WIP: Enable TCP_NODELAY

This should be optional; for now we're just testing if this works at all.
well-typed · Jul 4, 2024 · e5e16a1 · e5e16a1
1 parent 6a972f1
commit e5e16a1
Show file tree

Hide file tree

Showing 6 changed files with 49 additions and 7 deletions.
diff --git 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/edsko/network-run
+            tag:      70211ef61ebbf178d6681ec37d3293d720ec9030
+
+          source-repository-package
+            type:     git
+            location: https://github.com/edsko/http2-tls
+            tag:      53d8b7a0d2a044606de0906e5b66a1f2bce549bd
+
           package grapesy
             tests:       True
             benchmarks:  True

diff --git a/cabal.project b/cabal.project
@@ -5,6 +5,16 @@ package grapesy
   benchmarks: True
   flags: +build-demo +build-stress-test +snappy
 
+source-repository-package
+  type: git
+  location: https://github.com/edsko/network-run
+  tag: 70211ef61ebbf178d6681ec37d3293d720ec9030
+
+source-repository-package
+  type: git
+  location: https://github.com/edsko/http2-tls
+  tag: 53d8b7a0d2a044606de0906e5b66a1f2bce549bd
+
 --
 -- ghc 9.10
 --

diff --git 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/edsko/network-run
+  tag: 70211ef61ebbf178d6681ec37d3293d720ec9030
+
+source-repository-package
+  type: git
+  location: https://github.com/edsko/http2-tls
+  tag: 53d8b7a0d2a044606de0906e5b66a1f2bce549bd
+
 --
 -- ghc 9.10
 --

diff --git 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.3.1   && < 0.4
     , 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.3.2   && < 0.4
     , proto-lens           >= 0.7     && < 0.8
     , proto-lens-runtime   >= 0.7     && < 0.8
     , random               >= 1.2     && < 1.3

diff --git a/src/Network/GRPC/Client/Connection.hs b/src/Network/GRPC/Client/Connection.hs
@@ -560,9 +560,11 @@ 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.settingsCAStore          = caStore
+            , HTTP2.TLS.Client.settingsKeyLogger        = keyLogger
+            , HTTP2.TLS.Client.settingsAddrInfoFlags    = []
+            , HTTP2.TLS.Client.settingsOpenClientSocket = openClientSocket
 
             , HTTP2.TLS.Client.settingsConcurrentStreams =
                 fromIntegral $
@@ -626,7 +628,14 @@ overridePingRateLimit connParams clientConfig = clientConfig {
 
 runTCPClient :: Address -> (Socket -> IO a) -> IO a
 runTCPClient Address{addressHost, addressPort} =
-    Run.runTCPClient addressHost (show addressPort)
+    Run.runTCPClientWithSocket openClientSocket addressHost (show addressPort)
+
+openClientSocket :: AddrInfo -> IO Socket
+openClientSocket =
+    Run.openClientSocketWithOptions socketOptions
+  where
+    socketOptions :: [(SocketOption, Int)]
+    socketOptions = [(NoDelay, 1)]
 
 -- | Write-buffer size
 --

diff --git a/src/Network/GRPC/Server/Run.hs b/src/Network/GRPC/Server/Run.hs
@@ -410,9 +410,12 @@ disableTimeout =
 
 openServerSocket :: TMVar Socket -> AddrInfo -> IO Socket
 openServerSocket socketTMVar addr = do
-    sock <- Run.openServerSocket addr
+    sock <- Run.openServerSocketWithOptions socketOptions addr
     atomically $ putTMVar socketTMVar sock
     return sock
+  where
+    socketOptions :: [(SocketOption, Int)]
+    socketOptions = [(NoDelay, 1)]
 
 writeBufferSize :: BufferSize
 writeBufferSize = 4096