Merge pull request #260 from well-typed/edsko/http2settings

Remove `HTTP2Settings` from `ServerParams`

grapesy/grapesy.cabal

@@ -155,7 +155,6 @@ library
     , exceptions           >= 0.10    && < 0.11
     , grpc-spec            >= 0.1     && < 0.2
     , http-types           >= 0.12    && < 0.13
-    , http2                >= 5.3.4   && < 5.4
     , http2-tls            >= 0.4.1   && < 0.5
     , lens                 >= 5.0     && < 5.4
     , mtl                  >= 2.2     && < 2.4
@@ -172,6 +171,12 @@ library
     , unordered-containers >= 0.2     && < 0.3
     , utf8-string          >= 1.0     && < 1.1
 
+      -- We pin a very specific vrsion of http2.
+      --
+      -- Other versions should be tested against the full grapesy test suite
+      -- (regular tests and stress tests).
+    , http2 == 5.3.5
+
 test-suite test-record-dot
   import:         lang, common-executable-flags
   type:           exitcode-stdio-1.0

grapesy/interop/Interop/Server.hs

@@ -67,7 +67,7 @@ services =
 withInteropServer :: Cmdline -> (RunningServer -> IO a) -> IO a
 withInteropServer cmdline k = do
     server <- mkGrpcServer serverParams $ fromServices services
-    forkServer serverParams serverConfig server k
+    forkServer def serverConfig server k
   where
     serverConfig :: ServerConfig
     serverConfig

grapesy/kvstore/KVStore/Server.hs

