WIP: Cleanup settings, set TCP_NODELAY everywhere

Some of the tests are currently failing, not yet sure why.

.github/workflows/haskell-ci.yml

@@ -182,8 +182,8 @@ jobs:
 
           source-repository-package
             type:     git
-            location: https://github.com/kazu-yamamoto/http2-tls
-            tag:      6ecea0f22a576c3f0dcbb9efd7a402919bf4ad10
+            location: https://github.com/edsko/http2-tls
+            tag:      82fd8ce2c3ce63d8fd765a27f8bf570e4b95d1c8
 
           package grapesy
             tests:       True

cabal.project

@@ -13,8 +13,8 @@ source-repository-package
 
 source-repository-package
   type: git
-  location: https://github.com/kazu-yamamoto/http2-tls
-  tag: 6ecea0f22a576c3f0dcbb9efd7a402919bf4ad10
+  location: https://github.com/edsko/http2-tls
+  tag: 82fd8ce2c3ce63d8fd765a27f8bf570e4b95d1c8
 
 --
 -- ghc 9.10

cabal.project.ci

@@ -13,8 +13,8 @@ source-repository-package
 
 source-repository-package
   type: git
-  location: https://github.com/kazu-yamamoto/http2-tls
-  tag: 6ecea0f22a576c3f0dcbb9efd7a402919bf4ad10
+  location: https://github.com/edsko/http2-tls
+  tag: 82fd8ce2c3ce63d8fd765a27f8bf570e4b95d1c8
 
 --
 -- ghc 9.10

grapesy.cabal

@@ -210,12 +210,12 @@ library
     , 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.4     && < 0.5
     , proto-lens           >= 0.7     && < 0.8
     , proto-lens-runtime   >= 0.7     && < 0.8
     , random               >= 1.2     && < 1.3
     , record-hasfield      >= 1.0     && < 1.1
+    , recv                 >= 0.1     && < 0.2
     , stm                  >= 2.5     && < 2.6
     , text                 >= 1.2     && < 2.2
     , time-manager         >= 0.1     && < 0.2

src/Network/GRPC/Server/Run.hs

