Merge branch 'refactoring-for-settings'

Network/HTTP2/Client.hs

@@ -52,8 +52,18 @@ module Network.HTTP2.Client (
     scheme,
     authority,
     cacheLimit,
-    concurrentStreams,
-    windowSize,
+    connectionWindowSize,
+    settings,
+
+    -- * HTTP\/2 setting
+    Settings,
+    defaultSettings,
+    headerTableSize,
+    enablePush,
+    maxConcurrentStreams,
+    initialWindowSize,
+    maxFrameSize,
+    maxHeaderListSize,
 
     -- * Common configuration
     Config (..),

Network/HTTP2/Client/Run.hs

@@ -9,6 +9,7 @@ import Control.Concurrent.STM (check)
 import Control.Exception
 import Data.ByteString.Builder (Builder)
 import Data.IORef
+import Network.Control (RxFlow (..), defaultMaxData)
 import Network.Socket (SockAddr)
 import UnliftIO.Async
 import UnliftIO.Concurrent
@@ -26,26 +27,26 @@ data ClientConfig = ClientConfig
     , authority :: Authority
     -- ^ 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
+    , connectionWindowSize :: WindowSize
+    -- ^ The window size of connection.
+    , settings :: Settings
+    -- ^ Settings
     }
     deriving (Eq, Show)
 
 -- | The default client config.
 --
 -- >>> defaultClientConfig
--- ClientConfig {scheme = "http", authority = "localhost", cacheLimit = 64, concurrentStreams = 64, windowSize = 1048575}
+-- ClientConfig {scheme = "http", authority = "localhost", cacheLimit = 64, connectionWindowSize = 1048576, settings = Settings {headerTableSize = 4096, enablePush = True, maxConcurrentStreams = Just 64, initialWindowSize = 262144, maxFrameSize = 16384, maxHeaderListSize = Nothing}}
 defaultClientConfig :: ClientConfig
 defaultClientConfig =
     ClientConfig
         { scheme = "http"
         , authority = "localhost"
         , cacheLimit = 64
-        , concurrentStreams = properConcurrentStreams
-        , windowSize = properWindowSize
+        , connectionWindowSize = defaultMaxData
+        , settings = defaultSettings
         }
 
 -- | Running HTTP/2 client.
@@ -110,8 +111,8 @@ setup ClientConfig{..} conf@Config{..} = do
             clientInfo
             conf
             cacheLimit
-            concurrentStreams
-            windowSize
+            connectionWindowSize
+            settings
     mgr <- start confTimeoutManager
     exchangeSettings ctx
     return (ctx, mgr)
@@ -209,9 +210,11 @@ sendStreaming Context{..} mgr req sid newstrm strmbdy = do
         writeTQueue outputQ $ Output newstrm req OObj (Just tbq) (return ())
 
 exchangeSettings :: Context -> IO ()
-exchangeSettings ctx@Context{..} = do
-    frames <- pendingMySettings ctx
-    let setframe = CFrames Nothing (connectionPreface : frames)
+exchangeSettings Context{..} = do
+    connRxWS <- rxfWindow <$> readIORef rxFlow
+    let frames = makeNegotiationFrames mySettings connRxWS
+        setframe = CFrames Nothing (connectionPreface : frames)
+    writeIORef myFirstSettings True
     enqueueControl controlQ setframe
 
 data ClientIO = ClientIO

Network/HTTP2/Frame.hs

@@ -78,17 +78,12 @@ module Network.HTTP2.Frame (
         SettingsMaxConcurrentStreams,
         SettingsInitialWindowSize,
         SettingsMaxFrameSize,
-        SettingsMaxHeaderBlockSize
+        SettingsMaxHeaderListSize
     ),
     SettingsValue,
     fromSettingsKey,
     toSettingsKey,
 
-    -- * Settings
-    Settings (..),
-    defaultSettings,
-    updateSettings,
-
     -- * Payload length
     defaultPayloadLength,
     maxPayloadLength,

Network/HTTP2/Frame/Decode.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
@@ -47,14 +48,12 @@ instance Exception FrameDecodeError
 -- So, this function is not useful for real applications
 -- but useful for testing.
 decodeFrame
-    :: Settings
-    -- ^ HTTP/2 settings
-    -> ByteString
+    :: ByteString
     -- ^ Input byte-stream
     -> Either FrameDecodeError Frame
     -- ^ Decoded frame
-decodeFrame settings bs =
-    checkFrameHeader settings (decodeFrameHeader bs0)
+decodeFrame bs =
+    checkFrameHeader (decodeFrameHeader bs0)
         >>= \(typ, header) ->
             decodeFramePayload typ header bs1
                 >>= \payload -> return $ Frame header payload
@@ -82,15 +81,12 @@ decodeFrameHeader (PS fptr off _) = unsafeDupablePerformIO $ withForeignPtr fptr
 
 -- | Checking a frame header and reporting an error if any.
 --
--- >>> checkFrameHeader defaultSettings (FrameData,(FrameHeader 100 0 0))
+-- >>> checkFrameHeader (FrameData,(FrameHeader 100 0 0))
 -- Left (FrameDecodeError ProtocolError 0 "cannot used in control stream")
 checkFrameHeader
