{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Network.HTTP2.TLS.Config where

import Data.ByteString (ByteString)
import Foreign.Marshal.Alloc (free, mallocBytes)
import Network.HTTP2.Client (
    Config (..),
    defaultPositionReadMaker,
 )
import Network.Socket (SockAddr)
import Network.Socket.BufferPool
import qualified System.TimeManager as T

import Network.HTTP2.TLS.Server.Settings

allocConfigForServer
    :: Settings
    -> T.Manager
    -> (ByteString -> IO ())
    -> IO ByteString
    -> SockAddr
    -> SockAddr
    -> IO Config
allocConfigForServer :: Settings
-> Manager
-> (ByteString -> IO ())
-> IO ByteString
-> SockAddr
-> SockAddr
-> IO Config
allocConfigForServer Settings{Int
SessionManager
String -> IO ()
settingsTimeout :: Int
settingsSendBufferSize :: Int
settingsSlowlorisSize :: Int
settingsReadBufferSize :: Int
settingsReadBufferLowerLimit :: Int
settingsKeyLogger :: String -> IO ()
settingsNumberOfWorkers :: Int
settingsConcurrentStreams :: Int
settingsStreamWindowSize :: Int
settingsConnectionWindowSize :: Int
settingsSessionManager :: SessionManager
settingsEarlyDataSize :: Int
settingsPingRateLimit :: Int
settingsEmptyFrameRateLimit :: Int
settingsSettingsRateLimit :: Int
settingsRstRateLimit :: Int
settingsTimeout :: Settings -> Int
settingsSendBufferSize :: Settings -> Int
settingsSlowlorisSize :: Settings -> Int
settingsReadBufferSize :: Settings -> Int
settingsReadBufferLowerLimit :: Settings -> Int
settingsKeyLogger :: Settings -> String -> IO ()
settingsNumberOfWorkers :: Settings -> Int
settingsConcurrentStreams :: Settings -> Int
settingsStreamWindowSize :: Settings -> Int
settingsConnectionWindowSize :: Settings -> Int
settingsSessionManager :: Settings -> SessionManager
settingsEarlyDataSize :: Settings -> Int
settingsPingRateLimit :: Settings -> Int
settingsEmptyFrameRateLimit :: Settings -> Int
settingsSettingsRateLimit :: Settings -> Int
settingsRstRateLimit :: Settings -> Int
..} Manager
mgr ByteString -> IO ()
send IO ByteString
recv SockAddr
mysa SockAddr
peersa = do
    Ptr Word8
buf <- Int -> IO (Ptr Word8)
forall a. Int -> IO (Ptr a)
mallocBytes Int
settingsSendBufferSize
    RecvN
recvN <- ByteString -> IO ByteString -> IO RecvN
makeRecvN ByteString
"" IO ByteString
recv
    let config :: Config
config =
            Config
                { confWriteBuffer :: Ptr Word8
confWriteBuffer = Ptr Word8
buf
                , confBufferSize :: Int
confBufferSize = Int
settingsSendBufferSize
                , confSendAll :: ByteString -> IO ()
confSendAll = ByteString -> IO ()
send
                , confReadN :: RecvN
confReadN = RecvN
recvN
                , confPositionReadMaker :: PositionReadMaker
confPositionReadMaker = PositionReadMaker
defaultPositionReadMaker
                , confTimeoutManager :: Manager
confTimeoutManager = Manager
mgr
                , confMySockAddr :: SockAddr
confMySockAddr = SockAddr
mysa
                , confPeerSockAddr :: SockAddr
confPeerSockAddr = SockAddr
peersa
                }
    Config -> IO Config
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Config
config

-- | Deallocating the resource of the simple configuration.
freeConfigForServer :: Config -> IO ()
freeConfigForServer :: Config -> IO ()
freeConfigForServer Config
conf = Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
free (Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> Ptr Word8
confWriteBuffer Config
conf

allocConfigForClient
    :: (ByteString -> IO ()) -> IO ByteString -> SockAddr -> SockAddr -> IO Config
allocConfigForClient :: (ByteString -> IO ())
-> IO ByteString -> SockAddr -> SockAddr -> IO Config
allocConfigForClient ByteString -> IO ()
send IO ByteString
recv SockAddr
mysa SockAddr
peersa = do
    let wbufsiz :: Int
wbufsiz = Int
4096 -- fixme
    Ptr Word8
buf <- Int -> IO (Ptr Word8)
forall a. Int -> IO (Ptr a)
mallocBytes Int
wbufsiz
    RecvN
recvN <- ByteString -> IO ByteString -> IO RecvN
makeRecvN ByteString
"" IO ByteString
recv
    -- A global manager does not exist.
    -- So, a timeout manager is created per connection.
    Manager
mgr <- Int -> IO Manager
T.initialize Int
30000000 -- fixme
    let config :: Config
config =
            Config
                { confWriteBuffer :: Ptr Word8
confWriteBuffer = Ptr Word8
buf
                , confBufferSize :: Int
confBufferSize = Int
wbufsiz
                , confSendAll :: ByteString -> IO ()
confSendAll = ByteString -> IO ()
send
                , confReadN :: RecvN
confReadN = RecvN
recvN
                , confPositionReadMaker :: PositionReadMaker
confPositionReadMaker = PositionReadMaker
defaultPositionReadMaker
                , confTimeoutManager :: Manager
confTimeoutManager = Manager
mgr
                , confMySockAddr :: SockAddr
confMySockAddr = SockAddr
mysa
                , confPeerSockAddr :: SockAddr
confPeerSockAddr = SockAddr
peersa
                }
    Config -> IO Config
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Config
config

-- | Deallocating the resource of the simple configuration.
freeConfigForClient :: Config -> IO ()
freeConfigForClient :: Config -> IO ()
freeConfigForClient Config{Int
Ptr Word8
Manager
SockAddr
RecvN
PositionReadMaker
ByteString -> IO ()
confWriteBuffer :: Config -> Ptr Word8
confBufferSize :: Config -> Int
confSendAll :: Config -> ByteString -> IO ()
confReadN :: Config -> RecvN
confPositionReadMaker :: Config -> PositionReadMaker
confTimeoutManager :: Config -> Manager
confMySockAddr :: Config -> SockAddr
confPeerSockAddr :: Config -> SockAddr
confWriteBuffer :: Ptr Word8
confBufferSize :: Int
confSendAll :: ByteString -> IO ()
confReadN :: RecvN
confPositionReadMaker :: PositionReadMaker
confTimeoutManager :: Manager
confMySockAddr :: SockAddr
confPeerSockAddr :: SockAddr
..} = do
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
free Ptr Word8
confWriteBuffer
    Manager -> IO ()
T.killManager Manager
confTimeoutManager