Safe Haskell | None |
---|---|
Language | Haskell2010 |
Network.GRPC.Server.StreamType
Description
Server handlers
Synopsis
- data ServerHandler' (styp :: StreamingType) (m :: Type -> Type) (rpc :: k) where
- ServerHandler :: forall {k} (rpc :: k) (styp :: StreamingType) (m :: Type -> Type). SupportsStreamingType rpc styp => Handler 'Server styp m rpc -> ServerHandler' styp m rpc
- type ServerHandler (m :: Type -> Type) (rpc :: k) = ServerHandler' (RpcStreamingType rpc) m rpc
- mkNonStreaming :: forall {k} (rpc :: k) m. SupportsStreamingType rpc 'NonStreaming => (Input rpc -> m (Output rpc)) -> ServerHandler' 'NonStreaming m rpc
- mkClientStreaming :: forall {k} (rpc :: k) m. SupportsStreamingType rpc 'ClientStreaming => (IO (NextElem (Input rpc)) -> m (Output rpc)) -> ServerHandler' 'ClientStreaming m rpc
- mkServerStreaming :: forall {k} (rpc :: k) m. SupportsStreamingType rpc 'ServerStreaming => (Input rpc -> (NextElem (Output rpc) -> IO ()) -> m ()) -> ServerHandler' 'ServerStreaming m rpc
- mkBiDiStreaming :: forall {k} (rpc :: k) m. SupportsStreamingType rpc 'BiDiStreaming => (IO (NextElem (Input rpc)) -> (NextElem (Output rpc) -> IO ()) -> m ()) -> ServerHandler' 'BiDiStreaming m rpc
- data Methods (m :: Type -> Type) (rpcs :: [k]) where
- NoMoreMethods :: forall {k} (m :: Type -> Type). Methods m ('[] :: [k])
- Method :: forall {k} (rpc :: k) (styp :: StreamingType) (m :: Type -> Type) (rpcs1 :: [k]). (SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc), Default (ResponseTrailingMetadata rpc), SupportsStreamingType rpc styp) => ServerHandler' styp m rpc -> Methods m rpcs1 -> Methods m (rpc ': rpcs1)
- RawMethod :: forall {k} (rpc :: k) (m :: Type -> Type) (rpcs1 :: [k]). SupportsServerRpc rpc => RpcHandler m rpc -> Methods m rpcs1 -> Methods m (rpc ': rpcs1)
- UnsupportedMethod :: forall {k} (m :: Type -> Type) (rpcs1 :: [k]) (rpc :: k). Methods m rpcs1 -> Methods m (rpc ': rpcs1)
- data Services (m :: Type -> Type) (servs :: [[k]]) where
- fromMethod :: forall {k} (rpc :: k) (styp :: StreamingType) (m :: Type -> Type). (SupportsServerRpc rpc, ValidStreamingType styp, Default (ResponseInitialMetadata rpc), Default (ResponseTrailingMetadata rpc), MonadIO m) => ServerHandler' styp m rpc -> SomeRpcHandler m
- fromMethods :: forall {k} (m :: Type -> Type) (rpcs :: [k]). MonadIO m => Methods m rpcs -> [SomeRpcHandler m]
- fromServices :: forall {k} (m :: Type -> Type) (servs :: [[k]]). MonadIO m => Services m servs -> [SomeRpcHandler m]
- hoistMethods :: forall {k} m n (rpcs :: [k]). (forall a. m a -> n a) -> Methods m rpcs -> Methods n rpcs
- hoistServices :: forall {k} m n (servs :: [[k]]). (forall a. m a -> n a) -> Services m servs -> Services n servs
- simpleMethods :: forall {k} (m :: Type -> Type) (rpcs :: [k]) a. SimpleMethods m rpcs rpcs a => a
Handler type
data ServerHandler' (styp :: StreamingType) (m :: Type -> Type) (rpc :: k) where #
Constructors
ServerHandler :: forall {k} (rpc :: k) (styp :: StreamingType) (m :: Type -> Type). SupportsStreamingType rpc styp => Handler 'Server styp m rpc -> ServerHandler' styp m rpc |
type ServerHandler (m :: Type -> Type) (rpc :: k) = ServerHandler' (RpcStreamingType rpc) m rpc #
Construct server handler
mkNonStreaming :: forall {k} (rpc :: k) m. SupportsStreamingType rpc 'NonStreaming => (Input rpc -> m (Output rpc)) -> ServerHandler' 'NonStreaming m rpc Source #
mkClientStreaming :: forall {k} (rpc :: k) m. SupportsStreamingType rpc 'ClientStreaming => (IO (NextElem (Input rpc)) -> m (Output rpc)) -> ServerHandler' 'ClientStreaming m rpc Source #
mkServerStreaming :: forall {k} (rpc :: k) m. SupportsStreamingType rpc 'ServerStreaming => (Input rpc -> (NextElem (Output rpc) -> IO ()) -> m ()) -> ServerHandler' 'ServerStreaming m rpc Source #
mkBiDiStreaming :: forall {k} (rpc :: k) m. SupportsStreamingType rpc 'BiDiStreaming => (IO (NextElem (Input rpc)) -> (NextElem (Output rpc) -> IO ()) -> m ()) -> ServerHandler' 'BiDiStreaming m rpc Source #
Server API
data Methods (m :: Type -> Type) (rpcs :: [k]) where Source #
Declare handlers for a set of RPCs
See also simpleMethods
for an alternative API if you only need the Method
constructor.
Example usage
Example that provides methods for the gRPC RouteGuide API:
handlers :: [Feature] -> Methods IO (ProtobufMethodsOf RouteGuide) handlers db = Method (mkNonStreaming $ getFeature db) $ Method (mkServerStreaming $ listFeatures db) $ Method (mkClientStreaming $ recordRoute db) $ Method (mkBiDiStreaming $ routeChat db) $ NoMoreMethods
It is also possibly to define your own list of RPC, instead of computing it
using ProtobufMethodsOf
(indeed, there is no need to use Protobuf at all).
Taking advantage of type inference
Provided that you give a top-level type annotation, then type inference can guide this definition:
handlers :: [Feature] -> Methods IO (ProtobufMethodsOf RouteGuide) handlers db = _methods
This will reveal that we need four methods:
_methods :: Methods IO '[ Protobuf RouteGuide "getFeature" , Protobuf RouteGuide "listFeatures" , Protobuf RouteGuide "recordRoute" , Protobuf RouteGuide "routeChat" ]
We can use this to make a skeleton definition, with holes for each handler:
handlers :: [Feature] -> Methods IO (ProtobufMethodsOf RouteGuide) handlers db = Method _getFeature $ Method _listFeatures $ Method _recordRoute $ Method _routeChar $ NoMoreMethods
This will reveal types such as this:
_getFeature :: ServerHandler' NonStreaming IO (Protobuf RouteGuide "getFeature")
which we can simplify to
_getFeature :: ServerHandler IO (Protobuf RouteGuide "getFeature")
(the non-primed version of ServerHandler
infers the streaming type from
the RPC, when possible). Finally, if we then refine the skeleton to
Method (mkNonStreaming $ _getFeature)
ghc will tell us
_getFeature :: Proto Point -> IO (Proto Feature)
Constructors
NoMoreMethods :: forall {k} (m :: Type -> Type). Methods m ('[] :: [k]) | All methods of the service handled |
Method :: forall {k} (rpc :: k) (styp :: StreamingType) (m :: Type -> Type) (rpcs1 :: [k]). (SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc), Default (ResponseTrailingMetadata rpc), SupportsStreamingType rpc styp) => ServerHandler' styp m rpc -> Methods m rpcs1 -> Methods m (rpc ': rpcs1) | Define the next method of the service, inferring the streaming type In the most common case (Protobuf), the streaming type can be inferred
from the method. In this case, it is convenient to use |
RawMethod :: forall {k} (rpc :: k) (m :: Type -> Type) (rpcs1 :: [k]). SupportsServerRpc rpc => RpcHandler m rpc -> Methods m rpcs1 -> Methods m (rpc ': rpcs1) | Define a method that uses uses the raw (core) API instead This is useful when the communication pattern does not fall neatly into the four streaming types (non-streaming, client-side streaming, server-side streaming, or bidirectional streaming), or when you need access to lower level features such as request or response metadata, compression options, etc. |
UnsupportedMethod :: forall {k} (m :: Type -> Type) (rpcs1 :: [k]) (rpc :: k). Methods m rpcs1 -> Methods m (rpc ': rpcs1) | Declare that this particular |
data Services (m :: Type -> Type) (servs :: [[k]]) where Source #
Declare handlers for a set of services
See also fromServices
.
Example usage:
services :: [Feature] -> Services IO (ProtobufServices '[Greeter, RouteGuide]) services db = Service Greeter.handlers $ Service (RouteGuide.handlers db) $ NoMoreServices
fromMethod :: forall {k} (rpc :: k) (styp :: StreamingType) (m :: Type -> Type). (SupportsServerRpc rpc, ValidStreamingType styp, Default (ResponseInitialMetadata rpc), Default (ResponseTrailingMetadata rpc), MonadIO m) => ServerHandler' styp m rpc -> SomeRpcHandler m Source #
Construct SomeRpcHandler
from a streaming handler
Most users will not need to call this function, but it can occassionally be
useful when using the lower-level API. Depending on usage you may need to
provide a type argument to fix the rpc
, for example
Server.fromMethod @EmptyCall $ ServerHandler $ \(_ ::Empty) -> return (defMessage :: Empty)
If the streaming type cannot be deduced, you might need to specify that also:
Server.fromMethod @Ping @NonStreaming $ ServerHandler $ ..
Alternatively, use one of the handler construction functions, such as
Server.fromMethod @Ping $ Server.mkNonStreaming $ ..
fromMethods :: forall {k} (m :: Type -> Type) (rpcs :: [k]). MonadIO m => Methods m rpcs -> [SomeRpcHandler m] Source #
List handlers for all methods of a given service.
This can be used to verify at the type level that all methods of the given
service are handled. A typical definition of the Methods
might have a type
such as this:
methods :: Methods IO (ProtobufMethodsOf RouteGuide)
See also fromServices
if you are defining more than one service.
fromServices :: forall {k} (m :: Type -> Type) (servs :: [[k]]). MonadIO m => Services m servs -> [SomeRpcHandler m] Source #
List handlers for all methods of all services.
This can be used to verify at the type level that all methods of all services
are handled. A typical definition of the Services
might have a type such as
this:
services :: Services IO (ProtobufServices '[Greeter, RouteGuide])
See also fromMethods
if you are only defining one service.
Hoisting
hoistMethods :: forall {k} m n (rpcs :: [k]). (forall a. m a -> n a) -> Methods m rpcs -> Methods n rpcs Source #
hoistServices :: forall {k} m n (servs :: [[k]]). (forall a. m a -> n a) -> Services m servs -> Services n servs Source #
Varargs API
simpleMethods :: forall {k} (m :: Type -> Type) (rpcs :: [k]) a. SimpleMethods m rpcs rpcs a => a Source #
Alternative way to construct Methods
Example usage
Listing the handlers for the gRPC routeguide server using Methods
directly
looks like this:
Method (mkNonStreaming $ getFeature db) $ Method (mkServerStreaming $ listFeatures db) $ Method (mkClientStreaming $ recordRoute db) $ Method (mkBiDiStreaming $ routeChat db) $ NoMoreMethods
Since we only use Method
here, we can instead write this as
simpleMethods (mkNonStreaming $ getFeature db) (mkServerStreaming $ listFeatures db) (mkClientStreaming $ recordRoute db) (mkBiDiStreaming $ routeChat db)
Which API you prefer is mostly just a matter of taste.