| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Network.GRPC.Server
Synopsis
- mkGrpcServer :: ServerParams -> [SomeRpcHandler IO] -> IO Server
- data ServerParams = ServerParams {}
- type RequestHandler a = (forall x. IO x -> IO x) -> Request -> (Response -> IO ()) -> IO a
- data ContentType
- data Call (rpc :: k)
- data RpcHandler (m :: Type -> Type) (rpc :: k)
- mkRpcHandler :: forall {k} (rpc :: k) m. (Default (ResponseInitialMetadata rpc), MonadIO m) => (Call rpc -> m ()) -> RpcHandler m rpc
- mkRpcHandlerNoDefMetadata :: forall {k} (rpc :: k) m. (Call rpc -> m ()) -> RpcHandler m rpc
- hoistRpcHandler :: forall {k} m n (rpc :: k). (forall a. m a -> n a) -> RpcHandler m rpc -> RpcHandler n rpc
- data SomeRpcHandler (m :: Type -> Type)
- someRpcHandler :: forall {k} (rpc :: k) (m :: Type -> Type). SupportsServerRpc rpc => RpcHandler m rpc -> SomeRpcHandler m
- hoistSomeRpcHandler :: (forall a. m a -> n a) -> SomeRpcHandler m -> SomeRpcHandler n
- recvInput :: forall {k} (rpc :: k). HasCallStack => Call rpc -> IO (StreamElem NoMetadata (Input rpc))
- sendOutput :: forall {k} (rpc :: k). HasCallStack => Call rpc -> StreamElem (ResponseTrailingMetadata rpc) (Output rpc) -> IO ()
- sendGrpcException :: forall {k} (rpc :: k). Call rpc -> GrpcException -> IO ()
- getRequestMetadata :: forall {k} (rpc :: k). Call rpc -> IO (RequestMetadata rpc)
- setResponseInitialMetadata :: forall {k} (rpc :: k). HasCallStack => Call rpc -> ResponseInitialMetadata rpc -> IO ()
- sendNextOutput :: forall {k} (rpc :: k). HasCallStack => Call rpc -> Output rpc -> IO ()
- sendFinalOutput :: forall {k} (rpc :: k). HasCallStack => Call rpc -> (Output rpc, ResponseTrailingMetadata rpc) -> IO ()
- sendTrailers :: forall {k} (rpc :: k). HasCallStack => Call rpc -> ResponseTrailingMetadata rpc -> IO ()
- recvNextInputElem :: forall {k} (rpc :: k). HasCallStack => Call rpc -> IO (NextElem (Input rpc))
- recvNextInput :: forall {k} (rpc :: k). HasCallStack => Call rpc -> IO (Input rpc)
- recvFinalInput :: forall {k} (rpc :: k). HasCallStack => Call rpc -> IO (Input rpc)
- recvEndOfInput :: forall {k} (rpc :: k). HasCallStack => Call rpc -> IO ()
- initiateResponse :: forall {k} (rpc :: k). HasCallStack => Call rpc -> IO ()
- sendTrailersOnly :: forall {k} (rpc :: k). HasCallStack => Call rpc -> ResponseTrailingMetadata rpc -> IO ()
- recvInputWithMeta :: forall {k} (rpc :: k). HasCallStack => Call rpc -> IO (StreamElem NoMetadata (InboundMeta, Input rpc))
- sendOutputWithMeta :: forall {k} (rpc :: k). HasCallStack => Call rpc -> StreamElem (ResponseTrailingMetadata rpc) (OutboundMeta, Output rpc) -> IO ()
- getRequestHeaders :: forall {k} (rpc :: k). Call rpc -> IO (RequestHeaders' HandledSynthesized)
- data CallSetupFailure
- data ClientDisconnected = ClientDisconnected {}
- data HandlerTerminated = HandlerTerminated
- data ResponseAlreadyInitiated = ResponseAlreadyInitiated {}
Server proper
mkGrpcServer :: ServerParams -> [SomeRpcHandler IO] -> IO Server Source #
Construct server
The server can be run using the standard infrastructure offered by the
http2 package, but Network.GRPC.Server.Run provides some convenience
functions.
If you are using Protobuf (or if you have another way to compute a list of
methods at the type level), you may wish to use the infrastructure from
Network.GRPC.Server.StreamType (in particular,
fromMethods or
fromServices) to construct the set of
handlers.
Configuration
data ServerParams Source #
Constructors
| ServerParams | |
Fields
| |
Instances
| Default ServerParams Source # | |
Defined in Network.GRPC.Server.Context Methods def :: ServerParams # | |
type RequestHandler a = (forall x. IO x -> IO x) -> Request -> (Response -> IO ()) -> IO a Source #
HTTP2 request handler
data ContentType #
Constructors
| ContentTypeDefault | |
| ContentTypeOverride ByteString |
Instances
Handlers
data RpcHandler (m :: Type -> Type) (rpc :: k) Source #
Handler for an RPC request
To construct an RpcHandler, you have two options:
- Use the "raw" API by calling
mkRpcHandler; this gives you full control over the interaction with the client. - Use the API from Network.GRPC.Server.StreamType to define handlers that
use the Protobuf stream types. This API is more convenient, and can be used
to guarantee at compile-time that you have a handler for every method of
the services you support, but provides less flexibility (although it offers
an "escape" to the full API through
RawMethod).
Note on cancellation. The GRPC spec allows clients to "cancel" a
request (https://grpc.io/docs/guides/cancellation/). This does not
correspond to any specific message being sent across the network; instead,
the client simply disappears. The spec is quite clear that it is the
responsibility of the handler itself to monitor for this. In grapesy this
works as follows:
- Handlers are not terminated when a client disappears. This allows the handler to finish what it's doing, and terminate cleanly.
- When a handler tries to receive a message from the client (
recvInput), or send a message to the client (sendOutput), and the client disappeared, this will result in aClientDisconnectedexception, which the handler can catch and deal with.
Cancellation is always at the request of the client. If the handler
terminates early (that is, before sending the final output and trailers), a
HandlerTerminated exception will be raised and sent to
the client as GrpcException with GrpcUnknown error code.
mkRpcHandler :: forall {k} (rpc :: k) m. (Default (ResponseInitialMetadata rpc), MonadIO m) => (Call rpc -> m ()) -> RpcHandler m rpc Source #
Constructor for RpcHandler
When the handler sends its first message to the client, grapesy must first
send the initial metadata (of type ResponseInitialMetadata) to the client.
This metadata can be updated at any point before that first message (for
example, after receiving some messages from the client) by calling
setResponseInitialMetadata. If this function is never called, however, then
we need a default value; mkRpcHandler therefore calls
setResponseInitialMetadata once before the handler proper, relying on the
Default instance.
For RPCs where a sensible default does not exist (perhaps the initial
response metadata needs the request metadata from the client, or even some
messages from the client), you can use mkRpcHandlerNoDefMetadata.
mkRpcHandlerNoDefMetadata :: forall {k} (rpc :: k) m. (Call rpc -> m ()) -> RpcHandler m rpc Source #
Variant on mkRpcHandler that does not call setResponseInitialMetadata
You must call setResponseInitialMetadata before sending the first
message. See mkRpcHandler for additional discussion.
hoistRpcHandler :: forall {k} m n (rpc :: k). (forall a. m a -> n a) -> RpcHandler m rpc -> RpcHandler n rpc Source #
Hoist an RpcHandler to a different monad
We do not make RpcHandler an instance of MFunctor (from the mmorph
package) because RpcHandler m is not a monad; this means that even though
the types line up, the concepts do not.
Hide rpc type variable
data SomeRpcHandler (m :: Type -> Type) Source #
Wrapper around RpcHandler that hides the type argument
Construct using someRpcHandler.
someRpcHandler :: forall {k} (rpc :: k) (m :: Type -> Type). SupportsServerRpc rpc => RpcHandler m rpc -> SomeRpcHandler m Source #
Constructor for SomeRpcHandler
hoistSomeRpcHandler :: (forall a. m a -> n a) -> SomeRpcHandler m -> SomeRpcHandler n Source #
Open (ongoing) call
recvInput :: forall {k} (rpc :: k). HasCallStack => Call rpc -> IO (StreamElem NoMetadata (Input rpc)) Source #
Receive RPC input from the client
We do not return trailers, since gRPC does not support sending trailers from the client to the server (only from the server to the client).
sendOutput :: forall {k} (rpc :: k). HasCallStack => Call rpc -> StreamElem (ResponseTrailingMetadata rpc) (Output rpc) -> IO () Source #
Send RPC output to the client
This will send a GrpcStatus of GrpcOk to the client; for anything else
(i.e., to indicate something went wrong), the server handler should call
sendGrpcException.
This is a blocking call if this is the final message (i.e., the call will not return until the message has been written to the HTTP2 stream).
sendGrpcException :: forall {k} (rpc :: k). Call rpc -> GrpcException -> IO () Source #
Send GrpcException to the client
This closes the connection to the client; sending further messages will result in an exception being thrown.
Instead of calling sendGrpcException handlers can also simply throw the
gRPC exception (the grapesy client API treats this the same way: a
GrpcStatus other than GrpcOk will be raised as a GrpcException). The
difference is primarily one of preference/convenience, but the two are not
completely the same: when the GrpcException is thrown,
serverTopLevel will see the handler throw an exception (and, by
default, log that exception); when using sendGrpcException, the handler is
considered to have terminated normally. For handlers defined using
Network.GRPC.Server.StreamType throwing the exception is the only option.
Technical note: if the response to the client has not yet been initiated when
sendGrpcException is called, this will make use of the gRPC
Trailers-Only
case.
getRequestMetadata :: forall {k} (rpc :: k). Call rpc -> IO (RequestMetadata rpc) Source #
Get request metadata
The request metadata is included in the client's request headers when they first make the request, and is therefore available immediately to the handler (even if the first message from the client may not yet have been sent).
Dealing with invalid metadata
Metadata can be "invalid" to varying degrees, and we deal with this in different ways:
- The header could be syntactically invalid (e.g. binary data in an ASCII
header), or could use a reserved name. If
serverVerifyHeadersis enabled, such a request will be rejected; if not,getRequestMetadatawill throw an exception in this case. If you need access to these ill-formed headers, be sure to disableserverVerifyHeaders, callgetRequestHeadersto get the full set of request headers, and then inspectrequestUnrecognized. - The headers might be valid, but we might be unable to parse them as the
rpcspecificRequestMetadata(that is,parseMetadatathrows an exception). In this casegetRequestMetadatawill throw an exception if called, but the request will not be rejected even ifserverVerifyHeadersis enabled. If you want access to the raw headers, callgetRequestHeadersand then inspectrequestMetadata. - There might be some additional metadata present. This is really a special
case of the previous point: it depends on the
ParseMetadatainstance whether these additional headers result in an exception or whether they are simply ignored. As above, the full set (including any ignored headers) is always available throughgetRequestHeaders/requestMetadata.
Note: the ParseMetadata instance for NoMetadata is defined to throw an
exception if any metadata is present. The rationale here is that for rpc
without Metadata, there is no need to call getRequestMetadata and co; if
these functions are not called, then any metadata that is present will simply
be ignored. If getRequestMetadata is called, this amounts to check that
no metadata is present.
setResponseInitialMetadata :: forall {k} (rpc :: k). HasCallStack => Call rpc -> ResponseInitialMetadata rpc -> IO () Source #
Set the initial response metadata
This can be set at any time before the response is initiated (either
implicitly by calling sendOutput, or explicitly by calling
initiateResponse or sendTrailersOnly). If the response has already
been initiated (and therefore the initial response metadata already sent),
will throw ResponseAlreadyInitiated.
Note that this is about the initial metadata; additional metadata can be
sent after the final message; see sendOutput.
Protocol specific wrappers
sendNextOutput :: forall {k} (rpc :: k). HasCallStack => Call rpc -> Output rpc -> IO () Source #
Send the next output
If this is the last output, you should call sendTrailers after
(or use sendFinalOutput).
sendFinalOutput :: forall {k} (rpc :: k). HasCallStack => Call rpc -> (Output rpc, ResponseTrailingMetadata rpc) -> IO () Source #
Send final output
See also sendTrailers.
sendTrailers :: forall {k} (rpc :: k). HasCallStack => Call rpc -> ResponseTrailingMetadata rpc -> IO () Source #
Send trailers
This tells the client that there will be no more outputs. You should call
this (or sendFinalOutput) even when there is no special information to be
included in the trailers.
recvNextInputElem :: forall {k} (rpc :: k). HasCallStack => Call rpc -> IO (NextElem (Input rpc)) Source #
Receive RPC input from the client, if one exists
When using recvInput, the final few messages can look like
.. StreamElem msg2 StreamElem msg1 FinalElem msg0 ..
or like
.. StreamElem msg2 StreamElem msg1 StreamElem msg0 NoMoreElems ..
depending on whether the client indicates that msg0 is the last message
when it sends it, or indicates end-of-stream only after sending the last
message.
Many applications do not need to distinguish between these two cases, but
the API provided by recvInput makes it a bit awkward to treat them the
same, especially since it is an error to call recvInput again after
receiving either FinalElem or NoMoreElems. In this case, it may be more
convenient to use recvNextInputElem, which will report both cases as
.. NextElem msg2 NextElem msg1 NextElem msg0 NoNextElem
recvNextInput :: forall {k} (rpc :: k). HasCallStack => Call rpc -> IO (Input rpc) Source #
Receive next input
Throws ProtocolException if there are no more inputs.
recvFinalInput :: forall {k} (rpc :: k). HasCallStack => Call rpc -> IO (Input rpc) Source #
Receive input, which we expect to be the final input
Throws ProtocolException if the input we receive is not final.
NOTE: If the first input we receive from the client is not marked as final, we will block until we receive the end-of-stream indication.
recvEndOfInput :: forall {k} (rpc :: k). HasCallStack => Call rpc -> IO () Source #
Wait for the client to indicate that there are no more inputs
Throws ProtocolException if we received an input.
Low-level/specialized API
initiateResponse :: forall {k} (rpc :: k). HasCallStack => Call rpc -> IO () Source #
Initiate the response
This will cause the initial response metadata to be sent
(see also setResponseMetadata).
Does nothing if the response was already initated (that is, the response
headers, or trailers in the case of sendTrailersOnly, have already been
sent).
sendTrailersOnly :: forall {k} (rpc :: k). HasCallStack => Call rpc -> ResponseTrailingMetadata rpc -> IO () Source #
Use the gRPC Trailers-Only case for non-error responses
Under normal circumstances a gRPC server will respond to the client with
an initial set of headers, then zero or more messages, and finally a set of
trailers. When there are no messages, this can be collapsed into a single
set of trailers (or headers, depending on your point of view); the gRPC
specification refers to this as the Trailers-Only case. It mandates:
Most responses are expected to have both headers and trailers but Trailers-Only is permitted for calls that produce an immediate error.
In grapesy, if a server handler throws a GrpcException, we will make use
of this Trailers-Only case if applicable, as per the specification.
However, some servers make use of Trailers-Only also in non-error cases.
For example, the listFeatures handler in the official Python route guide
example server will use Trailers-Only if there are no features to report.
Since this is not conform the gRPC specification, we do not do this in
grapesy by default, but we make the option available through
sendTrailersOnly.
Throws ResponseAlreadyInitiated if the response has already been initiated.
recvInputWithMeta :: forall {k} (rpc :: k). HasCallStack => Call rpc -> IO (StreamElem NoMetadata (InboundMeta, Input rpc)) Source #
Generalization of recvInput, providing additional meta-information
This can be used to get some information about how the message was sent, such as its compressed and uncompressed size.
Most applications will never need to use this function.
sendOutputWithMeta :: forall {k} (rpc :: k). HasCallStack => Call rpc -> StreamElem (ResponseTrailingMetadata rpc) (OutboundMeta, Output rpc) -> IO () Source #
Generalization of sendOutput with additional control
This can be used for example to enable or disable compression for individual messages.
Most applications will never need to use this function.
getRequestHeaders :: forall {k} (rpc :: k). Call rpc -> IO (RequestHeaders' HandledSynthesized) Source #
Get full request headers, including any potential invalid headers
NOTE: When serverVerifyHeaders is enabled the caller can be sure that the
RequestHeaders' do not contain any errors, even though unfortunately this
is not visible from the type.
Exceptions
data CallSetupFailure Source #
We failed to setup the call from the client
Constructors
| CallSetupInvalidResourceHeaders InvalidResourceHeaders | Client sent resource headers that were not conform the gRPC spec |
| CallSetupInvalidRequestHeaders (InvalidHeaders HandledSynthesized) | Invalid request headers
|
| CallSetupUnsupportedCompression CompressionId | Client chose unsupported compression algorithm This is indicative of a misbehaving peer: a client should not use a compression algorithm unless they have evidence that the server supports it. The server cannot process such a request, as it has no way of decompression messages sent by the client. |
| CallSetupUnimplementedMethod Path | No registered handler for the specified path Note on terminology: HTTP has "methods" such as POST, GET, etc; gRPC
supports only POST, and when another HTTP method is chosen, this will
result in |
| CallSetupHandlerLookupException SomeException | An exception arose while we tried to look up the handler This can arise when the list of handlers itself is |
Instances
| Exception CallSetupFailure Source # | |
Defined in Network.GRPC.Server.Session Methods toException :: CallSetupFailure -> SomeException # fromException :: SomeException -> Maybe CallSetupFailure # | |
| Show CallSetupFailure Source # | |
Defined in Network.GRPC.Server.Session Methods showsPrec :: Int -> CallSetupFailure -> ShowS # show :: CallSetupFailure -> String # showList :: [CallSetupFailure] -> ShowS # | |
data ClientDisconnected Source #
Client disconnected unexpectedly
If you choose to catch this exception, you are advised to match against
the type, rather than against the constructor, and then use the record
accessors to get access to the fields. Future versions of grapesy may
record more information.
Constructors
| ClientDisconnected | |
Instances
| Exception ClientDisconnected Source # | |
Defined in Network.GRPC.Util.HTTP2.Stream Methods toException :: ClientDisconnected -> SomeException # fromException :: SomeException -> Maybe ClientDisconnected # | |
| Show ClientDisconnected Source # | |
Defined in Network.GRPC.Util.HTTP2.Stream Methods showsPrec :: Int -> ClientDisconnected -> ShowS # show :: ClientDisconnected -> String # showList :: [ClientDisconnected] -> ShowS # | |
data HandlerTerminated Source #
Handler terminated early
This gets thrown in the handler, and sent to the client, when the handler terminates before sending the final output and trailers.
Constructors
| HandlerTerminated |
Instances
| Exception HandlerTerminated Source # | |
Defined in Network.GRPC.Server.Call Methods toException :: HandlerTerminated -> SomeException # fromException :: SomeException -> Maybe HandlerTerminated # | |
| Show HandlerTerminated Source # | |
Defined in Network.GRPC.Server.Call Methods showsPrec :: Int -> HandlerTerminated -> ShowS # show :: HandlerTerminated -> String # showList :: [HandlerTerminated] -> ShowS # | |
data ResponseAlreadyInitiated Source #
Constructors
| ResponseAlreadyInitiated | |
Fields
| |
Instances
| Exception ResponseAlreadyInitiated Source # | |
Defined in Network.GRPC.Server.Call | |
| Show ResponseAlreadyInitiated Source # | |
Defined in Network.GRPC.Server.Call Methods showsPrec :: Int -> ResponseAlreadyInitiated -> ShowS # show :: ResponseAlreadyInitiated -> String # showList :: [ResponseAlreadyInitiated] -> ShowS # | |