Multiplex gRPC servers (#309)

Author: serras

grpc/server/src/Mu/GRpc/Server.hs

@@ -29,6 +29,7 @@ module Mu.GRpc.Server
 , runGRpcAppTLS, TLSSettings
   -- * Convert a 'Server' into a WAI application
 , gRpcApp, gRpcAppTrans
+, WrappedServer(..), gRpcMultipleApp, gRpcMultipleAppTrans
   -- * Raise errors as exceptions in IO
 , raiseErrors, liftServerConduit
   -- * Re-export useful instances
@@ -147,6 +148,31 @@ gRpcAppTrans protocol f svr
   = Wai.grpcApp [uncompressed, gzip]
                 (gRpcServerHandlers protocol f svr)
 
+-- | Turn several Mu 'Server's into a WAI 'Application'.
+--
+--   These 'Application's can be later combined using,
+--   for example, @wai-routes@, or you can add middleware
+--   from @wai-extra@, among others.
+gRpcMultipleApp
+  :: Proxy protocol
+  -> [WrappedServer protocol ServerErrorIO]
+  -> Application
+gRpcMultipleApp protocol = gRpcMultipleAppTrans protocol id
+
+-- | Turn several Mu 'Server's into a WAI 'Application'.
+--
+--   These 'Application's can be later combined using,
+--   for example, @wai-routes@, or you can add middleware
+--   from @wai-extra@, among others.
+gRpcMultipleAppTrans
+  :: Proxy protocol
+  -> (forall a. m a -> ServerErrorIO a)
+  -> [WrappedServer protocol m]
+  -> Application
+gRpcMultipleAppTrans protocol f svr
+  = Wai.grpcApp [uncompressed, gzip]
+                (concatMap (gRpcServerHandlersS protocol f) svr)
+
 gRpcServerHandlers
   :: forall name services handlers m protocol chn.
      ( KnownName name
@@ -160,6 +186,21 @@ gRpcServerHandlers pr f (Services svr)
   = gRpcServiceHandlers f (Proxy @('Package ('Just name) services)) pr packageName svr
   where packageName = BS.pack (nameVal (Proxy @name))
 
+data WrappedServer protocol m where
+  Srv :: ( KnownName name
+         , GRpcServiceHandlers ('Package ('Just name) services)
+                             protocol m chn services handlers )
+      => ServerT chn () ('Package ('Just name) services) m handlers
+      -> WrappedServer protocol m
+
+gRpcServerHandlersS
+  :: Proxy protocol
+  -> (forall a. m a -> ServerErrorIO a)
+  -> WrappedServer protocol m
+  -> [ServiceHandler]
+gRpcServerHandlersS pr f (Srv svr)
+  = gRpcServerHandlers pr f svr
+
 class GRpcServiceHandlers (fullP :: Package snm mnm anm (TypeRef snm))
                           (p :: GRpcMessageProtocol) (m :: Type -> Type)
                           (chn :: ServiceChain snm)