Merge pull request #178 from well-typed/finley/145

Allow setting number of worker threads and other HTTP/2 setting params
well-typed · Jul 4, 2024 · 1d38f88 · 1d38f88
2 parents ffb5168 + d2ac53f
commit 1d38f88
Show file tree

Hide file tree

Showing 14 changed files with 237 additions and 55 deletions.
diff --git a/.gitignore b/.gitignore
@@ -2,7 +2,7 @@ dist-newstyle
 .envrc
 *.swp
 *.pcapng
-cabal.project.local
+*.local
 *.eventlog
 *.eventlog.html
 *.hp

diff --git a/demo-server/Main.hs b/demo-server/Main.hs
@@ -58,8 +58,8 @@ main = do
           }
 
     runServerWithHandlers
-      serverConfig
       (serverParams cmdline)
+      serverConfig
       (fromServices $ services cmdline db)
 
 getRouteGuideDb :: IO [Proto Feature]

diff --git a/grapesy.cabal b/grapesy.cabal
@@ -111,6 +111,7 @@ library
       Network.GRPC.Common.Protobuf
       Network.GRPC.Common.StreamElem
       Network.GRPC.Common.StreamType
+      Network.GRPC.Common.HTTP2Settings
       Network.GRPC.Internal.XIO
       Network.GRPC.Server
       Network.GRPC.Server.Binary

diff --git a/interop/Interop/Server.hs b/interop/Interop/Server.hs
@@ -66,7 +66,7 @@ services =
 withInteropServer :: Cmdline -> (RunningServer -> IO a) -> IO a
 withInteropServer cmdline k = do
     server <- mkGrpcServer serverParams $ fromServices services
-    forkServer serverConfig server k
+    forkServer serverParams serverConfig server k
   where
     serverConfig :: ServerConfig
     serverConfig

diff --git a/kvstore/KVStore/Server.hs b/kvstore/KVStore/Server.hs
@@ -29,7 +29,7 @@ withKeyValueServer cmdline@Cmdline{cmdJSON} k = do
           | otherwise = Protobuf.server $ handlers cmdline store
 
     server <- mkGrpcServer params rpcHandlers