-    :: Settings
-    -> (FrameType, FrameHeader)
+    :: (FrameType, FrameHeader)
     -> Either FrameDecodeError (FrameType, FrameHeader)
-checkFrameHeader Settings{..} typfrm@(typ, FrameHeader{..})
-    | payloadLength > maxFrameSize =
-        Left $ FrameDecodeError FrameSizeError streamId "exceeds maximum frame size"
+checkFrameHeader typfrm@(typ, FrameHeader{..})
     | typ `elem` nonZeroFrameTypes && isControl streamId =
         Left $ FrameDecodeError ProtocolError streamId "cannot used in control stream"
     | typ `elem` zeroFrameTypes && not (isControl streamId) =
@@ -141,8 +137,6 @@ checkFrameHeader Settings{..} typfrm@(typ, FrameHeader{..})
                     streamId
                     "payload length must be 0 if ack flag is set"
     checkType FramePushPromise
-        | not enablePush =
-            Left $ FrameDecodeError ProtocolError streamId "push not enabled" -- checkme
         | isServerInitiated streamId =
             Left $
                 FrameDecodeError

Network/HTTP2/Frame/Types.hs

@@ -129,8 +129,8 @@ pattern SettingsInitialWindowSize     = SettingsKey 4
 pattern SettingsMaxFrameSize         :: SettingsKey
 pattern SettingsMaxFrameSize          = SettingsKey 5 -- this means payload size
 
-pattern SettingsMaxHeaderBlockSize   :: SettingsKey
-pattern SettingsMaxHeaderBlockSize    = SettingsKey 6
+pattern SettingsMaxHeaderListSize    :: SettingsKey
+pattern SettingsMaxHeaderListSize     = SettingsKey 6
 {- FOURMOLU_ENABLE -}
 
 {- FOURMOLU_DISABLE -}
@@ -140,7 +140,7 @@ instance Show SettingsKey where
     show SettingsMaxConcurrentStreams = "SettingsMaxConcurrentStreams"
     show SettingsInitialWindowSize    = "SettingsInitialWindowSize"
     show SettingsMaxFrameSize         = "SettingsMaxFrameSize"
-    show SettingsMaxHeaderBlockSize   = "SettingsMaxHeaderBlockSize"
+    show SettingsMaxHeaderListSize    = "SettingsMaxHeaderListSize"
     show (SettingsKey x)              = "SettingsKey " ++ show x
 {- FOURMOLU_ENABLE -}
 
@@ -155,7 +155,7 @@ instance Read SettingsKey where
         readSK "SettingsMaxConcurrentStreams" = return SettingsMaxConcurrentStreams
         readSK "SettingsInitialWindowSize" = return SettingsInitialWindowSize
         readSK "SettingsMaxFrameSize" = return SettingsMaxFrameSize
-        readSK "SettingsMaxHeaderBlockSize" = return SettingsMaxHeaderBlockSize
+        readSK "SettingsMaxHeaderListSize" = return SettingsMaxHeaderListSize
         readSK "SettingsKey" = do
             Number ftyp <- lexP
             return $ SettingsKey $ fromIntegral $ fromJust $ L.numberToInteger ftyp
@@ -167,52 +167,6 @@ type SettingsValue = Int -- Word32
 -- | Association list of SETTINGS.
 type SettingsList = [(SettingsKey, SettingsValue)]
 
-----------------------------------------------------------------
-
--- | Cooked version of settings. This is suitable to be stored in a HTTP/2 context.
-data Settings = Settings
-    { headerTableSize :: Int
-    , enablePush :: Bool
-    , maxConcurrentStreams :: Maybe Int
-    , initialWindowSize :: WindowSize
-    , maxFrameSize :: Int
-    , maxHeaderListSize :: Maybe Int
-    }
-    deriving (Show)
-
--- | The default settings.
---
--- >>> defaultSettings
--- Settings {headerTableSize = 4096, enablePush = True, maxConcurrentStreams = Nothing, initialWindowSize = 65535, maxFrameSize = 16384, maxHeaderListSize = Nothing}
-defaultSettings :: Settings
-defaultSettings =
-    Settings
-        { headerTableSize = 4096 -- defaultDynamicTableSize
-        , enablePush = True
-        , maxConcurrentStreams = Nothing
-        , initialWindowSize = defaultWindowSize
-        , maxFrameSize = defaultPayloadLength
-        , maxHeaderListSize = Nothing
-        }
-
--- | Updating settings.
---
--- >>> updateSettings defaultSettings [(SettingsEnablePush,0),(SettingsMaxHeaderBlockSize,200)]
--- Settings {headerTableSize = 4096, enablePush = False, maxConcurrentStreams = Nothing, initialWindowSize = 65535, maxFrameSize = 16384, maxHeaderListSize = Just 200}
-{- FOURMOLU_DISABLE -}
-updateSettings :: Settings -> SettingsList -> Settings
-updateSettings 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 (SettingsMaxHeaderBlockSize,x)   = def { maxHeaderListSize = Just x }
-    update def _                                = def
-{- FOURMOLU_ENABLE -}
-
 -- | The default initial window size.
 --
 -- >>> defaultWindowSize