From 44b352e180f1df344690537deba72097f0d7024a Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Thu, 4 Jul 2024 11:15:50 +0200 Subject: [PATCH] Enable `TCP_NODELAY`, alternative approach --- .github/workflows/haskell-ci.yml | 10 ++++ cabal.project | 11 +++++ cabal.project.ci | 10 ++++ grapesy.cabal | 8 ++- kvstore/KVStore/Client.hs | 34 ++++++++++--- kvstore/KVStore/Cmdline.hs | 18 +++++-- kvstore/KVStore/Server.hs | 41 ++++++++++++--- src/Network/GRPC/Client/Connection.hs | 61 +++++++++++++++-------- src/Network/GRPC/Common/HTTP2Settings.hs | 32 ++++++++++++ src/Network/GRPC/Server/Run.hs | 63 ++++++++++++++++-------- 10 files changed, 226 insertions(+), 62 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index da22a3f9..bac9444f 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -175,6 +175,16 @@ jobs: allow-newer: proto-lens:base allow-newer: proto-lens-runtime:base + source-repository-package + type: git + location: https://github.com/kazu-yamamoto/network-run + tag: 914e16ce1f819ac3e5e1343c0bce8c11cd83e0cb + + source-repository-package + type: git + location: https://github.com/kazu-yamamoto/http2-tls + tag: 6ecea0f22a576c3f0dcbb9efd7a402919bf4ad10 + package grapesy tests: True benchmarks: True diff --git a/cabal.project b/cabal.project index 92172526..da051755 100644 --- a/cabal.project +++ b/cabal.project @@ -5,6 +5,17 @@ package grapesy benchmarks: True flags: +build-demo +build-stress-test +snappy + +source-repository-package + type: git + location: https://github.com/kazu-yamamoto/network-run + tag: 914e16ce1f819ac3e5e1343c0bce8c11cd83e0cb + +source-repository-package + type: git + location: https://github.com/kazu-yamamoto/http2-tls + tag: 6ecea0f22a576c3f0dcbb9efd7a402919bf4ad10 + -- -- ghc 9.10 -- diff --git a/cabal.project.ci b/cabal.project.ci index bee011df..9dc03fd1 100644 --- a/cabal.project.ci +++ b/cabal.project.ci @@ -6,6 +6,16 @@ package grapesy flags: +build-demo +build-stress-test +snappy +strace ghc-options: -Werror +source-repository-package + type: git + location: https://github.com/kazu-yamamoto/network-run + tag: 914e16ce1f819ac3e5e1343c0bce8c11cd83e0cb + +source-repository-package + type: git + location: https://github.com/kazu-yamamoto/http2-tls + tag: 6ecea0f22a576c3f0dcbb9efd7a402919bf4ad10 + -- -- ghc 9.10 -- diff --git a/grapesy.cabal b/grapesy.cabal index 90e52010..393fe1b0 100644 --- a/grapesy.cabal +++ b/grapesy.cabal @@ -206,12 +206,12 @@ library , hashable >= 1.3 && < 1.5 , http-types >= 0.12 && < 0.13 , http2 >= 5.2.4 && < 5.3 - , http2-tls >= 0.2.11 && < 0.4 + , http2-tls >= 0.4 && < 0.5 , lens >= 5.0 && < 5.4 , mtl >= 2.2 && < 2.4 , network >= 3.1 && < 3.3 , network-byte-order >= 0.1 && < 0.2 - , network-run >= 0.2.7 && < 0.4 + , network-run >= 0.4 && < 0.5 , proto-lens >= 0.7 && < 0.8 , proto-lens-runtime >= 0.7 && < 0.8 , random >= 1.2 && < 1.3 @@ -576,6 +576,10 @@ benchmark grapesy-kvstore KVStore.Util.Store Proto.Kvstore + + Paths_grapesy + autogen-modules: + Paths_grapesy build-depends: grapesy build-depends: diff --git a/kvstore/KVStore/Client.hs b/kvstore/KVStore/Client.hs index 96cd6400..9b6e8a7e 100644 --- a/kvstore/KVStore/Client.hs +++ b/kvstore/KVStore/Client.hs @@ -89,7 +89,11 @@ showStats Cmdline{cmdDuration} stats = unlines [ -- separate thread, and kill the thread after some amount of time. The number -- of RPC calls made can then be read off from the 'IORef'. client :: Cmdline -> IORef Stats -> IO () -client Cmdline{cmdJSON} statsVar = do +client Cmdline{ + cmdJSON + , cmdSecure + , cmdDisableTcpNoDelay + } statsVar = do knownKeys <- RandomAccessSet.new random <- RandomGen.new @@ -120,14 +124,30 @@ client Cmdline{cmdJSON} statsVar = do _ -> error "impossible" where params :: ConnParams - params = def + params = def { + connHTTP2Settings = def { + http2TcpNoDelay = not cmdDisableTcpNoDelay + } + } server :: Server - server = ServerInsecure $ Address { - addressHost = "127.0.0.1" - , addressPort = defaultInsecurePort - , addressAuthority = Nothing - } + server + | cmdSecure + = ServerSecure + NoServerValidation + SslKeyLogNone -- Let the server write the log + Address { + addressHost = "127.0.0.1" + , addressPort = defaultSecurePort + , addressAuthority = Nothing + } + + | otherwise + = ServerInsecure $ Address { + addressHost = "127.0.0.1" + , addressPort = defaultInsecurePort + , addressAuthority = Nothing + } {------------------------------------------------------------------------------- Access the various server features diff --git a/kvstore/KVStore/Cmdline.hs b/kvstore/KVStore/Cmdline.hs index c6b127d7..bb6cf72c 100644 --- a/kvstore/KVStore/Cmdline.hs +++ b/kvstore/KVStore/Cmdline.hs @@ -13,10 +13,12 @@ import Options.Applicative qualified as Opt -------------------------------------------------------------------------------} data Cmdline = Cmdline { - cmdMode :: Mode - , cmdDuration :: Int - , cmdSimulateWork :: Bool - , cmdJSON :: Bool + cmdMode :: Mode + , cmdDuration :: Int + , cmdSimulateWork :: Bool + , cmdJSON :: Bool + , cmdSecure :: Bool + , cmdDisableTcpNoDelay :: Bool } data Mode = @@ -59,6 +61,14 @@ parseCmdline = Opt.long "json" , Opt.help "Use JSON instead of Protobuf" ]) + <*> (Opt.switch $ mconcat [ + Opt.long "secure" + , Opt.help "Enable TLS" + ]) + <*> (Opt.switch $ mconcat [ + Opt.long "disable-tcp-nodelay" + , Opt.help "Disable the TCP_NODELAY option" + ]) parseMode :: Parser Mode parseMode = asum [ diff --git a/kvstore/KVStore/Server.hs b/kvstore/KVStore/Server.hs index ae91c081..2463f435 100644 --- a/kvstore/KVStore/Server.hs +++ b/kvstore/KVStore/Server.hs @@ -15,14 +15,41 @@ import KVStore.Cmdline import KVStore.Util.Store (Store) import KVStore.Util.Store qualified as Store +import Paths_grapesy + {------------------------------------------------------------------------------- Server proper -------------------------------------------------------------------------------} withKeyValueServer :: Cmdline -> (RunningServer -> IO ()) -> IO () -withKeyValueServer cmdline@Cmdline{cmdJSON} k = do +withKeyValueServer cmdline@Cmdline{ + cmdJSON + , cmdSecure + , cmdDisableTcpNoDelay + } k = do store <- Store.new + config :: ServerConfig <- + if cmdSecure then do + pub <- getDataFileName "grpc-demo.pem" + priv <- getDataFileName "grpc-demo.key" + return ServerConfig { + serverInsecure = Nothing + , serverSecure = Just $ SecureConfig { + secureHost = "0.0.0.0" + , securePort = defaultSecurePort + , securePubCert = pub + , secureChainCerts = [] + , securePrivKey = priv + , secureSslKeyLog = SslKeyLogFromEnv + } + } + else + return ServerConfig { + serverInsecure = Just $ InsecureConfig Nothing defaultInsecurePort + , serverSecure = Nothing + } + let rpcHandlers :: [SomeRpcHandler IO] rpcHandlers | cmdJSON = JSON.server $ handlers cmdline store @@ -31,19 +58,17 @@ withKeyValueServer cmdline@Cmdline{cmdJSON} k = do server <- mkGrpcServer params rpcHandlers forkServer params config server k where - config :: ServerConfig - config = ServerConfig { - serverInsecure = Just $ InsecureConfig Nothing defaultInsecurePort - , serverSecure = Nothing - } - params :: ServerParams params = def { + serverHTTP2Settings = def { + http2TcpNoDelay = not cmdDisableTcpNoDelay + } + -- 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/src/Network/GRPC/Client/Connection.hs b/src/Network/GRPC/Client/Connection.hs index c8832375..1e1aff73 100644 --- a/src/Network/GRPC/Client/Connection.hs +++ b/src/Network/GRPC/Client/Connection.hs @@ -141,6 +141,7 @@ data ConnParams = ConnParams { -- messages sent by the client to the server. , connInitCompression :: Maybe Compression + -- | HTTP2 settings , connHTTP2Settings :: HTTP2Settings } @@ -512,8 +513,11 @@ stayConnected connParams server connStateVar connOutOfScope = -- | Insecure connection (no TLS) connectInsecure :: ConnParams -> Attempt -> Address -> IO () -connectInsecure connParams attempt addr = - runTCPClient addr $ \sock -> do +connectInsecure connParams attempt addr = do + Run.runTCPClientWithSettings + runSettings + (addressHost addr) + (show $ addressPort addr) $ \sock -> bracket (HTTP2.Client.allocSimpleConfig sock writeBufferSize) HTTP2.Client.freeSimpleConfig $ \conf -> HTTP2.Client.run clientConfig conf $ \sendRequest _aux -> do @@ -523,15 +527,23 @@ connectInsecure connParams attempt addr = ConnectionReady (attemptClosed attempt) conn takeMVar $ attemptOutOfScope attempt where + ConnParams{connHTTP2Settings} = connParams + + runSettings :: Run.Settings + runSettings = Run.defaultSettings { + Run.settingsOpenClientSocket = openClientSocket connHTTP2Settings + } + settings :: HTTP2.Client.Settings settings = HTTP2.Client.defaultSettings { HTTP2.Client.maxConcurrentStreams = Just . fromIntegral $ - http2MaxConcurrentStreams (connHTTP2Settings connParams) + http2MaxConcurrentStreams connHTTP2Settings , HTTP2.Client.initialWindowSize = fromIntegral $ - http2StreamWindowSize (connHTTP2Settings connParams) + http2StreamWindowSize connHTTP2Settings } + clientConfig :: HTTP2.Client.ClientConfig clientConfig = overridePingRateLimit connParams $ HTTP2.Client.defaultClientConfig { @@ -539,7 +551,7 @@ connectInsecure connParams attempt addr = , HTTP2.Client.settings = settings , HTTP2.Client.connectionWindowSize = fromIntegral $ - http2ConnectionWindowSize (connHTTP2Settings connParams) + http2ConnectionWindowSize connHTTP2Settings } -- | Secure connection (using TLS) @@ -560,19 +572,19 @@ connectSecure connParams attempt validation sslKeyLog addr = do case validation of ValidateServer _ -> True NoServerValidation -> False - , 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) + , HTTP2.TLS.Client.settingsCAStore = caStore + , HTTP2.TLS.Client.settingsKeyLogger = keyLogger + , HTTP2.TLS.Client.settingsAddrInfoFlags = [] + + , HTTP2.TLS.Client.settingsOpenClientSocket = + openClientSocket connHTTP2Settings + , HTTP2.TLS.Client.settingsConcurrentStreams = fromIntegral $ + http2MaxConcurrentStreams connHTTP2Settings + , HTTP2.TLS.Client.settingsStreamWindowSize = fromIntegral $ + http2StreamWindowSize connHTTP2Settings + , HTTP2.TLS.Client.settingsConnectionWindowSize = fromIntegral $ + http2ConnectionWindowSize connHTTP2Settings } clientConfig :: HTTP2.Client.ClientConfig @@ -592,6 +604,8 @@ connectSecure connParams attempt validation sslKeyLog addr = do writeTVar (attemptState attempt) $ ConnectionReady (attemptClosed attempt) conn takeMVar $ attemptOutOfScope attempt + where + ConnParams{connHTTP2Settings} = connParams -- | Authority -- @@ -624,9 +638,16 @@ overridePingRateLimit connParams clientConfig = clientConfig { Auxiliary http2 -------------------------------------------------------------------------------} -runTCPClient :: Address -> (Socket -> IO a) -> IO a -runTCPClient Address{addressHost, addressPort} = - Run.runTCPClient addressHost (show addressPort) +openClientSocket :: HTTP2Settings -> AddrInfo -> IO Socket +openClientSocket http2Settings = + Run.openClientSocketWithOptions socketOptions + where + socketOptions :: [(SocketOption, Int)] + socketOptions = concat [ + [ (NoDelay, 1) + | http2TcpNoDelay http2Settings + ] + ] -- | Write-buffer size -- diff --git a/src/Network/GRPC/Common/HTTP2Settings.hs b/src/Network/GRPC/Common/HTTP2Settings.hs index b08245c0..76e92119 100644 --- a/src/Network/GRPC/Common/HTTP2Settings.hs +++ b/src/Network/GRPC/Common/HTTP2Settings.hs @@ -56,6 +56,37 @@ data HTTP2Settings = HTTP2Settings { -- connecting to a peer that you trust, you can set this limit to -- 'maxBound' (effectively turning off protecting against ping flooding). , http2OverridePingRateLimit :: Maybe Int + + -- | Enable @TCP_NODELAY@ + -- + -- Send out TCP segments as soon as possible, even if there is only a + -- small amount of data. + -- + -- When @TCP_NODELAY@ is /NOT/ set, the TCP implementation will wait to + -- send a TCP segment to the receiving peer until either (1) there is + -- enough data to fill a certain minimum segment size or (2) we receive an + -- ACK from the receiving peer for data we sent previously. This adds a + -- network roundtrip delay to every RPC message we want to send (to + -- receive the ACK). If the peer uses TCP delayed acknowledgement, which + -- will typically be the case, then this delay will increase further + -- still; default for delayed acknowledgement is 40ms, thus resulting in a + -- theoretical maximum of 25 RPCs/sec. + -- + -- We therefore enable TCP_NODELAY by default, so that data is sent to the + -- peer as soon as we have an entire gRPC message serialized and ready to + -- send (we send the data to the TCP layer only once an entire message is + -- written, or the @http2@ write buffer is full). + -- + -- Turning this off /could/ improve throughput, as fewer TCP segments will + -- be needed, but you probably only want to do this if you send very few + -- very large RPC messages. In gRPC this is anyway discouraged, because + -- gRPC messages do not support incremental (de)serialization; if you need + -- to send large amounts of data, it is preferable to split these into + -- many, smaller, gRPC messages; this also gives the application the + -- possibility of reporting on data transmission progress. + -- + -- TL;DR: leave this at the default unless you know what you are doing. + , http2TcpNoDelay :: Bool } deriving (Show) @@ -82,6 +113,7 @@ defaultHTTP2Settings = HTTP2Settings { , http2StreamWindowSize = defInitialStreamWindowSize , http2ConnectionWindowSize = defMaxConcurrentStreams * defInitialStreamWindowSize , http2OverridePingRateLimit = Nothing + , http2TcpNoDelay = True } where defMaxConcurrentStreams = 128 diff --git a/src/Network/GRPC/Server/Run.hs b/src/Network/GRPC/Server/Run.hs index ce7f7a6f..1756ea44 100644 --- a/src/Network/GRPC/Server/Run.hs +++ b/src/Network/GRPC/Server/Run.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + #include "MachDeps.h" -- | Convenience functions for running a HTTP2 server @@ -290,14 +292,20 @@ runInsecure :: -> TMVar Socket -> HTTP2.Server -> IO () -runInsecure params cfg socketTMVar server = - Run.runTCPServerWithSocket - (openServerSocket socketTMVar) +runInsecure params cfg socketTMVar server = do + withServerSocket + serverHTTP2Settings + socketTMVar (insecureHost cfg) - (show $ insecurePort cfg) $ \sock -> do - bracket (allocConfigWithTimeout sock writeBufferSize disableTimeout) - HTTP2.freeSimpleConfig $ \config -> - HTTP2.run serverConfig config server + (insecurePort cfg) $ \sock -> + Run.runTCPServerWithSocket sock $ \clientSock -> + bracket ( allocConfigWithTimeout + clientSock + writeBufferSize + disableTimeout + ) + HTTP2.freeSimpleConfig $ \config -> + HTTP2.run serverConfig config server where ServerParams{ serverOverrideNumberOfWorkers @@ -348,8 +356,6 @@ runSecure params cfg socketTMVar server = do settings = HTTP2.TLS.defaultSettings { HTTP2.TLS.settingsKeyLogger = keyLogger - , HTTP2.TLS.settingsOpenServerSocket = - openServerSocket socketTMVar , HTTP2.TLS.settingsTimeout = disableTimeout , HTTP2.TLS.settingsNumberOfWorkers = @@ -364,12 +370,12 @@ runSecure params cfg socketTMVar server = do fromIntegral $ http2MaxConcurrentStreams serverHTTP2Settings } - HTTP2.TLS.run - settings - (TLS.Credentials [cred]) - (secureHost cfg) - (securePort cfg) - server + withServerSocket + serverHTTP2Settings + socketTMVar + (Just $ secureHost cfg) + (securePort cfg) $ \sock -> + HTTP2.TLS.runWithSocket settings (TLS.Credentials [cred]) sock server where ServerParams{ serverOverrideNumberOfWorkers @@ -408,11 +414,26 @@ disableTimeout = 30 * 60 #endif -openServerSocket :: TMVar Socket -> AddrInfo -> IO Socket -openServerSocket socketTMVar addr = do - sock <- Run.openServerSocket addr - atomically $ putTMVar socketTMVar sock - return sock +withServerSocket :: + HTTP2Settings + -> TMVar Socket + -> Maybe HostName + -> PortNumber + -> (Socket -> IO a) + -> IO a +withServerSocket http2Settings socketTMVar host port k = do + addr <- Run.resolve Stream host (show port) [AI_PASSIVE] + bracket (openServerSocket addr) close $ \sock -> do + atomically $ putTMVar socketTMVar sock + k sock + where + -- TODO: Check inheritance of TCP_NODELAY + openServerSocket :: AddrInfo -> IO Socket + openServerSocket = Run.openTCPServerSocketWithOptions $ concat [ + [ (NoDelay, 1) + | http2TcpNoDelay http2Settings + ] + ] writeBufferSize :: BufferSize writeBufferSize = 4096