{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}

module Network.HTTP2.H2.Settings where

import Network.Control

import Imports
import Network.HTTP2.Frame
import Network.HTTP2.H2.EncodeFrame

----------------------------------------------------------------

-- | HTTP\/2 settings. See <https://datatracker.ietf.org/doc/html/rfc9113#name-defined-settings>.
data Settings = Settings
    { Settings -> Int
headerTableSize :: Int
    -- ^ SETTINGS_HEADER_TABLE_SIZE
    , Settings -> Bool
enablePush :: Bool
    -- ^ SETTINGS_ENABLE_PUSH
    , Settings -> Maybe Int
maxConcurrentStreams :: Maybe Int
    -- ^ SETTINGS_MAX_CONCURRENT_STREAMS
    , Settings -> Int
initialWindowSize :: WindowSize
    -- ^ SETTINGS_INITIAL_WINDOW_SIZE
    , Settings -> Int
maxFrameSize :: Int
    -- ^ SETTINGS_MAX_FRAME_SIZE
    , Settings -> Maybe Int
maxHeaderListSize :: Maybe Int
    -- ^ SETTINGS_MAX_HEADER_LIST_SIZE
    }
    deriving (Settings -> Settings -> Bool
(Settings -> Settings -> Bool)
-> (Settings -> Settings -> Bool) -> Eq Settings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Settings -> Settings -> Bool
== :: Settings -> Settings -> Bool
$c/= :: Settings -> Settings -> Bool
/= :: Settings -> Settings -> Bool
Eq, Int -> Settings -> ShowS
[Settings] -> ShowS
Settings -> String
(Int -> Settings -> ShowS)
-> (Settings -> String) -> ([Settings] -> ShowS) -> Show Settings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Settings -> ShowS
showsPrec :: Int -> Settings -> ShowS
$cshow :: Settings -> String
show :: Settings -> String
$cshowList :: [Settings] -> ShowS
showList :: [Settings] -> ShowS
Show)

-- | The default settings.
--
-- >>> baseSettings
-- Settings {headerTableSize = 4096, enablePush = True, maxConcurrentStreams = Nothing, initialWindowSize = 65535, maxFrameSize = 16384, maxHeaderListSize = Nothing}
baseSettings :: Settings
baseSettings :: Settings
baseSettings =
    Settings
        { headerTableSize :: Int
headerTableSize = Int
4096 -- defaultDynamicTableSize
        , enablePush :: Bool
enablePush = Bool
True
        , maxConcurrentStreams :: Maybe Int
maxConcurrentStreams = Maybe Int
forall a. Maybe a
Nothing
        , initialWindowSize :: Int
initialWindowSize = Int
defaultWindowSize -- 64K (65,535)
        , maxFrameSize :: Int
maxFrameSize = Int
defaultPayloadLength -- 2^14 (16,384)
        , maxHeaderListSize :: Maybe Int
maxHeaderListSize = Maybe Int
forall a. Maybe a
Nothing
        }

-- | The default settings.
--
-- >>> defaultSettings
-- Settings {headerTableSize = 4096, enablePush = True, maxConcurrentStreams = Just 64, initialWindowSize = 262144, maxFrameSize = 16384, maxHeaderListSize = Nothing}
defaultSettings :: Settings
defaultSettings :: Settings
defaultSettings =
    Settings
baseSettings
        { maxConcurrentStreams = Just defaultMaxStreams
        , initialWindowSize = defaultMaxStreamData
        }

----------------------------------------------------------------

-- | Updating settings.
--
-- >>> fromSettingsList defaultSettings [(SettingsEnablePush,0),(SettingsMaxHeaderListSize,200)]
-- Settings {headerTableSize = 4096, enablePush = False, maxConcurrentStreams = Just 64, initialWindowSize = 262144, maxFrameSize = 16384, maxHeaderListSize = Just 200}
{- FOURMOLU_DISABLE -}
fromSettingsList :: Settings -> SettingsList -> Settings
fromSettingsList :: Settings -> SettingsList -> Settings
fromSettingsList Settings
settings SettingsList
kvs = (Settings -> (SettingsKey, Int) -> Settings)
-> Settings -> SettingsList -> Settings
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Settings -> (SettingsKey, Int) -> Settings
update Settings
settings SettingsList
kvs
  where
    update :: Settings -> (SettingsKey, Int) -> Settings
update Settings
def (SettingsKey
SettingsHeaderTableSize,Int
x)      = Settings
def { headerTableSize = x }
    -- fixme: x should be 0 or 1
    update Settings
def (SettingsKey
SettingsEnablePush,Int
x)           = Settings
def { enablePush = x > 0 }
    update Settings
def (SettingsKey
SettingsMaxConcurrentStreams,Int
x) = Settings
def { maxConcurrentStreams = Just x }
    update Settings
def (SettingsKey
SettingsInitialWindowSize,Int
x)    = Settings
def { initialWindowSize = x }
    update Settings
def (SettingsKey
SettingsMaxFrameSize,Int
x)         = Settings
def { maxFrameSize = x }
    update Settings
def (SettingsKey
SettingsMaxHeaderListSize,Int
x)    = Settings
def { maxHeaderListSize = Just x }
    update Settings
def (SettingsKey, Int)
_                                = Settings
def
{- FOURMOLU_ENABLE -}

----------------------------------------------------------------

