improving ClientConfig and ServerConfig

Network/HTTP2/Arch.hs

@@ -9,6 +9,7 @@ module Network.HTTP2.Arch (
     module Network.HTTP2.Arch.ReadN,
     module Network.HTTP2.Arch.Receiver,
     module Network.HTTP2.Arch.Sender,
+    module Network.HTTP2.Arch.Settings,
     module Network.HTTP2.Arch.Status,
     module Network.HTTP2.Arch.Stream,
     module Network.HTTP2.Arch.StreamTable,
@@ -26,6 +27,7 @@ import Network.HTTP2.Arch.Queue
 import Network.HTTP2.Arch.ReadN
 import Network.HTTP2.Arch.Receiver
 import Network.HTTP2.Arch.Sender
+import Network.HTTP2.Arch.Settings
 import Network.HTTP2.Arch.Status
 import Network.HTTP2.Arch.Stream
 import Network.HTTP2.Arch.StreamTable

Network/HTTP2/Arch/Context.hs

@@ -54,8 +54,9 @@ data Context = Context
     { role :: Role
     , roleInfo :: RoleInfo
     , -- Settings
-      myFirstSettings :: IORef Bool
-    , myPendingAlist :: IORef (Maybe SettingsList)
+      mySettingAlist :: SettingsList -- to be myPendingAlist
+    , myFirstSettings :: IORef Bool
+    , myPendingAlist :: IORef (Maybe SettingsList) -- to be mySettings
     , mySettings :: IORef Settings
     , peerSettings :: IORef Settings
     , oddStreamTable :: TVar OddStreamTable
@@ -88,9 +89,9 @@ data Context = Context
 ----------------------------------------------------------------
 
 newContext
-    :: RoleInfo -> Int -> BufferSize -> SockAddr -> SockAddr -> IO Context
-newContext rinfo cacheSiz siz mysa peersa =
-    Context rl rinfo
+    :: RoleInfo -> Int -> BufferSize -> SockAddr -> SockAddr -> SettingsList -> IO Context
+newContext rinfo cacheSiz siz mysa peersa settingAlist =
+    Context rl rinfo settingAlist
         <$> newIORef False
         <*> newIORef Nothing
         <*> newIORef defaultSettings
@@ -269,4 +270,3 @@ openEvenStreamWait ctx@Context{..} = do
             newstrm <- newEvenStream sid ws
             insertEven' evenStreamTable sid newstrm
             return (sid, newstrm)
-

Network/HTTP2/Arch/Receiver.hs

@@ -24,6 +24,7 @@ import Network.HTTP2.Arch.EncodeFrame
 import Network.HTTP2.Arch.HPACK
 import Network.HTTP2.Arch.Queue
 import Network.HTTP2.Arch.Rate
+import Network.HTTP2.Arch.Settings
 import Network.HTTP2.Arch.Stream
 import Network.HTTP2.Arch.StreamTable
 import Network.HTTP2.Arch.Types
@@ -125,10 +126,10 @@ processFrame ctx@Context{..} conf typhdr@(ftyp, header) = do
 ----------------------------------------------------------------
 
 controlOrStream :: Context -> Config -> FrameType -> FrameHeader -> IO ()
-controlOrStream ctx@Context{..} conf@Config{..} ftyp header@FrameHeader{streamId, payloadLength}
+controlOrStream ctx@Context{..} Config{..} ftyp header@FrameHeader{streamId, payloadLength}
     | isControl streamId = do
         bs <- confReadN payloadLength
-        control ftyp header bs ctx conf
+        control ftyp header bs ctx
     | ftyp == FramePushPromise = do
         bs <- confReadN payloadLength
         push header bs ctx
@@ -285,8 +286,8 @@ getOddStream ctx ftyp streamId Nothing
 
 type Payload = ByteString
 
-control :: FrameType -> FrameHeader -> Payload -> Context -> Config -> IO ()
-control FrameSettings header@FrameHeader{flags, streamId} bs ctx@Context{myFirstSettings, myPendingAlist, mySettings, controlQ, settingsRate} conf = do
+control :: FrameType -> FrameHeader -> Payload -> Context -> IO ()
+control FrameSettings header@FrameHeader{flags, streamId} bs ctx@Context{myFirstSettings, myPendingAlist, mySettings, controlQ, settingsRate} = do
     SettingsFrame peerAlist <- guardIt $ decodeSettingsFrame header bs
     traverse_ E.throwIO $ checkSettingsList peerAlist
     if testAck flags
@@ -314,10 +315,10 @@ control FrameSettings header@FrameHeader{flags, streamId} bs ctx@Context{myFirst
                     enqueueControl controlQ setframe
                 else do
                     -- Server side only
-                    frames <- updateMySettings conf ctx
+                    frames <- pendingMySettings ctx
                     let setframe = CFrames (Just peerAlist) (frames ++ [ack])
                     enqueueControl controlQ setframe
-control FramePing FrameHeader{flags, streamId} bs Context{controlQ, pingRate} _ =
+control FramePing FrameHeader{flags, streamId} bs Context{controlQ, pingRate} =
     unless (testAck flags) $ do
         -- Ping Flood - CVE-2019-9512
         rate <- getRate pingRate
@@ -326,15 +327,15 @@ control FramePing FrameHeader{flags, streamId} bs Context{controlQ, pingRate} _
             else do
                 let frame = pingFrame bs
                 enqueueControl controlQ $ CFrames Nothing [frame]
-control FrameGoAway header bs _ _ = do
+control FrameGoAway header bs _ = do
     GoAwayFrame sid err msg <- guardIt $ decodeGoAwayFrame header bs
     if err == NoError
         then E.throwIO ConnectionIsClosed
         else E.throwIO $ ConnectionErrorIsReceived err sid $ Short.toShort msg
-control FrameWindowUpdate header bs ctx _ = do
+control FrameWindowUpdate header bs ctx = do
     WindowUpdateFrame n <- guardIt $ decodeWindowUpdateFrame header bs
     increaseConnectionWindowSize ctx n
-control _ _ _ _ _ =
+control _ _ _ _ =
     -- must not reach here
     return ()
 

Network/HTTP2/Arch/Sender.hs

@@ -30,6 +30,7 @@ import Network.HTTP2.Arch.File
 import Network.HTTP2.Arch.HPACK
 import Network.HTTP2.Arch.Manager hiding (start)
 import Network.HTTP2.Arch.Queue
+import Network.HTTP2.Arch.Settings
 import Network.HTTP2.Arch.Stream
 import Network.HTTP2.Arch.Types
 import Network.HTTP2.Arch.Window

Network/HTTP2/Arch/Settings.hs

@@ -0,0 +1,73 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Network.HTTP2.Arch.Settings where
+
+import Data.IORef
+import UnliftIO.STM
+
+import Imports
+import Network.HTTP2.Arch.Config
+import Network.HTTP2.Arch.Context
+import Network.HTTP2.Arch.EncodeFrame
+import Network.HTTP2.Arch.StreamTable
+import Network.HTTP2.Arch.Types
+import Network.HTTP2.Frame
+
+-- max: 2,147,483,647 (2^31-1) is too large.
+-- def:        65,535 (2^16-1) it too small.
+--          1,048,575 (2^20-1)
+properWindowSize :: WindowSize
+properWindowSize = 1048575
+
+properConcurrentStreams :: Int
+properConcurrentStreams = 64
+
+makeMySettingsList :: Config -> Int -> WindowSize -> [(SettingsKey, Int)]
+makeMySettingsList Config{..} maxConc winSiz = myInitialAlist
+  where
+    -- confBufferSize is the size of the write buffer.
+    -- But we assume that the size of the read buffer is the same size.
+    -- So, the size is announced to via SETTINGS_MAX_FRAME_SIZE.
+    len = confBufferSize - frameHeaderLength
+    payloadLen = max defaultPayloadLength len
+    myInitialAlist =
+        [ (SettingsMaxFrameSize, payloadLen)
+        , (SettingsMaxConcurrentStreams, maxConc)
+        , (SettingsInitialWindowSize, winSiz)
+        ]
+
+----------------------------------------------------------------
+
+pendingMySettings :: Context -> IO [ByteString]
+pendingMySettings Context{mySettingAlist, myFirstSettings, myPendingAlist} = do
+    writeIORef myFirstSettings True
+    writeIORef myPendingAlist $ Just mySettingAlist
+    return frames'
+  where
+    frame1 = settingsFrame id mySettingAlist
+    -- Initial window update for connection
+    frames = case lookup SettingsInitialWindowSize mySettingAlist of
+      Nothing -> []
+      Just winSiz -> [windowUpdateFrame 0 (winSiz - defaultWindowSize)]
+    frames' = frame1 : frames
+
+----------------------------------------------------------------
+
+-- Peer SETTINGS_INITIAL_WINDOW_SIZE
+-- Adjusting initial window size for streams
+updatePeerSettings :: Context -> SettingsList -> IO ()
+updatePeerSettings Context{peerSettings, oddStreamTable} peerAlist = do
+    oldws <- initialWindowSize <$> readIORef peerSettings
+    modifyIORef' peerSettings $ \old -> updateSettings old peerAlist
+    newws <- initialWindowSize <$> readIORef peerSettings
+    let diff = newws - oldws
+    when (diff /= 0) $ updateAllOddStreamWindow (+ diff) oddStreamTable
+
+----------------------------------------------------------------
+
+updateAllOddStreamWindow
+    :: (WindowSize -> WindowSize) -> TVar OddStreamTable -> IO ()
+updateAllOddStreamWindow adst var = do
+    strms <- getOddStreams var
+    forM_ strms $ \strm -> atomically $ modifyTVar (streamWindow strm) adst

Network/HTTP2/Arch/Window.hs

@@ -8,11 +8,9 @@ import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 
 import Imports
-import Network.HTTP2.Arch.Config
 import Network.HTTP2.Arch.Context
 import Network.HTTP2.Arch.EncodeFrame
 import Network.HTTP2.Arch.Queue
-import Network.HTTP2.Arch.StreamTable
 import Network.HTTP2.Arch.Types
 import Network.HTTP2.Frame
 
@@ -82,49 +80,3 @@ informWindowUpdate Context{controlQ, rxConnectionInc} Stream{streamNumber} strea
       where
         thresh = defaultWindowSize -- fixme
         w1 = w0 + len
-
-----------------------------------------------------------------
-
--- max: 2,147,483,647 (2^31-1) is too large.
--- def:        65,535 (2^16-1) it too small.
---          1,048,575 (2^20-1)
-properWindowSize :: WindowSize
-properWindowSize = 1048575
-
-updateMySettings :: Config -> Context -> IO [ByteString]
-updateMySettings Config{..} Context{myFirstSettings, myPendingAlist} = do
-    writeIORef myFirstSettings True
-    writeIORef myPendingAlist $ Just myInitialAlist
-    return frames
-  where
-    len = confBufferSize - frameHeaderLength
-    payloadLen = max defaultPayloadLength len
-    myInitialAlist =
-        -- confBufferSize is the size of the write buffer.
-        -- But we assume that the size of the read buffer is the same size.
-        -- So, the size is announced to via SETTINGS_MAX_FRAME_SIZE.
-        [ (SettingsMaxFrameSize, payloadLen)
-        , (SettingsMaxConcurrentStreams, recommendedConcurrency)
-        , -- Initial window size for streams
-          (SettingsInitialWindowSize, properWindowSize)
-        ]
-    frame1 = settingsFrame id myInitialAlist
-    -- Initial window update for connection
-    frame2 = windowUpdateFrame 0 (properWindowSize - defaultWindowSize)
-    frames = [frame1, frame2]
-
--- Peer SETTINGS_INITIAL_WINDOW_SIZE
--- Adjusting initial window size for streams
-updatePeerSettings :: Context -> SettingsList -> IO ()
-updatePeerSettings Context{peerSettings, oddStreamTable} peerAlist = do
-    oldws <- initialWindowSize <$> readIORef peerSettings
-    modifyIORef' peerSettings $ \old -> updateSettings old peerAlist
-    newws <- initialWindowSize <$> readIORef peerSettings
-    let diff = newws - oldws
-    when (diff /= 0) $ updateAllOddStreamWindow (+ diff) oddStreamTable
-
-updateAllOddStreamWindow
-    :: (WindowSize -> WindowSize) -> TVar OddStreamTable -> IO ()
-updateAllOddStreamWindow adst var = do
-    strms <- getOddStreams var
-    forM_ strms $ \strm -> atomically $ modifyTVar (streamWindow strm) adst

Network/HTTP2/Client.hs

@@ -43,11 +43,14 @@
 module Network.HTTP2.Client (
     -- * Runner
     run,
+
+    -- * Client configuration
     Scheme,
     Authority,
-
-    -- * Runner arguments
     ClientConfig (..),
+    defaultClientConfig,
+
+    -- * Common configuration
     Config (..),
     allocSimpleConfig,
     freeSimpleConfig,

Network/HTTP2/Client/Run.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -25,7 +26,25 @@ data ClientConfig = ClientConfig
     -- ^ Server name
     , cacheLimit :: Int
     -- ^ How many pushed responses are contained in the cache
-    }
+    , concurrentStreams :: Int
+    -- ^ The maximum number of incoming streams on the net
+    , windowSize :: WindowSize
+    -- ^ The window size of incoming streams
+    } deriving (Eq, Show)
+
+-- | The default client config.
+--
+-- >>> defaultClientConfig
+-- ClientConfig {scheme = "http", authority = "localhost", cacheLimit = 64, concurrentStreams = 64, windowSize = 1048575}
+defaultClientConfig :: ClientConfig
+defaultClientConfig =
+    ClientConfig
+        { scheme = "http"
+        , authority = "localhost"
+        , cacheLimit = 64
+        , concurrentStreams = properConcurrentStreams
+        , windowSize = properWindowSize
+        }
 
 -- | Running HTTP/2 client.
 run :: ClientConfig -> Config -> Client a -> IO a
@@ -60,10 +79,11 @@ runIO cconf@ClientConfig{..} conf@Config{..} action = do
 setup :: ClientConfig -> Config -> IO (Context, Manager)
 setup ClientConfig{..} conf@Config{..} = do
     let clientInfo = newClientInfo scheme authority
+        myAlist = makeMySettingsList conf concurrentStreams windowSize
     ctx <-
-        newContext clientInfo cacheLimit confBufferSize confMySockAddr confPeerSockAddr
+        newContext clientInfo cacheLimit confBufferSize confMySockAddr confPeerSockAddr myAlist
     mgr <- start confTimeoutManager
-    exchangeSettings conf ctx
+    exchangeSettings ctx
     return (ctx, mgr)
 
 runArch :: Config -> Context -> Manager -> IO a -> IO a
@@ -157,9 +177,9 @@ sendStreaming Context{..} mgr req sid newstrm strmbdy = do
         writeTVar outputQStreamID (sid + 2)
         writeTQueue outputQ $ Output newstrm req OObj (Just tbq) (return ())
 
-exchangeSettings :: Config -> Context -> IO ()
-exchangeSettings conf ctx@Context{..} = do
-    frames <- updateMySettings conf ctx
+exchangeSettings :: Context -> IO ()
+exchangeSettings ctx@Context{..} = do
+    frames <- pendingMySettings ctx
     let setframe = CFrames Nothing (connectionPreface : frames)
     enqueueControl controlQ setframe
 

Network/HTTP2/Server.hs

@@ -28,8 +28,13 @@
 module Network.HTTP2.Server (
     -- * Runner
     run,
+    run',
 
-    -- * Runner arguments
+    -- * Client configuration
+    ServerConfig(..),
+    defaultServerConfig,
+
+    -- * Common configuration
     Config (..),
     allocSimpleConfig,
     freeSimpleConfig,
@@ -107,7 +112,7 @@ import Network.HPACK
 import Network.HPACK.Token
 import Network.HTTP2.Arch
 import Network.HTTP2.Frame.Types
-import Network.HTTP2.Server.Run (run)
+import Network.HTTP2.Server.Run (run, run', ServerConfig(..), defaultServerConfig)
 import Network.HTTP2.Server.Types
 
 ----------------------------------------------------------------