Move new ServerConfig fields to ServerParams

demo-server/Main.hs

@@ -6,7 +6,6 @@ import Data.Aeson
 
 import Network.GRPC.Common
 import Network.GRPC.Common.Compression qualified as Compression
-import Network.GRPC.Common.HTTP2Settings (defaultHTTP2Settings)
 import Network.GRPC.Common.Protobuf
 import Network.GRPC.Server
 import Network.GRPC.Server.Protobuf
@@ -54,15 +53,13 @@ main = do
 
     let serverConfig :: ServerConfig
         serverConfig = ServerConfig {
-            serverInsecure                = cmdInsecure cmdline
-          , serverSecure                  = cmdSecure cmdline
-          , serverOverrideNumberOfWorkers = Nothing
-          , serverHTTP2Settings           = defaultHTTP2Settings
+            serverInsecure = cmdInsecure cmdline
+          , serverSecure   = cmdSecure cmdline
           }
 
     runServerWithHandlers
-      serverConfig
       (serverParams cmdline)
+      serverConfig
       (fromServices $ services cmdline db)
 
 getRouteGuideDb :: IO [Proto Feature]

interop/Interop/Server.hs

@@ -7,7 +7,6 @@ import Control.Exception (SomeException)
 import Control.Monad.Catch (generalBracket, ExitCase(..))
 
 import Network.GRPC.Common
-import Network.GRPC.Common.HTTP2Settings (defaultHTTP2Settings)
 import Network.GRPC.Internal.XIO qualified as XIO
 import Network.GRPC.Server
 import Network.GRPC.Server.Protobuf
@@ -67,34 +66,30 @@ services =
 withInteropServer :: Cmdline -> (RunningServer -> IO a) -> IO a
 withInteropServer cmdline k = do
     server <- mkGrpcServer serverParams $ fromServices services
