More helpers for creating wai applications from services

http2-grpc-protocol-buffers/Text/ProtocolBuffers/GRPC.hs

@@ -1,45 +1,57 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 
-module Text.ProtocolBuffers.GRPC (
-  makeServiceHandlers,
-  QualifiedMethod(..),
-  QualifiedMethods,
-  qualifiedMethods,
-  ServiceHandler(..),
-  StreamHandler(..),
-  UnaryHandler,
-  ServerStreamHandler,
-  ClientStreamHandler,
-  BiDiStreamHandler,
-  GeneralStreamHandler,
-) where
+module Text.ProtocolBuffers.GRPC
+  ( makeServiceHandlers,
+    makeGrpcService,
+    makeGrpcApp,
+    Compression,
+    uncompressed,
+    gzip,
+    QualifiedMethod (..),
+    QualifiedMethods,
+    qualifiedMethods,
+    ServiceHandler (..),
+    StreamHandler (..),
+    UnaryHandler,
+    ServerStreamHandler,
+    ServerStream(..),
+    ClientStreamHandler,
+    ClientStream(..),
+    BiDiStreamHandler,
+    BiDiStream(..),BiDiStep(..),
+    GeneralStreamHandler,
+    IncomingStream(..), OutgoingStream(..),
+  )
+where
 
 import Data.Binary.Builder (fromByteString, putWord32be, singleton)
 import Data.Binary.Get (getByteString, getInt8, getWord32be, runGetIncremental)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BSC
 import qualified Data.ByteString.Lazy as BSL
 import qualified Data.ByteString.Lazy.Builder as BSLB
-import Data.Proxy
 import Data.HVect hiding (singleton)
+import Data.Proxy
+import GHC.Exts
 import GHC.TypeLits
 import Network.GRPC.HTTP2.Encoding
 import Network.GRPC.HTTP2.Types
-import Network.GRPC.Server.Wai
-import Text.ProtocolBuffers (Method, ReflectDescriptor, Service, Wire, messageGet, Streaming(..))
-import Text.ProtocolBuffers.WireMessage (messagePut)
 import Network.GRPC.Server.Handlers
-import GHC.Exts
-import Text.ProtocolBuffers.Basic (Service(Service))
+import Network.GRPC.Server.Wai (ServiceHandler (..))
+import qualified Network.GRPC.Server.Wai
+import Network.Wai
+import Text.ProtocolBuffers (Method, ReflectDescriptor, Service, Streaming (..), Wire, messageGet)
+import Text.ProtocolBuffers.Basic (Service (Service))
+import Text.ProtocolBuffers.WireMessage (messagePut)
 
 data QualifiedMethod (serviceName :: Symbol) (methodName :: Symbol) (input :: Streaming *) (output :: Streaming *) = QualifiedMethod
 
@@ -89,12 +101,12 @@ instance HasQualifiedMethods (Service serviceName rest) => HasQualifiedMethods (
   type QualifiedMethods (Service serviceName (Method methodName i o ': rest)) = QualifiedMethod serviceName methodName i o ': QualifiedMethods (Service serviceName rest)
   qualifiedMethods _ = QualifiedMethod :&: qualifiedMethods (Service :: Service serviceName rest)
 
-class MakeHandlers (methods :: [*]) where
-  type MakeHandlersResult methods
-  makeHandlers :: KnownSymbol serviceName => proxy serviceName -> Proxy methods -> ([ServiceHandler] -> [ServiceHandler]) -> MakeHandlersResult methods
+class MakeHandlers (methods :: [*]) a where
+  type MakeHandlersResult methods a
+  makeHandlers :: KnownSymbol serviceName => proxy serviceName -> Proxy methods -> ([ServiceHandler] -> a) -> MakeHandlersResult methods a
 
-instance MakeHandlers '[] where
-  type MakeHandlersResult '[] = [ServiceHandler]
+instance MakeHandlers '[] a where
+  type MakeHandlersResult '[] a = a
   makeHandlers _ _ acc = acc []
 
 data StreamHandler m (i :: Streaming *) (o :: Streaming *) where
@@ -104,8 +116,8 @@ data StreamHandler m (i :: Streaming *) (o :: Streaming *) where
   BiDiStreamHandler :: (Wire i, Wire o, ReflectDescriptor i, ReflectDescriptor o) => BiDiStreamHandler m i o a -> StreamHandler m (StreamOf i) (StreamOf o)
   GeneralStreamHandler :: (Wire i, Wire o, ReflectDescriptor i, ReflectDescriptor o) => GeneralStreamHandler m i o a b -> StreamHandler m (StreamOf i) (StreamOf o)
 
-instance (MakeHandlers xs, KnownSymbol methodName) => MakeHandlers (Method methodName i o ': xs) where
-  type MakeHandlersResult (Method methodName i o ': xs) = StreamHandler IO i o -> MakeHandlersResult xs
+instance (MakeHandlers xs a, KnownSymbol methodName) => MakeHandlers (Method methodName i o ': xs) a where
+  type MakeHandlersResult (Method methodName i o ': xs) a = StreamHandler IO i o -> MakeHandlersResult xs a
   makeHandlers (serviceName :: proxy serviceName) _ acc handler =
     let method = QualifiedMethod :: QualifiedMethod serviceName methodName i o
         newEntry =
@@ -115,8 +127,16 @@ instance (MakeHandlers xs, KnownSymbol methodName) => MakeHandlers (Method metho
             ClientStreamHandler handler -> clientStream method handler
             BiDiStreamHandler handler -> bidiStream method handler
             GeneralStreamHandler handler -> generalStream method handler
-    in makeHandlers serviceName (Proxy :: Proxy xs) (acc . (newEntry:))
+     in makeHandlers serviceName (Proxy :: Proxy xs) (acc . (newEntry :))
+
+makeServiceHandlers :: forall methods serviceName. (MakeHandlers methods [ServiceHandler], KnownSymbol serviceName) => Service serviceName methods -> MakeHandlersResult methods [ServiceHandler]
+makeServiceHandlers service = withServiceHandlers service id
+
+makeGrpcService :: forall methods serviceName. (MakeHandlers methods (Application -> Application), KnownSymbol serviceName) => Service serviceName methods -> [Compression] -> MakeHandlersResult methods (Application -> Application)
+makeGrpcService service compression = withServiceHandlers service $ Network.GRPC.Server.Wai.grpcService compression
+
+makeGrpcApp :: forall methods serviceName. (MakeHandlers methods Application, KnownSymbol serviceName) => Service serviceName methods -> [Compression] -> MakeHandlersResult methods Application
+makeGrpcApp service compression = withServiceHandlers service $ Network.GRPC.Server.Wai.grpcApp compression
 
-makeServiceHandlers :: forall methods serviceName res . (MakeHandlers methods, KnownSymbol serviceName) => Service serviceName methods -> MakeHandlersResult methods
-makeServiceHandlers _ =
-  makeHandlers (Proxy :: Proxy serviceName) (Proxy :: Proxy methods) id
+withServiceHandlers :: forall methods serviceName res. (MakeHandlers methods res, KnownSymbol serviceName) => Service serviceName methods -> ([ServiceHandler] -> res) -> MakeHandlersResult methods res
+withServiceHandlers _ = makeHandlers (Proxy :: Proxy serviceName) (Proxy :: Proxy methods)

http2-grpc-protocol-buffers/http2-grpc-protocol-buffers.cabal

@@ -25,5 +25,6 @@ Library
                  binary,
                  hvect,
                  unliftio-core,
-                 warp-grpc
+                 warp-grpc,
+                 wai