File: Settings.hs

package info (click to toggle)
haskell-http2 5.0.1-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 55,180 kB
  • sloc: haskell: 8,657; makefile: 5
file content (147 lines) | stat: -rw-r--r-- 4,686 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
{-# 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
    { headerTableSize :: Int
    -- ^ SETTINGS_HEADER_TABLE_SIZE
    , enablePush :: Bool
    -- ^ SETTINGS_ENABLE_PUSH
    , maxConcurrentStreams :: Maybe Int
    -- ^ SETTINGS_MAX_CONCURRENT_STREAMS
    , initialWindowSize :: WindowSize
    -- ^ SETTINGS_INITIAL_WINDOW_SIZE
    , maxFrameSize :: Int
    -- ^ SETTINGS_MAX_FRAME_SIZE
    , maxHeaderListSize :: Maybe Int
    -- ^ SETTINGS_MAX_HEADER_LIST_SIZE
    }
    deriving (Eq, Show)

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

-- | The default settings.
--
-- >>> defaultSettings
-- Settings {headerTableSize = 4096, enablePush = True, maxConcurrentStreams = Just 64, initialWindowSize = 262144, maxFrameSize = 16384, maxHeaderListSize = Nothing}
defaultSettings :: Settings
defaultSettings =
    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 kvs = foldl' update settings kvs
  where
    update def (SettingsHeaderTableSize,x)      = def { headerTableSize = x }
    -- fixme: x should be 0 or 1
    update def (SettingsEnablePush,x)           = def { enablePush = x > 0 }
    update def (SettingsMaxConcurrentStreams,x) = def { maxConcurrentStreams = Just x }
    update def (SettingsInitialWindowSize,x)    = def { initialWindowSize = x }
    update def (SettingsMaxFrameSize,x)         = def { maxFrameSize = x }
    update def (SettingsMaxHeaderListSize,x)    = def { maxHeaderListSize = Just x }
    update def _                                = def
{- FOURMOLU_ENABLE -}

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

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

toSettingsList :: Settings -> Settings -> SettingsList
toSettingsList s s0 =
    catMaybes
        [ diff
            s
            s0
            headerTableSize
            SettingsHeaderTableSize
            id
        , diff
            s
            s0
            enablePush
            SettingsEnablePush
            (const 0) -- fixme
        , diff
            s
            s0
            maxConcurrentStreams
            SettingsMaxConcurrentStreams
            fromJust
        , diff
            s
            s0
            initialWindowSize
            SettingsInitialWindowSize
            id
        , diff
            s
            s0
            maxFrameSize
            SettingsMaxFrameSize
            id
        , diff
            s
            s0
            maxHeaderListSize
            SettingsMaxHeaderListSize
            fromJust
        ]

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

makeNegotiationFrames :: Settings -> WindowSize -> [ByteString]
makeNegotiationFrames settings connWindowSize = frame1 : frames
  where
    alist = toSettingsList settings baseSettings
    frame1 = settingsFrame id alist
    frames =
        if connWindowSize /= defaultWindowSize
            then [windowUpdateFrame 0 (connWindowSize - defaultWindowSize)]
            else []

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