-    forkServer serverConfig server k
+    forkServer serverParams serverConfig server k
   where
     serverConfig :: ServerConfig
     serverConfig
       | cmdUseTLS cmdline
       = ServerConfig {
-            serverSecure = Just SecureConfig {
+            serverInsecure = Nothing
+          , serverSecure   = Just SecureConfig {
                 secureHost       = "0.0.0.0"
               , securePort       = cmdPort cmdline
               , securePubCert    = cmdPubCert cmdline
               , secureChainCerts = []
               , securePrivKey    = cmdPrivKey cmdline
               , secureSslKeyLog  = cmdSslKeyLog cmdline
               }
-          , serverInsecure                = Nothing
-          , serverOverrideNumberOfWorkers = Nothing
-          , serverHTTP2Settings           = defaultHTTP2Settings
           }
 
      | otherwise
      = ServerConfig {
-            serverInsecure = Just InsecureConfig {
+            serverSecure   = Nothing
+          , serverInsecure = Just InsecureConfig {
                 insecureHost = Nothing
               , insecurePort = cmdPort cmdline
               }
-          , serverSecure                  = Nothing
-          , serverOverrideNumberOfWorkers = Nothing
-          , serverHTTP2Settings           = defaultHTTP2Settings
           }
 
     serverParams :: ServerParams

kvstore/KVStore/Server.hs

@@ -5,7 +5,6 @@ import Control.Monad
 
 import Network.GRPC.Common
 import Network.GRPC.Common.Compression qualified as Compr
-import Network.GRPC.Common.HTTP2Settings (defaultHTTP2Settings)
 import Network.GRPC.Server
 import Network.GRPC.Server.Run
 
@@ -30,14 +29,12 @@ withKeyValueServer cmdline@Cmdline{cmdJSON} k = do
           | otherwise = Protobuf.server $ handlers cmdline store
 
     server <- mkGrpcServer params rpcHandlers
-    forkServer config server k
+    forkServer params config server k
   where
     config :: ServerConfig
     config = ServerConfig {
-          serverInsecure                = Just $ InsecureConfig Nothing defaultInsecurePort
-        , serverSecure                  = Nothing
-        , serverOverrideNumberOfWorkers = Nothing
-        , serverHTTP2Settings           = defaultHTTP2Settings
+          serverInsecure = Just $ InsecureConfig Nothing defaultInsecurePort
+        , serverSecure   = Nothing
         }
 
     params :: ServerParams

src/Network/GRPC/Common.hs

@@ -41,9 +41,13 @@ module Network.GRPC.Common (
     -- * Configuration
   , SslKeyLog(..)
 
+  -- * HTTP\/2 Settings
+  , HTTP2Settings(..)
+
     -- * Defaults
   , defaultInsecurePort
   , defaultSecurePort
+  , defaultHTTP2Settings
 
     -- * Exceptions
 
@@ -74,6 +78,7 @@ import Network.Socket (PortNumber)
 
 import Control.Exception
 
+import Network.GRPC.Common.HTTP2Settings
 import Network.GRPC.Common.NextElem (NextElem(..))
 import Network.GRPC.Common.StreamElem (StreamElem(..))
 import Network.GRPC.Spec

src/Network/GRPC/Common/HTTP2Settings.hs

@@ -29,12 +29,13 @@ data HTTP2Settings = HTTP2Settings {
       --
       -- If the consumed window space of all streams exceeds this value, the
       -- sender will stop sending data. Therefore, if this value is less than
-      -- @'http2MaxConcurrentStreams' * 'http2StreamWindowSize'@, there
-      -- is risk of a control flow deadlock, since the connection window space
-      -- may be used up by streams that we are not yet processing before we have
+      -- @'http2MaxConcurrentStreams' * 'http2StreamWindowSize'@, there is risk
+      -- of a control flow deadlock, since the connection window space may be
+      -- used up by streams that we are not yet processing before we have
       -- received all data on the streams that we /are/ processing. To reduce
-      -- this risk, increase 'Network.GRPC.Server.Run.serverOverrideNumberOfWorkers'. See
-      -- <https://github.com/kazu-yamamoto/network-control/pull/4> for more
+      -- this risk, increase
+      -- 'Network.GRPC.Server.Run.serverOverrideNumberOfWorkers' for the server.
+      -- See <https://github.com/kazu-yamamoto/network-control/pull/4> for more
       -- information.
     , http2ConnectionWindowSize :: Word32
 

src/Network/GRPC/Server/Context.hs

@@ -15,6 +15,7 @@ import Control.Monad.XIO qualified as XIO
 import Data.Default
 import System.IO
 
+import Network.GRPC.Common
 import Network.GRPC.Common.Compression qualified as Compr
 import Network.GRPC.Server.RequestHandler.API
 import Network.GRPC.Spec
@@ -83,15 +84,33 @@ data ServerParams = ServerParams {
       -- headers are valid. By default we do /not/ do this, throwing an error
       -- only in scenarios where we really cannot continue.
     , serverVerifyHeaders :: Bool
+
+      -- | Number of threads that will be spawned to process incoming frames
+      -- on the currently active HTTP\/2 streams
+      --
+      -- This setting is specific to the
+      -- [http2](https://hackage.haskell.org/package/http2) package's
+      -- implementation of the HTTP\/2 specification for servers. Set to
+      -- 'Nothing' to use the default of 8 worker threads.
+      --
+      -- __Note__: If a lower 'http2ConnectionWindowSize' is desired, the
+      -- number of workers should be increased to avoid a potential HTTP\/2
+      -- control flow deadlock.
+    , serverOverrideNumberOfWorkers :: Maybe Word
+
+      -- | HTTP\/2 settings
+    , serverHTTP2Settings :: HTTP2Settings
     }
 
 instance Default ServerParams where
   def = ServerParams {
-        serverCompression       = def
-      , serverTopLevel          = defaultServerTopLevel
-      , serverExceptionToClient = defaultServerExceptionToClient
-      , serverContentType       = Just ContentTypeDefault
-      , serverVerifyHeaders     = False
+        serverCompression             = def
+      , serverTopLevel                = defaultServerTopLevel
+      , serverExceptionToClient       = defaultServerExceptionToClient
+      , serverContentType             = Just ContentTypeDefault
+      , serverVerifyHeaders           = False
+      , serverOverrideNumberOfWorkers = Nothing
+      , serverHTTP2Settings           = def
       }
 
 defaultServerTopLevel ::

src/Network/GRPC/Server/Run.hs

@@ -62,22 +62,6 @@ data ServerConfig = ServerConfig {
       --
       -- Set to 'Nothing' to disable.
     , serverSecure :: Maybe SecureConfig
-
-      -- | Number of threads that will be spawned to process incoming frames
-      -- on the currently active HTTP\/2 streams
-      --
-      -- This setting is specific to the
-      -- [http2](https://hackage.haskell.org/package/http2) package's
-      -- implementation of the HTTP\/2 specification for servers. Set to
-      -- 'Nothing' to use the default of 8 worker threads.
-      --
-      -- __Note__: If a lower 'http2ConnectionWindowSize' is desired, the
-      -- number of workers should be increased to avoid a potential HTTP\/2
-      -- control flow deadlock.
-    , serverOverrideNumberOfWorkers :: Maybe Word
-
-      -- | HTTP\/2 settings
-    , serverHTTP2Settings :: HTTP2Settings
     }
 
 -- | Offer insecure connection (no TLS)
@@ -139,18 +123,18 @@ data SecureConfig = SecureConfig {
 --
 -- See also 'runServerWithHandlers', which handles the creation of the
 -- 'HTTP2.Server' for you.
-runServer :: ServerConfig -> HTTP2.Server -> IO ()
-runServer cfg server = forkServer cfg server $ waitServer
+runServer :: ServerParams -> ServerConfig -> HTTP2.Server -> IO ()
+runServer params cfg server = forkServer params cfg server $ waitServer
 
 -- | Convenience function that combines 'runServer' with 'mkGrpcServer'
 runServerWithHandlers ::
-     ServerConfig
-  -> ServerParams
+     ServerParams
+  -> ServerConfig
   -> [SomeRpcHandler IO]
   -> IO ()
-runServerWithHandlers config params handlers = do
+runServerWithHandlers params config handlers = do
     server <- mkGrpcServer params handlers
-    runServer config server
+    runServer params config server
 
 {-------------------------------------------------------------------------------
   Full interface
@@ -184,14 +168,18 @@ data ServerTerminated = ServerTerminated
   deriving anyclass (Exception)
 
 -- | Start the server
-forkServer :: ServerConfig -> HTTP2.Server -> (RunningServer -> IO a) -> IO a
-forkServer cfg server k = do
+forkServer :: ServerParams -> ServerConfig -> HTTP2.Server -> (RunningServer -> IO a) -> IO a
+forkServer params ServerConfig{serverInsecure, serverSecure} server k = do
     runningSocketInsecure <- newEmptyTMVarIO
     runningSocketSecure   <- newEmptyTMVarIO
 
     let secure, insecure :: IO ()
-        insecure = runInsecure cfg runningSocketInsecure server
-        secure   = runSecure cfg runningSocketSecure server
+        insecure = case serverInsecure of
+                     Nothing  -> return ()
+                     Just cfg -> runInsecure params cfg runningSocketInsecure server
+        secure   = case serverSecure of
+                     Nothing  -> return ()
+                     Just cfg -> runSecure params cfg runningSocketSecure server
 
     withAsync insecure $ \runningServerInsecure ->
       withAsync secure $ \runningServerSecure ->
@@ -289,20 +277,12 @@ getSocket serverAsync socketTMVar = do
   Insecure
 -------------------------------------------------------------------------------}
 
-runInsecure :: ServerConfig -> TMVar Socket -> HTTP2.Server -> IO ()
-runInsecure ServerConfig{serverInsecure = Nothing} _ _ = return ()
-runInsecure
-    ServerConfig {
-        serverInsecure = Just insecureCfg
-      , serverOverrideNumberOfWorkers
-      , serverHTTP2Settings
-      }
-    socketTMVar server
-  =
+runInsecure :: ServerParams -> InsecureConfig -> TMVar Socket -> HTTP2.Server -> IO ()
+runInsecure ServerParams{serverOverrideNumberOfWorkers, serverHTTP2Settings} cfg socketTMVar server =
     Run.runTCPServerWithSocket
         (openServerSocket socketTMVar)
-        (insecureHost insecureCfg)
-        (show $ insecurePort insecureCfg) $ \sock -> do
+        (insecureHost cfg)
+        (show $ insecurePort cfg) $ \sock -> do
       bracket (allocConfigWithTimeout sock writeBufferSize disableTimeout)
               HTTP2.freeSimpleConfig $ \config ->
         HTTP2.run serverConfig config server
@@ -328,27 +308,20 @@ runInsecure
   Secure (over TLS)
 -------------------------------------------------------------------------------}
 
-runSecure :: ServerConfig -> TMVar Socket -> HTTP2.Server -> IO ()
-runSecure ServerConfig{serverSecure = Nothing} _ _ = return ()
-runSecure
-    ServerConfig {
-        serverSecure = Just secureCfg
-      , serverOverrideNumberOfWorkers
-      , serverHTTP2Settings
-      }
-    socketTMVar server = do
+runSecure :: ServerParams -> SecureConfig -> TMVar Socket -> HTTP2.Server -> IO ()
+runSecure ServerParams{serverOverrideNumberOfWorkers, serverHTTP2Settings} cfg socketTMVar server = do
     cred :: TLS.Credential <-
           TLS.credentialLoadX509Chain
-            (securePubCert    secureCfg)
-            (secureChainCerts secureCfg)
-            (securePrivKey    secureCfg)
+            (securePubCert    cfg)
+            (secureChainCerts cfg)
+            (securePrivKey    cfg)
       >>= \case
             Left  err -> throwIO $ CouldNotLoadCredentials err
             Right res -> return res
 
-    keyLogger <- Util.TLS.keyLogger (secureSslKeyLog secureCfg)
-    let tlsSettings :: HTTP2.TLS.Settings
-        tlsSettings = HTTP2.TLS.defaultSettings {
+    keyLogger <- Util.TLS.keyLogger (secureSslKeyLog cfg)
+    let settings :: HTTP2.TLS.Settings
+        settings = HTTP2.TLS.defaultSettings {
               HTTP2.TLS.settingsKeyLogger =
                 keyLogger
             , HTTP2.TLS.settingsOpenServerSocket =
@@ -366,10 +339,10 @@ runSecure
             }
 
     HTTP2.TLS.run
-      tlsSettings
+      settings
       (TLS.Credentials [cred])
-      (secureHost secureCfg)
-      (securePort secureCfg)
+      (secureHost cfg)
+      (securePort cfg)
       server
 
 data CouldNotLoadCredentials =

test-grapesy/Test/Driver/ClientServer.hs

@@ -39,7 +39,6 @@ import Test.Tasty.QuickCheck qualified as QuickCheck
 import Network.GRPC.Client qualified as Client
 import Network.GRPC.Common
 import Network.GRPC.Common.Compression qualified as Compr
-import Network.GRPC.Common.HTTP2Settings
 import Network.GRPC.Internal.XIO (NeverThrows)
 import Network.GRPC.Internal.XIO qualified as XIO
 import Network.GRPC.Server qualified as Server
@@ -453,31 +452,25 @@ withTestServer cfg firstTestFailure handlerLock serverHandlers k = do
                       insecureHost = Nothing
                     , insecurePort = serverPort cfg
                     }
-                , serverSecure = Nothing
-                , serverOverrideNumberOfWorkers = Nothing
-                , serverHTTP2Settings = defaultHTTP2Settings
+                , serverSecure   = Nothing
                 }
               Just (TlsFail TlsFailUnsupported) -> Server.ServerConfig {
                   serverInsecure = Just Server.InsecureConfig {
                       insecureHost = Nothing
                     , insecurePort = serverPort cfg
                     }
-                , serverSecure = Nothing
-                , serverOverrideNumberOfWorkers = Nothing
-                , serverHTTP2Settings = defaultHTTP2Settings
+                , serverSecure   = Nothing
                 }
               Just _tlsSetup -> Server.ServerConfig {
                   serverInsecure = Nothing
-                , serverSecure = Just $ Server.SecureConfig {
+                , serverSecure   = Just $ Server.SecureConfig {
                       secureHost       = "127.0.0.1"
                     , securePort       = serverPort cfg
                     , securePubCert    = pubCert
                     , secureChainCerts = []
                     , securePrivKey    = privKey
                     , secureSslKeyLog  = SslKeyLogNone
                     }
-                , serverOverrideNumberOfWorkers = Nothing
-                , serverHTTP2Settings = defaultHTTP2Settings
                 }
 
         serverParams :: Server.ServerParams
@@ -498,7 +491,7 @@ withTestServer cfg firstTestFailure handlerLock serverHandlers k = do
             }
 
     server <- Server.mkGrpcServer serverParams serverHandlers
-    Server.forkServer serverConfig server k
+    Server.forkServer serverParams serverConfig server k
 
 {-------------------------------------------------------------------------------
   Client