@@ -1,8 +1,5 @@
-{-# LANGUAGE CPP               #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-#include "MachDeps.h"
-
 -- | Convenience functions for running a HTTP2 server
 --
 -- Intended for unqualified import.
@@ -32,8 +29,6 @@ import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Exception
 import Control.Monad
-import Data.Maybe (fromMaybe)
-import Network.ByteOrder (BufferSize)
 import Network.HTTP2.Server qualified as HTTP2
 import Network.HTTP2.TLS.Server qualified as HTTP2.TLS
 import Network.Run.TCP qualified as Run
@@ -42,7 +37,7 @@ import Network.TLS qualified as TLS
 
 import Network.GRPC.Common.HTTP2Settings
 import Network.GRPC.Server
-import Network.GRPC.Util.HTTP2 (allocConfigWithTimeout)
+import Network.GRPC.Util.HTTP2
 import Network.GRPC.Util.TLS (SslKeyLog(..))
 import Network.GRPC.Util.TLS qualified as Util.TLS
 
@@ -303,12 +298,7 @@ runInsecure params cfg socketTMVar server = do
         when (http2TcpNoDelay serverHTTP2Settings) $
           -- See description of 'withServerSocket'
           setSockOpt clientSock NoDelay True
-        bracket ( allocConfigWithTimeout
-                    clientSock
-                    writeBufferSize
-                    disableTimeout
-                )
-                HTTP2.freeSimpleConfig $ \config ->
+        withConfigForInsecure clientSock $ \config ->
           HTTP2.run serverConfig config server
   where
     ServerParams{
@@ -317,23 +307,10 @@ runInsecure params cfg socketTMVar server = do
       } = params
 
     serverConfig :: HTTP2.ServerConfig
-    serverConfig = HTTP2.defaultServerConfig {
-          HTTP2.numberOfWorkers =
-              fromMaybe
-                (HTTP2.numberOfWorkers HTTP2.defaultServerConfig)
-                (fromIntegral <$> serverOverrideNumberOfWorkers)
-        , HTTP2.connectionWindowSize =
-              fromIntegral $ http2ConnectionWindowSize serverHTTP2Settings
-        , HTTP2.settings =
-              HTTP2.defaultSettings {
-                  HTTP2.initialWindowSize =
-                      fromIntegral $
-                        http2StreamWindowSize serverHTTP2Settings
-                , HTTP2.maxConcurrentStreams =
-                      Just . fromIntegral $
-                        http2MaxConcurrentStreams serverHTTP2Settings
-                }
-        }
+    serverConfig =
+        mkServerConfig
+          serverHTTP2Settings
+          serverOverrideNumberOfWorkers
 
 {-------------------------------------------------------------------------------
   Secure (over TLS)
@@ -356,36 +333,34 @@ runSecure params cfg socketTMVar server = do
             Right res -> return res
 
     keyLogger <- Util.TLS.keyLogger (secureSslKeyLog cfg)
-    let settings :: HTTP2.TLS.Settings
-        settings = HTTP2.TLS.defaultSettings {
-              HTTP2.TLS.settingsKeyLogger =
-                keyLogger
-            , HTTP2.TLS.settingsTimeout =
-                disableTimeout
-            , HTTP2.TLS.settingsNumberOfWorkers =
-                fromMaybe
-                  (HTTP2.TLS.settingsNumberOfWorkers HTTP2.TLS.defaultSettings)
-                  (fromIntegral <$> serverOverrideNumberOfWorkers)
-            , HTTP2.TLS.settingsConnectionWindowSize =
-                fromIntegral $ http2ConnectionWindowSize serverHTTP2Settings
-            , HTTP2.TLS.settingsStreamWindowSize =
-                fromIntegral $ http2StreamWindowSize serverHTTP2Settings
-            , HTTP2.TLS.settingsConcurrentStreams =
-                fromIntegral $ http2MaxConcurrentStreams serverHTTP2Settings
-            }
+    let serverConfig :: HTTP2.ServerConfig
+        serverConfig =
+          mkServerConfig
+            serverHTTP2Settings
+            serverOverrideNumberOfWorkers
+
+        tlsSettings :: HTTP2.TLS.Settings
+        tlsSettings =
+          mkTlsSettings
+            serverHTTP2Settings
+            serverOverrideNumberOfWorkers
+            keyLogger
 
     withServerSocket
         serverHTTP2Settings
         socketTMVar
         (Just $ secureHost cfg)
         (securePort cfg) $ \listenSock ->
-      -- TODO: We should really set NoDelay on the clientSock, but we have
-      -- no access to it.
-      HTTP2.TLS.runWithSocket
-        settings
-        (TLS.Credentials [cred])
-        listenSock
-        server
+      HTTP2.TLS.runTLSWithSocket
+          tlsSettings
+          (TLS.Credentials [cred])
+          listenSock
+          "h2" $ \mgr backend -> do
+        when (http2TcpNoDelay serverHTTP2Settings) $
+          -- See description of 'withServerSocket'
+          setSockOpt (HTTP2.TLS.requestSock backend) NoDelay True
+        withConfigForSecure mgr backend $ \config ->
+          HTTP2.run serverConfig config server
   where
     ServerParams{
         serverOverrideNumberOfWorkers
@@ -402,28 +377,6 @@ data CouldNotLoadCredentials =
   Internal auxiliary
 -------------------------------------------------------------------------------}
 
--- | Work around the fact that we cannot disable timeouts in http2/http2-tls
---
--- TODO: <https://github.com/well-typed/grapesy/issues/123>
--- We need a proper solution for this.
-disableTimeout :: Int
-disableTimeout =
-#if (WORD_SIZE_IN_BITS == 64)
-    -- Set a really high timeout to effectively disable timeouts
-    --
-    -- We cannot use `maxBound` here, because this is value in
-    -- seconds which will be multiplied by 1_000_000 to get a value
-    -- in microseconds; `maxBound` would result in overflow.
-    1000000000 -- roughly 30 years
-#else
-#warning "Timeout for RPC messages is set to 30 minutes on 32-bit systems."
-#warning "See https://github.com/kazu-yamamoto/http2/issues/112"
-    -- Unfortunately, the same trick does not work on 32-bit
-    -- systems, where we simply don't have enough range. The
-    -- maximum timeout we can support here is 30 mins.
-    30 * 60
-#endif
-
 -- | Create server listen socket
 --
 -- We set @TCP_NODELAY@ on the server listen socket, but there is no guarantee
@@ -472,5 +425,3 @@ withServerSocket http2Settings socketTMVar host port k = do
           ]
         ]
 
-writeBufferSize :: BufferSize
-writeBufferSize = 4096