One Manager per server

See comments on `withTimeManager`

src/Network/GRPC/Server/Run.hs

@@ -293,13 +293,14 @@ runInsecure params cfg socketTMVar server = do
         serverHTTP2Settings
         socketTMVar
         (insecureHost cfg)
-        (insecurePort cfg) $ \listenSock -> do
-      Run.runTCPServerWithSocket listenSock $ \clientSock -> do
-        when (http2TcpNoDelay serverHTTP2Settings) $
-          -- See description of 'withServerSocket'
-          setSockOpt clientSock NoDelay True
-        withConfigForInsecure clientSock $ \config ->
-          HTTP2.run serverConfig config server
+        (insecurePort cfg) $ \listenSock ->
+      withTimeManager $ \mgr ->
+        Run.runTCPServerWithSocket listenSock $ \clientSock -> do
+          when (http2TcpNoDelay serverHTTP2Settings) $
+            -- See description of 'withServerSocket'
+            setSockOpt clientSock NoDelay True
+          withConfigForInsecure mgr clientSock $ \config ->
+            HTTP2.run serverConfig config server
   where
     ServerParams{
         serverOverrideNumberOfWorkers

util/Network/GRPC/Util/HTTP2.hs

@@ -11,6 +11,8 @@ module Network.GRPC.Util.HTTP2 (
     -- * Settings
   , mkServerConfig
   , mkTlsSettings
+    -- * Timeouts
+  , withTimeManager
   ) where
 
 import Control.Exception
@@ -51,24 +53,24 @@ fromHeaderTable = map (first HPACK.tokenKey) . fst
 -- instead create a config that is very similar to the config created by
 -- 'allocConfigForSecure'.
 withConfigForInsecure ::
-     Socket
+     Time.Manager
+  -> Socket
   -> (Server.Config -> IO a)
   -> IO a
-withConfigForInsecure sock k = do
-    TimeManager.withManager (disableTimeout * 1_000_000) $ \mgr -> do
-      -- @recv@ does not provide a way to deallocate a buffer pool, and
-      -- @http2-tls@ (in @freeServerConfig@) does not attempt to deallocate it.
-      -- We follow suit here.
-      pool   <- Recv.newBufferPool readBufferLowerLimit readBufferSize
-      mysa   <- Socket.getSocketName sock
-      peersa <- Socket.getPeerName sock
-      withConfig
-        mgr
-        (Socket.sendAll sock)
-        (Recv.receive sock pool)
-        mysa
-        peersa
-        k
+withConfigForInsecure mgr sock k = do
+    -- @recv@ does not provide a way to deallocate a buffer pool, and
+    -- @http2-tls@ (in @freeServerConfig@) does not attempt to deallocate it.
+    -- We follow suit here.
+    pool   <- Recv.newBufferPool readBufferLowerLimit readBufferSize
+    mysa   <- Socket.getSocketName sock
+    peersa <- Socket.getPeerName sock
+    withConfig
+      mgr
+      (Socket.sendAll sock)
+      (Recv.receive sock pool)
+      mysa
+      peersa
+      k
   where
     def :: Server.TLS.Settings
     def = Server.TLS.defaultSettings
@@ -217,6 +219,19 @@ mkTlsSettings http2Settings numberOfWorkers keyLogger =
   Timeouts
 -------------------------------------------------------------------------------}
 
+-- | Allocate time manager (without any actual timeouts)
+--
+-- The @http2@ ecosystem relies on a time manager for timeouts; we don't use
+-- those timeouts (see disableTimeout), but must still provide a time manager
+-- for insecure connections. For secure connections the time manager is
+-- allocated in 'Network.Run.Timeout.runTCPServerWithSocket' from @network-run@.
+-- In that package it allocates a single manager for the entire server (it
+-- allocates the manager before calling accept), so we should do the same in the
+-- insecure case for better consistency between the two setups; this also avoids
+-- the possibility of leaking managers.
+withTimeManager :: (Time.Manager -> IO a) -> IO a
+withTimeManager = TimeManager.withManager (disableTimeout * 1_000_000)
+
 -- | Work around the fact that we cannot disable timeouts in http2/http2-tls
 --
 -- TODO: <https://github.com/well-typed/grapesy/issues/123>