content: {-
    Copyright (c) Meta Platforms, Inc. and affiliates.
    All rights reserved.
  
    This source code is licensed under the BSD-style license found in the
    LICENSE file in the root directory of this source tree.
  -}
  
  {-# LANGUAGE StandaloneDeriving #-}
  module Thrift.Channel.Lib.HeaderChannel
    ( HeaderWrappedChannel
    , HeaderConfig(..)
    , getRequestChannelProtocolId
    , withHeaderChannelForTransport
    , withHeaderChannelIOForTransport
    ) where
  
  import Control.Exception
  import Data.ByteString (ByteString)
  import qualified Data.ByteString.Unsafe as BS
  import Data.Proxy
  import Foreign.C
  import Foreign.Ptr
  
  import Thrift.Channel.Lib.CppChannel
  import Thrift.Monad
  import Thrift.Protocol
  import Thrift.Protocol.Id
  import Util.EventBase
  
  data HeaderClient
  type HeaderWrappedChannel = WrappedChannel HeaderClient
  
  data HeaderConfig a = HeaderConfig
    { headerHost :: ByteString
    , headerPort :: Int
    , headerProtocolId :: ProtocolId
    , headerConnTimeout :: Int
    , headerSendTimeout :: Int
    , headerRecvTimeout :: Int
    }
  
  deriving instance Show (HeaderConfig a)
  
  withHeaderChannelForTransport
      :: EventBaseDataplane
      -> HeaderConfig t
      -> FunPtr (CppSocketAddress -> EventBase -> CSize
        -> IO (Ptr CppAsyncTransport))
      -> (forall p . Protocol p => ThriftM p HeaderWrappedChannel t a)
      -> IO a
  withHeaderChannelForTransport io HeaderConfig{..} transportMaker fn = do
    eb <- getEventBase io
    BS.unsafeUseAsCStringLen headerHost $ \(host_str, host_len) -> bracket
      (newHeaderChannel host_str (fromIntegral host_len)
                        (fromIntegral headerPort)
                        transportMaker
                        headerProtocolId
                        (fromIntegral headerConnTimeout)
                        (fromIntegral headerSendTimeout)
                        (fromIntegral headerRecvTimeout)
                        eb
                        )
      deleteHeaderChannel $ \ch -> do
        protId <- getRequestChannelProtocolId ch
        withProxy protId $ runAction ch fn
    where
      runAction
        :: Protocol p
        => Ptr CppRequestChannelPtr
        -> ThriftM p HeaderWrappedChannel t a
        -> Proxy p
        -> IO a
      runAction c a _ = withCppChannel c a
  
  withHeaderChannelIOForTransport
      :: EventBaseDataplane
      -> HeaderConfig t
      -> FunPtr (CppSocketAddress -> EventBase -> CSize
        -> IO (Ptr CppAsyncTransport))
      -> (forall p . Protocol p => HeaderWrappedChannel t -> Proxy p -> IO a)
      -> IO a
  withHeaderChannelIOForTransport io HeaderConfig{..} transportMaker fn = do
    eb <- getEventBase io
    BS.unsafeUseAsCStringLen headerHost $ \(host_str, host_len) -> bracket
      (newHeaderChannel host_str (fromIntegral host_len)
                        (fromIntegral headerPort)
                        transportMaker
                        headerProtocolId
                        (fromIntegral headerConnTimeout)
                        (fromIntegral headerSendTimeout)
                        (fromIntegral headerRecvTimeout)
                        eb
                        )
      deleteHeaderChannel $ \ch -> do
        protId <- getRequestChannelProtocolId ch
        withCppChannelIO ch $ \ wr -> do
        withProxy protId $ fn wr
  
  
  foreign import ccall safe "newHeaderChannel"
    newHeaderChannel :: CString -> CSize
                    -> CSize
                    -> FunPtr (CppSocketAddress -> EventBase -> CSize
                      -> IO (Ptr CppAsyncTransport))
                    -> CUShort
                    -> CSize
                    -> CSize
                    -> CSize
                    -> EventBase
                    -> IO (Ptr CppRequestChannelPtr)
  
  foreign import ccall safe "deleteHeaderChannel"
    deleteHeaderChannel :: Ptr CppRequestChannelPtr -> IO ()
  
  foreign import ccall unsafe "getRequestChannelProtocolId"
    getRequestChannelProtocolId :: Ptr CppRequestChannelPtr -> IO CUShort
  