diff
    :: Eq a
    => Settings
    -> Settings
    -> (Settings -> a)
    -> SettingsKey
    -> (a -> SettingsValue)
    -> Maybe (SettingsKey, SettingsValue)
diff :: forall a.
Eq a =>
Settings
-> Settings
-> (Settings -> a)
-> SettingsKey
-> (a -> Int)
-> Maybe (SettingsKey, Int)
diff Settings
settings Settings
settings0 Settings -> a
label SettingsKey
key a -> Int
enc
    | a
val a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
val0 = Maybe (SettingsKey, Int)
forall a. Maybe a
Nothing
    | Bool
otherwise = (SettingsKey, Int) -> Maybe (SettingsKey, Int)
forall a. a -> Maybe a
Just (SettingsKey
key, a -> Int
enc a
val)
  where
    val :: a
val = Settings -> a
label Settings
settings
    val0 :: a
val0 = Settings -> a
label Settings
settings0

toSettingsList :: Settings -> Settings -> SettingsList
toSettingsList :: Settings -> Settings -> SettingsList
toSettingsList Settings
s Settings
s0 =
    [Maybe (SettingsKey, Int)] -> SettingsList
forall a. [Maybe a] -> [a]
catMaybes
        [ Settings
-> Settings
-> (Settings -> Int)
-> SettingsKey
-> (Int -> Int)
-> Maybe (SettingsKey, Int)
forall a.
Eq a =>
Settings
-> Settings
-> (Settings -> a)
-> SettingsKey
-> (a -> Int)
-> Maybe (SettingsKey, Int)
diff
            Settings
s
            Settings
s0
            Settings -> Int
headerTableSize
            SettingsKey
SettingsHeaderTableSize
            Int -> Int
forall a. a -> a
id
        , Settings
-> Settings
-> (Settings -> Bool)
-> SettingsKey
-> (Bool -> Int)
-> Maybe (SettingsKey, Int)
forall a.
Eq a =>
Settings
-> Settings
-> (Settings -> a)
-> SettingsKey
-> (a -> Int)
-> Maybe (SettingsKey, Int)
diff
            Settings
s
            Settings
s0
            Settings -> Bool
enablePush
            SettingsKey
SettingsEnablePush
            (Int -> Bool -> Int
forall a b. a -> b -> a
const Int
0) -- fixme
        , Settings
-> Settings
-> (Settings -> Maybe Int)
-> SettingsKey
-> (Maybe Int -> Int)
-> Maybe (SettingsKey, Int)
forall a.
Eq a =>
Settings
-> Settings
-> (Settings -> a)
-> SettingsKey
-> (a -> Int)
-> Maybe (SettingsKey, Int)
diff
            Settings
s
            Settings
s0
            Settings -> Maybe Int
maxConcurrentStreams
            SettingsKey
SettingsMaxConcurrentStreams
            Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust
        , Settings
-> Settings
-> (Settings -> Int)
-> SettingsKey
-> (Int -> Int)
-> Maybe (SettingsKey, Int)
forall a.
Eq a =>
Settings
-> Settings
-> (Settings -> a)
-> SettingsKey
-> (a -> Int)
-> Maybe (SettingsKey, Int)
diff
            Settings
s
            Settings
s0
            Settings -> Int
initialWindowSize
            SettingsKey
SettingsInitialWindowSize
            Int -> Int
forall a. a -> a
id
        , Settings
-> Settings
-> (Settings -> Int)
-> SettingsKey
-> (Int -> Int)
-> Maybe (SettingsKey, Int)
forall a.
Eq a =>
Settings
-> Settings
-> (Settings -> a)
-> SettingsKey
-> (a -> Int)
-> Maybe (SettingsKey, Int)
diff
            Settings
s
            Settings
s0
            Settings -> Int
maxFrameSize
            SettingsKey
SettingsMaxFrameSize
            Int -> Int
forall a. a -> a
id
        , Settings
-> Settings
-> (Settings -> Maybe Int)
-> SettingsKey
-> (Maybe Int -> Int)
-> Maybe (SettingsKey, Int)
forall a.
Eq a =>
Settings
-> Settings
-> (Settings -> a)
-> SettingsKey
-> (a -> Int)
-> Maybe (SettingsKey, Int)
diff
            Settings
s
            Settings
s0
            Settings -> Maybe Int
maxHeaderListSize
            SettingsKey
SettingsMaxHeaderListSize
            Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust
        ]

----------------------------------------------------------------

makeNegotiationFrames :: Settings -> WindowSize -> [ByteString]
makeNegotiationFrames :: Settings -> Int -> [ByteString]
makeNegotiationFrames Settings
settings Int
connWindowSize = ByteString
frame1 ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
frames
  where
    alist :: SettingsList
alist = Settings -> Settings -> SettingsList
toSettingsList Settings
settings Settings
baseSettings
    frame1 :: ByteString
frame1 = (FrameFlags -> FrameFlags) -> SettingsList -> ByteString
settingsFrame FrameFlags -> FrameFlags
forall a. a -> a
id SettingsList
alist
    frames :: [ByteString]
frames =
        if Int
connWindowSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
defaultWindowSize
            then [Int -> Int -> ByteString
windowUpdateFrame Int
0 (Int
connWindowSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
defaultWindowSize)]
            else []

----------------------------------------------------------------