diff --git a/grapesy/grapesy.cabal b/grapesy/grapesy.cabal index b7194db0..7e0fa0e6 100644 --- a/grapesy/grapesy.cabal +++ b/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 diff --git a/grapesy/interop/Interop/Server.hs b/grapesy/interop/Interop/Server.hs index b2f87a12..2822d2d4 100644 --- a/grapesy/interop/Interop/Server.hs +++ b/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 diff --git a/grapesy/kvstore/KVStore/Server.hs b/grapesy/kvstore/KVStore/Server.hs index 168efec5..ab2e0340 100644 --- a/grapesy/kvstore/KVStore/Server.hs +++ b/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 } {------------------------------------------------------------------------------- diff --git a/grapesy/src/Network/GRPC/Server/Context.hs b/grapesy/src/Network/GRPC/Server/Context.hs index e7230bfb..5fbe41e8 100644 --- a/grapesy/src/Network/GRPC/Server/Context.hs +++ b/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 () diff --git a/grapesy/src/Network/GRPC/Server/Run.hs b/grapesy/src/Network/GRPC/Server/Run.hs index 7fb7bf5a..af110832 100644 --- a/grapesy/src/Network/GRPC/Server/Run.hs +++ b/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,10 +123,12 @@ 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 @@ -133,7 +136,10 @@ runServerWithHandlers :: -> 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,12 +174,12 @@ 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 @@ -181,11 +187,11 @@ forkServer params ServerConfig{serverInsecure, serverSecure} server k = do 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 diff --git a/grapesy/test-grapesy/Test/Driver/ClientServer.hs b/grapesy/test-grapesy/Test/Driver/ClientServer.hs index bbde47ca..7959ac0e 100644 --- a/grapesy/test-grapesy/Test/Driver/ClientServer.hs +++ b/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