grapesy
Safe HaskellNone
LanguageHaskell2010

Network.GRPC.Server

Synopsis

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

  • serverCompression :: Negotation

    Server compression preferences

  • serverTopLevel :: RequestHandler () -> RequestHandler ()

    Top-level hook for request handlers

    The most important responsibility of this function is to deal with any exceptions that the handler might throw, but in principle it has full control over how requests are handled.

    The default merely logs any exceptions to stderr.

  • serverExceptionToClient :: SomeException -> IO (Maybe Text)

    Render handler-side exceptions for the client

    When a handler throws an exception other than a GrpcException, we use this function to render that exception for the client (server-side logging is taken care of by serverTopLevel). The default implementation simply calls displayException on the exception, which means the full context is visible on the client, which is most useful for debugging. However, it is a potential security concern: if the exception happens to contain sensitive information, this information will also be visible on the client. You may therefore wish to override the default behaviour.

  • serverContentType :: Maybe ContentType

    Override content-type for response to client.

    Set to Nothing to omit the content-type header completely (this is not conform the gRPC spec).

  • serverVerifyHeaders :: Bool

    Verify that all request headers can be parsed

    When enabled, we verify at the start of each request that all request headers are valid. By default we do not do this, throwing an error only in scenarios where we really cannot continue.

    Even if enabled, we will not attempt to parse rpc-specific metadata (merely that the metadata is syntactically correct). See getRequestMetadata for detailed discussion.

Instances

Instances details
Default ServerParams Source # 
Instance details

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 #

Instances

Instances details
Default ContentType 
Instance details

Defined in Network.GRPC.Spec.Headers.Common

Methods

def :: ContentType #

Generic ContentType 
Instance details

Defined in Network.GRPC.Spec.Headers.Common

Associated Types

type Rep ContentType 
Instance details

Defined in Network.GRPC.Spec.Headers.Common

type Rep ContentType = D1 ('MetaData "ContentType" "Network.GRPC.Spec.Headers.Common" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "ContentTypeDefault" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ContentTypeOverride" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)))
Show ContentType 
Instance details

Defined in Network.GRPC.Spec.Headers.Common

Eq ContentType 
Instance details

Defined in Network.GRPC.Spec.Headers.Common

type Rep ContentType 
Instance details

Defined in Network.GRPC.Spec.Headers.Common

type Rep ContentType = D1 ('MetaData "ContentType" "Network.GRPC.Spec.Headers.Common" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "ContentTypeDefault" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ContentTypeOverride" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)))

Handlers

data Call (rpc :: k) Source #

Open connection to a client

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 a ClientDisconnected exception, 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 serverVerifyHeaders is enabled, such a request will be rejected; if not, getRequestMetadata will throw an exception in this case. If you need access to these ill-formed headers, be sure to disable serverVerifyHeaders, call getRequestHeaders to get the full set of request headers, and then inspect requestUnrecognized.
  • The headers might be valid, but we might be unable to parse them as the rpc specific RequestMetadata (that is, parseMetadata throws an exception). In this case getRequestMetadata will throw an exception if called, but the request will not be rejected even if serverVerifyHeaders is enabled. If you want access to the raw headers, call getRequestHeaders and then inspect requestMetadata.
  • There might be some additional metadata present. This is really a special case of the previous point: it depends on the ParseMetadata instance 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 through getRequestHeaders/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

CallSetupInvalidResourceHeaders refers to an invalid method (anything other than POST) or an invalid path; CallSetupInvalidRequestHeaders means we could not parse the HTTP headers according to the gRPC spec.

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 CallSetupInvalidResourceHeaders. However, gRPC itself also has the concept of a "method" (a method, or gRPC call, supported by a particular service); it's these methods that CallSetupUnimplementedMethod is referring to.

CallSetupHandlerLookupException SomeException

An exception arose while we tried to look up the handler

This can arise when the list of handlers itself is undefined.

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.

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