module Network.HTTP3.Config where

import Network.HTTP2.Internal
import Network.HTTP3.Frame
import Network.QUIC (Stream)
import qualified System.TimeManager as T

-- | Hooks mainly for error testing.
data Hooks = Hooks {
    Hooks -> [H3Frame] -> [H3Frame]
onControlFrameCreated :: [H3Frame] -> [H3Frame]
  , Hooks -> [H3Frame] -> [H3Frame]
onHeadersFrameCreated :: [H3Frame] -> [H3Frame]
  , Hooks -> Stream -> IO ()
onControlStreamCreated :: Stream -> IO ()
  , Hooks -> Stream -> IO ()
onEncoderStreamCreated :: Stream -> IO ()
  , Hooks -> Stream -> IO ()
onDecoderStreamCreated :: Stream -> IO ()
  }

-- | Default hooks.
defaultHooks :: Hooks
defaultHooks :: Hooks
defaultHooks = Hooks {
    onControlFrameCreated :: [H3Frame] -> [H3Frame]
onControlFrameCreated = forall a. a -> a
id
  , onHeadersFrameCreated :: [H3Frame] -> [H3Frame]
onHeadersFrameCreated = forall a. a -> a
id
  , onControlStreamCreated :: Stream -> IO ()
onControlStreamCreated = \Stream
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  , onEncoderStreamCreated :: Stream -> IO ()
onEncoderStreamCreated = \Stream
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  , onDecoderStreamCreated :: Stream -> IO ()
onDecoderStreamCreated = \Stream
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  }

-- | Configuration for HTTP\/3 or HQ.
data Config = Config {
    Config -> Hooks
confHooks :: Hooks
  , Config -> PositionReadMaker
confPositionReadMaker :: PositionReadMaker
  , Config -> Manager
confTimeoutManager :: T.Manager
  }

-- | Allocating a simple configuration with a handle-based position
--   reader and a locally allocated timeout manager.
allocSimpleConfig :: IO Config
allocSimpleConfig :: IO Config
allocSimpleConfig = Hooks -> PositionReadMaker -> Manager -> Config
Config Hooks
defaultHooks PositionReadMaker
defaultPositionReadMaker forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Manager
T.initialize (Int
30 forall a. Num a => a -> a -> a
* Int
1000000)

-- | Freeing a simple configration.
freeSimpleConfig :: Config -> IO ()
freeSimpleConfig :: Config -> IO ()
freeSimpleConfig Config
conf = Manager -> IO ()
T.killManager forall a b. (a -> b) -> a -> b
$ Config -> Manager
confTimeoutManager Config
conf