module Network.HTTP2.TLS.Server.Settings where

import Network.Control
import Network.TLS (SessionManager, noSessionManager)

-- Server settings type.
data Settings = Settings
    { Settings -> Int
settingsTimeout :: Int
    -- ^ Timeout in seconds. (All)
    --
    -- >>> settingsTimeout defaultSettings
    -- 30
    , Settings -> Int
settingsSendBufferSize :: Int
    -- ^ Send buffer size. (H2 and H2c)
    --
    -- >>> settingsSendBufferSize defaultSettings
    -- 4096
    , Settings -> Int
settingsSlowlorisSize :: Int
    -- ^ If the size of receiving data is less than or equal,
    --   the timeout is not reset.
    --   (All)
    --
    -- >>> settingsSlowlorisSize defaultSettings
    -- 50
    , Settings -> Int
settingsReadBufferSize :: Int
    -- ^ When the size of a read buffer is lower than this limit, the buffer is thrown awany (and is eventually freed). Then a new buffer is allocated. (All)
    --
    -- >>> settingsReadBufferSize defaultSettings
    -- 16384
    , Settings -> Int
settingsReadBufferLowerLimit :: Int
    -- ^  The allocation size for a read buffer.  (All)
    --
    -- >>> settingsReadBufferLowerLimit defaultSettings
    -- 2048
    , Settings -> String -> IO ()
settingsKeyLogger :: String -> IO ()
    -- ^ Key logger.
    --
    -- Applications may wish to set this depending on the SSLKEYLOGFILE environment variable. The default is do nothing.
    --
    -- Default: do nothing
    , Settings -> Int
settingsNumberOfWorkers :: Int
    -- ^ The http2 library now spawns a thread for each connection. Its limit is based on 'settingsConcurrentStreams'.
    , Settings -> Int
settingsConcurrentStreams :: Int
    -- ^ The maximum number of incoming streams on the net (H2 and H2c)
    --
    -- >>> settingsConcurrentStreams defaultSettings
    -- 64
    , Settings -> Int
settingsStreamWindowSize :: Int
    -- ^ The window size of incoming streams (H2 and H2c)
    --
    -- >>> settingsStreamWindowSize defaultSettings
    -- 262144
    , Settings -> Int
settingsConnectionWindowSize :: Int
    -- ^ The window size of a connection (H2 and H2c)
    --
    -- >>> settingsConnectionWindowSize defaultSettings
    -- 1048575
    , Settings -> SessionManager
settingsSessionManager :: SessionManager
    -- ^ TLS session manager (H2 and TLS)
    --
    -- Default: 'noSessionManager'
    , Settings -> Int
settingsEarlyDataSize :: Int
    -- ^ The max size of early data (0-RTT) to be accepted. (H2 and TLS)
    -- 0 means that early data is not accepted.
    --
    -- >>> settingsEarlyDataSize defaultSettings
    -- 0
    , Settings -> Int
settingsPingRateLimit :: Int
    -- ^ Maximum number of pings allowed per second (CVE-2019-9512)
    --
    -- >>> settingsPingRateLimit defaultSettings
    -- 10
    , Settings -> Int
settingsEmptyFrameRateLimit :: Int
    -- ^ Maximum number of empty data frames allowed per second (CVE-2019-9518)
    --
    -- >>> settingsEmptyFrameRateLimit defaultSettings
    -- 4
    , Settings -> Int
settingsSettingsRateLimit :: Int
    -- ^ Maximum number of settings frames allowed per second (CVE-2019-9515)
    --
    -- >>> settingsSettingsRateLimit defaultSettings
    -- 4
    , Settings -> Int
settingsRstRateLimit :: Int
    -- ^ Maximum number of reset frames allowed per second (CVE-2023-44487)
    --
    -- >>> settingsRstRateLimit
    -- 4
    }

{-# DEPRECATED settingsNumberOfWorkers "This field is meaningless now" #-}

-- | Default settings.
defaultSettings :: Settings
defaultSettings :: Settings
defaultSettings =
    Settings
        { settingsTimeout :: Int
settingsTimeout = Int
30
        , settingsSendBufferSize :: Int
settingsSendBufferSize = Int
4096
        , settingsSlowlorisSize :: Int
settingsSlowlorisSize = Int
50
        , settingsReadBufferSize :: Int
settingsReadBufferSize = Int
16384
        , settingsReadBufferLowerLimit :: Int
settingsReadBufferLowerLimit = Int
2048
        , settingsKeyLogger :: String -> IO ()
settingsKeyLogger = \String
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , settingsNumberOfWorkers :: Int
settingsNumberOfWorkers = Int
8 -- dummy
        , settingsConcurrentStreams :: Int
settingsConcurrentStreams = Int
defaultMaxStreams
        , settingsStreamWindowSize :: Int
settingsStreamWindowSize = Int
defaultMaxStreamData
        , settingsConnectionWindowSize :: Int
settingsConnectionWindowSize = Int
defaultMaxData
        , settingsSessionManager :: SessionManager
settingsSessionManager = SessionManager
noSessionManager
        , settingsEarlyDataSize :: Int
settingsEarlyDataSize = Int
0
        , settingsPingRateLimit :: Int
settingsPingRateLimit = Int
10
        , settingsEmptyFrameRateLimit :: Int
settingsEmptyFrameRateLimit = Int
4
        , settingsSettingsRateLimit :: Int
settingsSettingsRateLimit = Int
4
        , settingsRstRateLimit :: Int
settingsRstRateLimit = Int
4
        }