-    forkServer config server k
+    forkServer params config server k
   where
     config :: ServerConfig
     config = ServerConfig {

diff --git a/src/Network/GRPC/Client/Connection.hs b/src/Network/GRPC/Client/Connection.hs
@@ -47,6 +47,7 @@ import Network.GRPC.Client.Meta qualified as Meta
 import Network.GRPC.Client.Session
 import Network.GRPC.Common.Compression qualified as Compr
 import Network.GRPC.Common.Compression qualified as Compression
+import Network.GRPC.Common.HTTP2Settings
 import Network.GRPC.Spec
 import Network.GRPC.Util.GHC
 import Network.GRPC.Util.HTTP2.Stream (ServerDisconnected(..))
@@ -140,21 +141,7 @@ data ConnParams = ConnParams {
       -- messages sent by the client to the server.
     , connInitCompression :: Maybe Compression
 
-      -- | Override ping rate limit
-      --
-      -- The @http2@ library imposes a ping rate limit as a security measure
-      -- against
-      -- [CVE-2019-9512](https://www.cve.org/CVERecord?id=CVE-2019-9512). By
-      -- default (as of version 5.1.2) it sets this limit at 10 pings/second. If
-      -- you find yourself being disconnected from a gRPC peer because that peer
-      -- is sending too many pings (you will see an
-      -- [EnhanceYourCalm](https://hackage.haskell.org/package/http2-5.1.2/docs/Network-HTTP2-Client.html#t:ErrorCode)
-      -- exception, corresponding to the
-      -- [ENHANCE_YOUR_CALM](https://www.rfc-editor.org/rfc/rfc9113#ErrorCodes)
-      -- HTTP/2 error code), you may wish to increase this limit. If you are
-      -- connecting to a peer that you trust, you can set this limit to
-      -- 'maxBound' (effectively turning off protecting against ping flooding).
-    , connOverridePingRateLimit :: Maybe Int
+    , connHTTP2Settings :: HTTP2Settings
     }
 
 instance Default ConnParams where
@@ -164,7 +151,7 @@ instance Default ConnParams where
       , connReconnectPolicy       = def
       , connContentType           = Just ContentTypeDefault
       , connInitCompression       = Nothing
-      , connOverridePingRateLimit = Nothing
+      , connHTTP2Settings         = def
       }
 
 {-------------------------------------------------------------------------------
@@ -536,10 +523,23 @@ connectInsecure connParams attempt addr =
               ConnectionReady (attemptClosed attempt) conn
           takeMVar $ attemptOutOfScope attempt
   where
+    settings :: HTTP2.Client.Settings
+    settings = HTTP2.Client.defaultSettings {
+          HTTP2.Client.maxConcurrentStreams =
+              Just . fromIntegral $
+                http2MaxConcurrentStreams (connHTTP2Settings connParams)
+        , HTTP2.Client.initialWindowSize =
+              fromIntegral $
+                http2StreamWindowSize (connHTTP2Settings connParams)
+        }
     clientConfig :: HTTP2.Client.ClientConfig
     clientConfig = overridePingRateLimit connParams $
         HTTP2.Client.defaultClientConfig {
             HTTP2.Client.authority = authority addr
+          , HTTP2.Client.settings = settings
+          , HTTP2.Client.connectionWindowSize =
+                fromIntegral $
+                  http2ConnectionWindowSize (connHTTP2Settings connParams)
           }
 
 -- | Secure connection (using TLS)
@@ -563,6 +563,16 @@ connectSecure connParams attempt validation sslKeyLog addr = do
             , HTTP2.TLS.Client.settingsCAStore       = caStore
             , HTTP2.TLS.Client.settingsKeyLogger     = keyLogger
             , HTTP2.TLS.Client.settingsAddrInfoFlags = []
+
+            , HTTP2.TLS.Client.settingsConcurrentStreams =
+                fromIntegral $
+                  http2MaxConcurrentStreams (connHTTP2Settings connParams)
+            , HTTP2.TLS.Client.settingsStreamWindowSize =
+                fromIntegral $
+                  http2StreamWindowSize (connHTTP2Settings connParams)
+            , HTTP2.TLS.Client.settingsConnectionWindowSize =
+                fromIntegral $
+                  http2ConnectionWindowSize (connHTTP2Settings connParams)
             }
 
         clientConfig :: HTTP2.Client.ClientConfig
@@ -601,7 +611,7 @@ overridePingRateLimit ::
 overridePingRateLimit connParams clientConfig = clientConfig {
       HTTP2.Client.settings = settings {
           HTTP2.Client.pingRateLimit =
-            case connOverridePingRateLimit connParams of
+            case http2OverridePingRateLimit (connHTTP2Settings connParams) of
               Nothing    -> HTTP2.Client.pingRateLimit settings
               Just limit -> limit
         }
@@ -623,6 +633,6 @@ runTCPClient Address{addressHost, addressPort} =
 -- See docs of 'confBufferSize', but importantly: "this value is announced
 -- via SETTINGS_MAX_FRAME_SIZE to the peer."
 --
--- Value of 4kB is taken from the example code.
+-- Value of 4KB is taken from the example code.
 writeBufferSize :: HPACK.BufferSize
 writeBufferSize = 4096
diff --git a/src/Network/GRPC/Common.hs b/src/Network/GRPC/Common.hs
@@ -41,9 +41,13 @@ module Network.GRPC.Common (
     -- * Configuration
   , SslKeyLog(..)
 
+  -- * HTTP\/2 Settings
+  , HTTP2Settings(..)
+
     -- * Defaults
   , defaultInsecurePort
   , defaultSecurePort
+  , defaultHTTP2Settings
 
     -- * Exceptions
 
@@ -74,6 +78,7 @@ import Network.Socket (PortNumber)
 
 import Control.Exception
 
+import Network.GRPC.Common.HTTP2Settings
 import Network.GRPC.Common.NextElem (NextElem(..))
 import Network.GRPC.Common.StreamElem (StreamElem(..))
 import Network.GRPC.Spec

diff --git a/src/Network/GRPC/Common/HTTP2Settings.hs b/src/Network/GRPC/Common/HTTP2Settings.hs
@@ -0,0 +1,91 @@
+-- | Settings and parameters pertaining to HTTP\/2
+--
+-- Intended for unqualified import.
+
+module Network.GRPC.Common.HTTP2Settings
+  ( HTTP2Settings(..)
+  , defaultHTTP2Settings
+  ) where
+
+import Data.Default
+import Data.Word
+
+-- | HTTP\/2 settings
+data HTTP2Settings = HTTP2Settings {
+      -- | Maximum number of concurrent active streams
+      --
+      -- <https://datatracker.ietf.org/doc/html/rfc7540#section-5.1.2>
+      http2MaxConcurrentStreams :: Word32
+
+      -- | Window size for streams
+      --
+      -- <https://datatracker.ietf.org/doc/html/rfc7540#section-6.9.2>
+    , http2StreamWindowSize :: Word32
+
+      -- | Connection window size
+      --
+      -- This value is broadcast via a @WINDOW_UDPATE@ frame at the beginning of
+      -- a new connection.
+      --
+      -- If the consumed window space of all streams exceeds this value, the
+      -- sender will stop sending data. Therefore, if this value is less than
+      -- @'http2MaxConcurrentStreams' * 'http2StreamWindowSize'@, there is risk
+      -- of a control flow deadlock, since the connection window space may be
+      -- used up by streams that we are not yet processing before we have
+      -- received all data on the streams that we /are/ processing. To reduce
+      -- this risk, increase
+      -- 'Network.GRPC.Server.Run.serverOverrideNumberOfWorkers' for the server.
+      -- See <https://github.com/kazu-yamamoto/network-control/pull/4> for more
+      -- information.
+    , http2ConnectionWindowSize :: Word32
+
+      -- | Ping rate limit
+      --
+      -- This setting is specific to the [@http2@
+      -- package's](https://hackage.haskell.org/package/http2) implementation of
+      -- the HTTP\/2 specification. In particular, the library imposes a ping
+      -- rate limit as a security measure against
+      -- [CVE-2019-9512](https://www.cve.org/CVERecord?id=CVE-2019-9512). By
+      -- default (as of version 5.1.2) it sets this limit at 10 pings/second. If
+      -- you find yourself being disconnected from a gRPC peer because that peer
+      -- is sending too many pings (you will see an
+      -- [EnhanceYourCalm](https://hackage.haskell.org/package/http2-5.1.2/docs/Network-HTTP2-Client.html#t:ErrorCode)
+      -- exception, corresponding to the
+      -- [ENHANCE_YOUR_CALM](https://www.rfc-editor.org/rfc/rfc9113#ErrorCodes)
+      -- HTTP\/2 error code), you may wish to increase this limit. If you are
+      -- connecting to a peer that you trust, you can set this limit to
+      -- 'maxBound' (effectively turning off protecting against ping flooding).
+    , http2OverridePingRateLimit :: Maybe Int
+    }
+  deriving (Show)
+
+-- | Default HTTP\/2 settings
+--
+-- [Section 6.5.2 of the HTTP\/2
+-- specification](https://datatracker.ietf.org/doc/html/rfc7540#section-6.5.2)
+-- recommends that the @SETTINGS_MAX_CONCURRENT_STREAMS@ parameter be no smaller
+-- than 100 "so as not to unnecessarily limit parallelism", so we default to
+-- 128.
+--
+-- The default initial stream window size (corresponding to the
+-- @SETTINGS_INITIAL_WINDOW_SIZE@ HTTP\/2 parameter) is 64KB.
+--
+-- The default connection window size is 128 * 64KB to avoid the control flow
+-- deadlock discussed at 'http2ConnectionWindowSize'.
+--
+-- The ping rate limit imposed by the [@http2@
+-- package](https://hackage.haskell.org/package/http2) is not overridden by
+-- default.
+defaultHTTP2Settings :: HTTP2Settings
+defaultHTTP2Settings = HTTP2Settings {
+      http2MaxConcurrentStreams  = defMaxConcurrentStreams
+    , http2StreamWindowSize      = defInitialStreamWindowSize
+    , http2ConnectionWindowSize  = defMaxConcurrentStreams * defInitialStreamWindowSize
+    , http2OverridePingRateLimit = Nothing
+    }
+  where
+    defMaxConcurrentStreams    = 128
+    defInitialStreamWindowSize = 1024 * 64
+
+instance Default HTTP2Settings where
+  def = defaultHTTP2Settings
diff --git a/src/Network/GRPC/Server.hs b/src/Network/GRPC/Server.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 module Network.GRPC.Server (
     -- * Server proper
     mkGrpcServer

diff --git a/src/Network/GRPC/Server/Context.hs b/src/Network/GRPC/Server/Context.hs
@@ -15,6 +15,7 @@ import Control.Monad.XIO qualified as XIO
 import Data.Default
 import System.IO
 
+import Network.GRPC.Common
 import Network.GRPC.Common.Compression qualified as Compr
 import Network.GRPC.Server.RequestHandler.API
 import Network.GRPC.Spec
@@ -83,15 +84,33 @@ data ServerParams = ServerParams {
       -- headers are valid. By default we do /not/ do this, throwing an error
       -- only in scenarios where we really cannot continue.
     , serverVerifyHeaders :: Bool
+
+      -- | Number of threads that will be spawned to process incoming frames
+      -- on the currently active HTTP\/2 streams
+      --
+      -- This setting is specific to the
+      -- [http2](https://hackage.haskell.org/package/http2) package's
+      -- implementation of the HTTP\/2 specification for servers. Set to
+      -- 'Nothing' if you don't want to override the default.
+      --
+      -- __Note__: If a lower 'http2ConnectionWindowSize' is desired, the
+      -- number of workers should be increased to avoid a potential HTTP\/2
+      -- control flow deadlock.
+    , serverOverrideNumberOfWorkers :: Maybe Word
+
+      -- | HTTP\/2 settings
+    , serverHTTP2Settings :: HTTP2Settings
     }
 
 instance Default ServerParams where
   def = ServerParams {
-        serverCompression       = def
-      , serverTopLevel          = defaultServerTopLevel
-      , serverExceptionToClient = defaultServerExceptionToClient
-      , serverContentType       = Just ContentTypeDefault
-      , serverVerifyHeaders     = False
+        serverCompression             = def
+      , serverTopLevel                = defaultServerTopLevel
+      , serverExceptionToClient       = defaultServerExceptionToClient
+      , serverContentType             = Just ContentTypeDefault
+      , serverVerifyHeaders           = False
+      , serverOverrideNumberOfWorkers = Nothing
+      , serverHTTP2Settings           = def
       }
 
 defaultServerTopLevel ::