@@ -57,20 +57,21 @@ withKeyValueServer cmdline@Cmdline{
           | otherwise = Protobuf.server $ handlers cmdline store
 
     server <- mkGrpcServer params rpcHandlers
-    forkServer params config server k
+    forkServer http2 config server k
   where
+    http2 :: HTTP2Settings
+    http2 = def {
+          http2TcpNoDelay            = not cmdDisableTcpNoDelay
+        , http2OverridePingRateLimit = cmdPingRateLimit
+        }
+
     params :: ServerParams
     params = def {
-          serverHTTP2Settings = def {
-              http2TcpNoDelay            = not cmdDisableTcpNoDelay
-            , http2OverridePingRateLimit = cmdPingRateLimit
-            }
-
           -- The Java benchmark does not use compression (unclear if the Java
           -- implementation supports compression at all; the compression Interop
           -- tests are also disabled for Java). For a fair comparison, we
           -- therefore disable compression here also.
-        , serverCompression = Compr.none
+          serverCompression = Compr.none
         }
 
 {-------------------------------------------------------------------------------

grapesy/src/Network/GRPC/Server/Context.hs

@@ -83,9 +83,6 @@ data ServerParams = ServerParams {
       -- (merely that the metadata is syntactically correct). See
       -- 'Network.GRPC.Server.getRequestMetadata' for detailed discussion.
     , serverVerifyHeaders :: Bool
-
-      -- | HTTP\/2 settings
-    , serverHTTP2Settings :: HTTP2Settings
     }
 
 instance Default ServerParams where
@@ -95,7 +92,6 @@ instance Default ServerParams where
       , serverExceptionToClient = defaultServerExceptionToClient
       , serverContentType       = Just ContentTypeDefault
       , serverVerifyHeaders     = False
-      , serverHTTP2Settings     = def
       }
 
 defaultServerTopLevel :: RequestHandler () -> RequestHandler ()

grapesy/src/Network/GRPC/Server/Run.hs

@@ -29,6 +29,7 @@ import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Exception
 import Control.Monad
+import Data.Default
 import Network.HTTP2.Server qualified as HTTP2
 import Network.HTTP2.TLS.Server qualified as HTTP2.TLS
 import Network.Run.TCP qualified as Run
@@ -122,18 +123,23 @@ data SecureConfig = SecureConfig {
 --
 -- See also 'runServerWithHandlers', which handles the creation of the
 -- 'HTTP2.Server' for you.
-runServer :: ServerParams -> ServerConfig -> HTTP2.Server -> IO ()
-runServer params cfg server = forkServer params cfg server $ waitServer
+runServer :: HTTP2Settings -> ServerConfig -> HTTP2.Server -> IO ()
+runServer http2 cfg server = forkServer http2 cfg server $ waitServer
 
 -- | Convenience function that combines 'runServer' with 'mkGrpcServer'
+--
+-- NOTE: If you want to override the 'HTTP2Settings', use 'runServer' instead.
 runServerWithHandlers ::
      ServerParams
   -> ServerConfig
   -> [SomeRpcHandler IO]
   -> IO ()
 runServerWithHandlers params config handlers = do
     server <- mkGrpcServer params handlers
-    runServer params config server
+    runServer http2 config server
+  where
+    http2 :: HTTP2Settings
+    http2 = def
 
 {-------------------------------------------------------------------------------
   Full interface
@@ -168,24 +174,24 @@ data ServerTerminated = ServerTerminated
 
 -- | Start the server
 forkServer ::
-     ServerParams
+     HTTP2Settings
   -> ServerConfig
   -> HTTP2.Server
   -> (RunningServer -> IO a)
   -> IO a
-forkServer params ServerConfig{serverInsecure, serverSecure} server k = do
+forkServer http2 ServerConfig{serverInsecure, serverSecure} server k = do
     runningSocketInsecure <- newEmptyTMVarIO
     runningSocketSecure   <- newEmptyTMVarIO
 
     let secure, insecure :: IO ()
         insecure =
           case serverInsecure of
             Nothing  -> return ()
-            Just cfg -> runInsecure params cfg runningSocketInsecure server
+            Just cfg -> runInsecure http2 cfg runningSocketInsecure server
         secure =
           case serverSecure of
             Nothing  -> return ()
-            Just cfg -> runSecure params cfg runningSocketSecure server
+            Just cfg -> runSecure http2 cfg runningSocketSecure server
 
     withAsync insecure $ \runningServerInsecure ->
       withAsync secure $ \runningServerSecure ->
@@ -284,44 +290,42 @@ getSocket serverAsync socketTMVar = do
 -------------------------------------------------------------------------------}
 
 runInsecure ::
-     ServerParams
+     HTTP2Settings
   -> InsecureConfig
   -> TMVar Socket
   -> HTTP2.Server
   -> IO ()
-runInsecure params cfg socketTMVar server = do
+runInsecure http2 cfg socketTMVar server = do
     withServerSocket
-        serverHTTP2Settings
+        http2
         socketTMVar
         (insecureHost cfg)
         (insecurePort cfg) $ \listenSock ->
       withTimeManager $ \mgr ->
         Run.runTCPServerWithSocket listenSock $ \clientSock -> do
-          when (http2TcpNoDelay serverHTTP2Settings) $ do
+          when (http2TcpNoDelay http2) $ do
             -- See description of 'withServerSocket'
             setSocketOption clientSock NoDelay 1
-          when (http2TcpAbortiveClose serverHTTP2Settings) $ do
+          when (http2TcpAbortiveClose http2) $ do
             setSockOpt clientSock Linger
               (StructLinger { sl_onoff = 1, sl_linger = 0 })
           withConfigForInsecure mgr clientSock $ \config ->
             HTTP2.run serverConfig config server
   where
-    ServerParams{serverHTTP2Settings} = params
-
     serverConfig :: HTTP2.ServerConfig
-    serverConfig = mkServerConfig serverHTTP2Settings
+    serverConfig = mkServerConfig http2
 
 {-------------------------------------------------------------------------------
   Secure (over TLS)
 -------------------------------------------------------------------------------}
 
 runSecure ::
-     ServerParams
+     HTTP2Settings
   -> SecureConfig
   -> TMVar Socket
   -> HTTP2.Server
   -> IO ()
-runSecure params cfg socketTMVar server = do
+runSecure http2 cfg socketTMVar server = do
     cred :: TLS.Credential <-
           TLS.credentialLoadX509Chain
             (securePubCert    cfg)
@@ -333,13 +337,13 @@ runSecure params cfg socketTMVar server = do
 
     keyLogger <- Util.TLS.keyLogger (secureSslKeyLog cfg)
     let serverConfig :: HTTP2.ServerConfig
-        serverConfig = mkServerConfig serverHTTP2Settings
+        serverConfig = mkServerConfig http2
 
         tlsSettings :: HTTP2.TLS.Settings
-        tlsSettings = mkTlsSettings serverHTTP2Settings keyLogger
+        tlsSettings = mkTlsSettings http2 keyLogger
 
     withServerSocket
-        serverHTTP2Settings
+        http2
         socketTMVar
         (Just $ secureHost cfg)
         (securePort cfg) $ \listenSock ->
@@ -348,16 +352,14 @@ runSecure params cfg socketTMVar server = do
           (TLS.Credentials [cred])
           listenSock
           "h2" $ \mgr backend -> do
-        when (http2TcpNoDelay serverHTTP2Settings) $
+        when (http2TcpNoDelay http2) $
           -- See description of 'withServerSocket'
           setSocketOption (HTTP2.TLS.requestSock backend) NoDelay 1
-        when (http2TcpAbortiveClose serverHTTP2Settings) $ do
+        when (http2TcpAbortiveClose http2) $ do
           setSockOpt (HTTP2.TLS.requestSock backend) Linger
             (StructLinger { sl_onoff = 1, sl_linger = 0 })
         withConfigForSecure mgr backend $ \config ->
           HTTP2.run serverConfig config server
-  where
-    ServerParams{serverHTTP2Settings} = params
 
 data CouldNotLoadCredentials =
     -- | Failed to load server credentials

grapesy/test-grapesy/Test/Driver/ClientServer.hs

@@ -482,7 +482,7 @@ withTestServer cfg firstTestFailure handlerLock serverHandlers k = do
             }
 
     server <- Server.mkGrpcServer serverParams serverHandlers
-    Server.forkServer serverParams serverConfig server k
+    Server.forkServer def serverConfig server k
 
 {-------------------------------------------------------------------------------
   Client