grapesy
Safe HaskellNone
LanguageHaskell2010

Network.GRPC.Client

Synopsis

Connecting to the server

data Connection Source #

Open connection to server

See withConnection.

Before we can send RPC requests, we have to connect to a specific server first. Once we have opened a connection to that server, we can send as many RPC requests over that one connection as we wish. Connection abstracts over this connection, and also maintains some information about the server.

We can make many RPC calls over the same connection.

Instances

Instances details
(MonadIO m, MonadMask m) => CanCallRPC (ReaderT Connection m) Source # 
Instance details

Defined in Network.GRPC.Client.StreamType

data Server Source #

Constructors

ServerInsecure Address

Make insecure connection (without TLS) to the given server

ServerSecure ServerValidation SslKeyLog Address

Make secure connection (with TLS) to the given server

Instances

Instances details
Show Server Source # 
Instance details

Defined in Network.GRPC.Client.Connection

data ConnParams Source #

Connection configuration

You may wish to override connReconnectPolicy.

Constructors

ConnParams 

Fields

  • connCompression :: Negotation

    Compression negotation

  • connDefaultTimeout :: Maybe Timeout

    Default timeout

    Individual RPC calls can override this through CallParams.

  • connReconnectPolicy :: ReconnectPolicy

    Reconnection policy

    NOTE: The default ReconnectPolicy is DontReconnect, as per the spec (see ReconnectPolicy). You may wish to override this in order to enable Wait for Ready semantics (retry connecting to a server when it is not yet ready) as well as automatic reconnects (reconnecting after a server disappears). The latter can be especially important when there are proxies, which tend to drop connections after a certain amount of time.

  • connContentType :: Maybe ContentType

    Optionally override the content type

    If Nothing, the Content-Type header will be omitted entirely (this is not conform gRPC spec).

  • connVerifyHeaders :: Bool

    Should we verify all request headers?

    This is the client analogue of serverVerifyHeaders; see detailed discussion there.

    Arguably, it is less essential to verify headers on the client: a server must deal with all kinds of different clients, and might want to know if any of those clients has expectations that it cannot fulfill. A client however connects to a known server, and knows what information it wants from the server.

  • connInitCompression :: Maybe Compression

    Optionally set the initial compression algorithm

    Under normal circumstances, the grapesy client will only start using compression once the server has informed it what compression algorithms it supports. This means the first message will necessarily be uncompressed. connCompression can be used to override this behaviour, but should be used with care: if the server does not support the selected compression algorithm, it will not be able to decompress any messages sent by the client to the server.

  • connHTTP2Settings :: HTTP2Settings

    HTTP2 settings

Instances

Instances details
Default ConnParams Source # 
Instance details

Defined in Network.GRPC.Client.Connection

Methods

def :: ConnParams #

withConnection :: ConnParams -> Server -> (Connection -> IO a) -> IO a Source #

Open connection to the server

See withRPC for making individual RPCs on the new connection.

The connection to the server is set up asynchronously; the first call to withRPC will block until the connection has been established.

If the server cannot be reached, the behaviour depends on connReconnectPolicy: if the policy allows reconnection attempts, we will wait the time specified by the policy and try again. This implements the gRPC "Wait for ready" semantics.

If the connection to the server is lost after it has been established, any currently ongoing RPC calls will be closed; attempts at further communication on any of these calls will result in an exception being thrown. However, if the ReconnectPolicy allows, we will automatically try to re-establish a connection to the server. This can be especially important when there is a proxy between the client and the server, which may drop an existing connection after a certain period.

NOTE: The default ReconnectPolicy is DontReconnect, as per the gRPC specification of "Wait for ready" semantics. You may wish to override this default.

Clients should prefer sending many calls on a single connection, rather than sending few calls on many connections, as minimizing the number of connections used via this interface results in better memory behavior. See well-typed/grapesy#134 for discussion.

Reconnection policy

data ReconnectPolicy Source #

Reconnect policy

See exponentialBackoff for a convenient function to construct a policy.

Constructors

DontReconnect

Do not attempt to reconnect

When we get disconnected from the server (or fail to establish a connection), do not attempt to connect again.

ReconnectAfter ReconnectTo (IO ReconnectPolicy)

Reconnect to the (potentially different) server after the IO action returns

The ReconnectTo can be used to implement a rudimentary redundancy scheme. For example, you could decide to reconnect to a known fallback server after connection to a main server fails a certain number of times.

This is a very general API: typically the IO action will call threadDelay after some amount of time (which will typically involve some randomness), but it can be used to do things such as display a message to the user somewhere that the client is reconnecting.

Instances

Instances details
Default ReconnectPolicy Source #

The default policy is DontReconnect

The default follows the gRPC specification of Wait for Ready semantics https://github.com/grpc/grpc/blob/master/doc/wait-for-ready.md.

Instance details

Defined in Network.GRPC.Client.Connection

data ReconnectTo Source #

What server should we attempt to reconnect to?

Instances

Instances details
Default ReconnectTo Source # 
Instance details

Defined in Network.GRPC.Client.Connection

Methods

def :: ReconnectTo #

exponentialBackoff Source #

Arguments

:: (Int -> IO ())

Execute the delay (in microseconds)

The default choice here can simply be threadDelay, but it is also possible to use this to add some logging. Simple example:

waitFor :: Int -> IO ()
waitFor delay = do
  putStrLn $ "Disconnected. Reconnecting after " ++ show delay ++ "μs"
  threadDelay delay
  putStrLn "Reconnecting now."
-> Double

Exponent

-> (Double, Double)

Initial delay

-> Word

Maximum number of attempts

-> ReconnectPolicy 

Exponential backoff

If the exponent is 1, the delay interval will be the same every step; for an exponent of greater than 1, we will wait longer each step.

Connection parameters

data Scheme #

Constructors

Http 
Https 

Instances

Instances details
Show Scheme 
Instance details

Defined in Network.GRPC.Spec.Headers.PseudoHeaders

data Address #

Instances

Instances details
Show Address 
Instance details

Defined in Network.GRPC.Spec.Headers.PseudoHeaders

Secure connection (TLS)

data ServerValidation Source #

How does the client want to validate the server?

Constructors

ValidateServer CertificateStoreSpec

Validate the server

The CertificateStore is a collection of trust anchors. If Nothing is specified, the system certificate store will be used.

NoServerValidation

Skip server validation

WARNING: This is dangerous. Although communication with the server will still be encrypted, you cannot be sure that the server is who they claim to be.

Instances

Instances details
Show ServerValidation Source # 
Instance details

Defined in Network.GRPC.Util.TLS

data CertificateStoreSpec Source #

Certificate store specification (for certificate validation)

This is a deep embedding, describing how to construct a certificate store. The actual construction happens in loadCertificateStore.

There are three primitive ways to construct a CertificateStore: certStoreFromSystem, certStoreFromCerts, and certStoreFromPath; please refer to the corresponding documentation.

You can also combine CertificateStores through the Monoid instance.

certStoreFromSystem :: CertificateStoreSpec Source #

Use the system's certificate store

certStoreFromCerts :: [SignedCertificate] -> CertificateStoreSpec Source #

Construct a certificate store with the given certificates

certStoreFromPath :: FilePath -> CertificateStoreSpec Source #

Load certificate store from disk

The path may point to single file (multiple PEM formatted certificates concanated) or directory (one certificate per file, file names are hashes from certificate).

Make RPCs

data Call (rpc :: k) Source #

State of the call

This type is kept abstract (opaque) in the public facing API.

withRPC :: forall {k} (rpc :: k) m a. (MonadMask m, MonadIO m, SupportsClientRpc rpc, HasCallStack) => Connection -> CallParams rpc -> Proxy rpc -> (Call rpc -> m a) -> m a Source #

Scoped RPC call

This is the low-level API for making RPC calls, providing full flexibility. You may wish to consider using the infrastructure from Network.GRPC.Client.StreamType.IO instead.

Typical usage:

withRPC conn def (Proxy @ListFeatures) $ \call -> do
  .. use 'call' to send and receive messages

for some previously established connection conn (see withConnection) and where ListFeatures is some kind of RPC.

The call is setup in the background, and might not yet have been established when the body is run. If you want to be sure that the call has been setup, you can call recvResponseMetadata.

Leaving the scope of withRPC before the client informs the server that they have sent their last message (using sendInput or sendEndOfInput) is considered a cancellation, and accordingly throws a GrpcException with GrpcCancelled (see also https://grpc.io/docs/guides/cancellation/).

There is one exception to this rule: if the server unilaterally closes the RPC (that is, the server already sent the trailers), then the call is considered closed and the cancellation exception is not raised. Under normal circumstances (with well-behaved server handlers) this should not arise. (The gRPC specification itself is not very specific about this case; see discussion at https://stackoverflow.com/questions/55511528/should-grpc-server-side-half-closing-implicitly-terminate-the-client.)

If there are still inbound messages upon leaving the scope of withRPC no exception is raised (but the call is nonetheless still closed, and the server handler will be informed that the client has disappeared).

Note on timeouts: if a timeout is specified for the call (either through callTimeout or through connDefaultTimeout), when the timeout is reached the RPC is cancelled; any further attempts to receive or send messages will result in a GrpcException with GrpcDeadlineExceeded. As per the gRPC specification, this does not rely on the server; this does mean that the same deadline also applies if the client is slow (rather than the server).

Parameters

data CallParams (rpc :: k) #

Instances

Instances details
Default (RequestMetadata rpc) => Default (CallParams rpc) 
Instance details

Defined in Network.GRPC.Spec.Call

Methods

def :: CallParams rpc #

Show (RequestMetadata rpc) => Show (CallParams rpc) 
Instance details

Defined in Network.GRPC.Spec.Call

Methods

showsPrec :: Int -> CallParams rpc -> ShowS #

show :: CallParams rpc -> String #

showList :: [CallParams rpc] -> ShowS #

Timeouts

data Timeout #

Instances

Instances details
Generic Timeout 
Instance details

Defined in Network.GRPC.Spec.Timeout

Associated Types

type Rep Timeout 
Instance details

Defined in Network.GRPC.Spec.Timeout

Methods

from :: Timeout -> Rep Timeout x #

to :: Rep Timeout x -> Timeout #

Show Timeout 
Instance details

Defined in Network.GRPC.Spec.Timeout

Eq Timeout 
Instance details

Defined in Network.GRPC.Spec.Timeout

Methods

(==) :: Timeout -> Timeout -> Bool #

(/=) :: Timeout -> Timeout -> Bool #

type Rep Timeout 
Instance details

Defined in Network.GRPC.Spec.Timeout

data TimeoutValue where #

Bundled Patterns

pattern TimeoutValue :: Word -> TimeoutValue 

Instances

Instances details
Generic TimeoutValue 
Instance details

Defined in Network.GRPC.Spec.Timeout

Associated Types

type Rep TimeoutValue 
Instance details

Defined in Network.GRPC.Spec.Timeout

type Rep TimeoutValue = D1 ('MetaData "TimeoutValue" "Network.GRPC.Spec.Timeout" "grpc-spec-1.0.0-inplace" 'True) (C1 ('MetaCons "UnsafeTimeoutValue" 'PrefixI 'True) (S1 ('MetaSel ('Just "getTimeoutValue") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word)))
Show TimeoutValue 
Instance details

Defined in Network.GRPC.Spec.Timeout

Eq TimeoutValue 
Instance details

Defined in Network.GRPC.Spec.Timeout

type Rep TimeoutValue 
Instance details

Defined in Network.GRPC.Spec.Timeout

type Rep TimeoutValue = D1 ('MetaData "TimeoutValue" "Network.GRPC.Spec.Timeout" "grpc-spec-1.0.0-inplace" 'True) (C1 ('MetaCons "UnsafeTimeoutValue" 'PrefixI 'True) (S1 ('MetaSel ('Just "getTimeoutValue") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word)))

data TimeoutUnit #

Instances

Instances details
Generic TimeoutUnit 
Instance details

Defined in Network.GRPC.Spec.Timeout

Associated Types

type Rep TimeoutUnit 
Instance details

Defined in Network.GRPC.Spec.Timeout

type Rep TimeoutUnit = D1 ('MetaData "TimeoutUnit" "Network.GRPC.Spec.Timeout" "grpc-spec-1.0.0-inplace" 'False) ((C1 ('MetaCons "Hour" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Minute" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Second" 'PrefixI 'False) (U1 :: Type -> Type))) :+: (C1 ('MetaCons "Millisecond" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Microsecond" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Nanosecond" 'PrefixI 'False) (U1 :: Type -> Type))))
Show TimeoutUnit 
Instance details

Defined in Network.GRPC.Spec.Timeout

Eq TimeoutUnit 
Instance details

Defined in Network.GRPC.Spec.Timeout

type Rep TimeoutUnit 
Instance details

Defined in Network.GRPC.Spec.Timeout

type Rep TimeoutUnit = D1 ('MetaData "TimeoutUnit" "Network.GRPC.Spec.Timeout" "grpc-spec-1.0.0-inplace" 'False) ((C1 ('MetaCons "Hour" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Minute" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Second" 'PrefixI 'False) (U1 :: Type -> Type))) :+: (C1 ('MetaCons "Millisecond" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Microsecond" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Nanosecond" 'PrefixI 'False) (U1 :: Type -> Type))))

Ongoing calls

Call denotes a previously opened request (see withRPC).

Protobuf communication patterns

This is a general implementation of the gRPC specification. As such, these functions do not provide explicit support for the common communication patterns of non-streaming, server-side streaming, client-side streaming, or bidirectional streaming. These are not part of the gRPC standard, but are part of its Protobuf instantiation, although these patterns are of course not really Protobuf specific. We provide support for these communication patterns, independent from a choice of serialization format, in Network.GRPC.Common.StreamType and Network.GRPC.Client.StreamType (and Network.GRPC.Server.StreamType for the server side).

If you only use the abstractions provided in "Network.GRPC.*.StreamType", you can ignore the rest of the discussion below, which applies only to the more general interface.

Stream elements

Both sendInput and recvOutput work with StreamElem:

data StreamElem b a =
    StreamElem a
  | FinalElem a b
  | NoMoreElems b

The intuition is that we are sending messages of type a (see "Inputs and outputs", below) and then when we send the final message, we can include some additional information of type b (see "Metadata", below).

Inputs and outputs

By convention, we refer to messages sent from the client to the server as "inputs" and messages sent from the server to the client as "outputs" (we inherited this terminology from proto-lens.) On the client side we therefore have recvOutput and sendInput defined as

recvOutput :: Call rpc -> m (StreamElem (ResponseTrailingMetadata rpc) (Output rpc))
sendInput  :: Call rpc -> StreamElem NoMetadata (Input rpc) -> m ()

and on the server side we have recvInput and sendOutput:

recvInput  :: Call rpc -> IO (StreamElem NoMetadata (Input rpc))
sendOutput :: Call rpc -> StreamElem (ResponseTrailingMetadata rpc) (Output rpc) -> IO ()

Metadata

Both the server and the client can send some metadata before they send their first message; see withRPC and callRequestMetadata for the client-side (and setResponseInitialMetadata for the server-side).

The gRPC specification allows the server, but not the client, to include some final metadata as well; this is the reason between the use of ResponseTrailingMetadata for messages from the server to the client versus NoMetadata for messages from the client.

FinalElem versus NoMoreElems

StreamElem allows to mark the final message as final when it is sent (FinalElem), or retroactively indicate that the previous message was in fact final (NoMoreElems). The reason for this is technical in nature.

Suppose we are doing a grpc+proto non-streaming RPC call. The input message from the client to the server will be sent over one or more HTTP2 DATA frames (chunks of the input). The server will expect the last of those frames to be marked as END_STREAM. The HTTP2 specification does allow sending an separate empty DATA frame with the END_STREAM flag set to indicate no further data is coming, but not all gRPC servers will wait for this, and might either think that the client is broken and disconnect, or might send the client a RST_STREAM frame to force it to close the stream. To avoid problems, therefore, it is better to mark the final DATA frame as END_STREAM; in order to be able to do that, sendInput needs to know whether an input is the final one. It is therefore better to use FinalElem instead of NoMoreElems for outgoing messages, if possible.

For incoming messages the situation is different. Now we do expect HTTP trailers (final metadata), which means that we cannot tell from DATA frames alone if we have received the last message: it will be the frame containing the trailers that is marked as END_STREAM, with no indication on the data frame just before it that it was the last one. We cannot wait for the next frame to come in, because that would be a blocking call (we might have to wait for the next TCP packet), and if the output was not the last one, we would unnecessarily delay making the output we already received available to the client code. Typically therefore clients will receive a StreamElem followed by NoMoreElems.

Of course, for a given RPC and its associated communication pattern we may know whether any given message was the last; in the example above of a non-streaming grpc+proto RPC call, we only expect a single output. In this case the client can (and should) call recvOutput again to wait for the trailers (which, amongst other things, will include the trailerGrpcStatus). The specialized functions from Network.GRPC.Client.StreamType take care of this; if these functions are not applicable, users may wish to use recvFinalOutput.

sendInput :: forall {k} m (rpc :: k). (HasCallStack, MonadIO m) => Call rpc -> StreamElem NoMetadata (Input rpc) -> m () Source #

Send an input to the peer

Calling sendInput again after sending the final message is a bug.

recvOutput :: forall {k} (rpc :: k) m. (MonadIO m, HasCallStack) => Call rpc -> m (StreamElem (ResponseTrailingMetadata rpc) (Output rpc)) Source #

Receive an output from the peer

After the final Output, you will receive any custom metadata (application defined trailers) that the server returns. We do NOT include the GrpcStatus here: a status of GrpcOk carries no information, and any other status will result in a GrpcException. Calling recvOutput again after receiving the trailers is a bug and results in a RecvAfterFinal exception.

recvResponseMetadata :: forall {k} (rpc :: k) m. MonadIO m => Call rpc -> m (ResponseMetadata rpc) Source #

The initial metadata that was included in the response headers

The server can send two sets of metadata: an initial set of type ResponseInitialMetadata when it first initiates the response, and then a final set of type ResponseTrailingMetadata after the final message (see recvOutput).

It is however possible for the server to send only a single set; this is the gRPC "Trailers-Only" case. The server can choose to do so when it knows it will not send any messages; in this case, the initial response metadata is fact of type ResponseTrailingMetadata instead. The ResponseMetadata type distinguishes between these two cases.

If the "Trailers-Only" case can be ruled out (that is, if it would amount to a protocol error), you can use recvResponseInitialMetadata instead.

This can block: we need to wait until we receive the metadata. The precise communication pattern will depend on the specifics of each server:

  • It might be necessary to send one or more inputs to the server before it returns any replies.
  • The response metadata will be available before the first output from the server, and may indeed be available well before.

Protocol specific wrappers

sendNextInput :: forall {k} m (rpc :: k). MonadIO m => Call rpc -> Input rpc -> m () Source #

Send the next input

If this is the last input, you should call sendFinalInput instead.

sendFinalInput :: forall {k} m (rpc :: k). MonadIO m => Call rpc -> Input rpc -> m () Source #

Send final input

For some servers it is important that the client marks the final input /when it is sent/. If you really want to send the final input and separately tell the server that no more inputs will be provided, use sendEndOfInput (or sendInput).

sendEndOfInput :: forall {k} m (rpc :: k). MonadIO m => Call rpc -> m () Source #

Indicate that there are no more inputs

See sendFinalInput for additional discussion.

recvResponseInitialMetadata :: forall {k} (rpc :: k) m. MonadIO m => Call rpc -> m (ResponseInitialMetadata rpc) Source #

Receive initial metadata

This is a specialization of recvResponseMetadata which can be used if a use of "Trailers-Only" amounts to a protocol error; if the server does use "Trailers-Only", this throws a ProtoclException (UnexpectedTrailersOnly).

recvNextOutput :: forall {k} (rpc :: k) m. (MonadIO m, HasCallStack) => Call rpc -> m (Output rpc) Source #

Receive the next output

Throws ProtocolException if there are no more outputs.

recvFinalOutput :: forall {k} (rpc :: k) m. (MonadIO m, HasCallStack) => Call rpc -> m (Output rpc, ResponseTrailingMetadata rpc) Source #

Receive output, which we expect to be the final output

Throws ProtocolException if the output we receive is not final.

NOTE: If the first output we receive from the server is not marked as final, we will block until we receive the end-of-stream indication.

recvTrailers :: forall {k} (rpc :: k) m. (MonadIO m, HasCallStack) => Call rpc -> m (ResponseTrailingMetadata rpc) Source #

Receive trailers

Throws ProtocolException if we received an output.

Low-level/specialized API

data ResponseHeaders_ (f :: Type -> Type) #

Instances

Instances details
Generic ResponseHeaders 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Associated Types

type Rep (ResponseHeaders_ Undecorated) 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

type Rep (ResponseHeaders_ Undecorated) = D1 ('MetaData "ResponseHeaders_" "Network.GRPC.Spec.Headers.Response" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "ResponseHeaders" 'PrefixI 'True) ((S1 ('MetaSel ('Just "responseCompression") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe CompressionId))) :*: S1 ('MetaSel ('Just "responseAcceptCompression") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe (NonEmpty CompressionId))))) :*: (S1 ('MetaSel ('Just "responseContentType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe ContentType))) :*: (S1 ('MetaSel ('Just "responseMetadata") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 CustomMetadataMap) :*: S1 ('MetaSel ('Just "responseUnrecognized") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated ()))))))
Show ResponseHeaders 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Eq ResponseHeaders 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

HasRequiredHeaders ResponseHeaders_ Source # 
Instance details

Defined in Network.GRPC.Common.Headers

Coerce ResponseHeaders_ 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Methods

undecorate :: ResponseHeaders_ (DecoratedWith Identity) -> ResponseHeaders_ Undecorated

decorate :: ResponseHeaders_ Undecorated -> ResponseHeaders_ (DecoratedWith Identity)

Traversable ResponseHeaders_ 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Methods

traverse :: Applicative m => (forall a. f a -> m (g a)) -> ResponseHeaders_ (DecoratedWith f) -> m (ResponseHeaders_ (DecoratedWith g))

Show e => Show (ResponseHeaders_ (Checked e)) 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Methods

showsPrec :: Int -> ResponseHeaders_ (Checked e) -> ShowS #

show :: ResponseHeaders_ (Checked e) -> String #

showList :: [ResponseHeaders_ (Checked e)] -> ShowS #

Eq e => Eq (ResponseHeaders_ (Checked e)) 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Methods

(==) :: ResponseHeaders_ (Checked e) -> ResponseHeaders_ (Checked e) -> Bool #

(/=) :: ResponseHeaders_ (Checked e) -> ResponseHeaders_ (Checked e) -> Bool #

data RequiredHeaders ResponseHeaders_ Source # 
Instance details

Defined in Network.GRPC.Common.Headers

type Rep (ResponseHeaders_ Undecorated) 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

type Rep (ResponseHeaders_ Undecorated) = D1 ('MetaData "ResponseHeaders_" "Network.GRPC.Spec.Headers.Response" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "ResponseHeaders" 'PrefixI 'True) ((S1 ('MetaSel ('Just "responseCompression") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe CompressionId))) :*: S1 ('MetaSel ('Just "responseAcceptCompression") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe (NonEmpty CompressionId))))) :*: (S1 ('MetaSel ('Just "responseContentType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe ContentType))) :*: (S1 ('MetaSel ('Just "responseMetadata") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 CustomMetadataMap) :*: S1 ('MetaSel ('Just "responseUnrecognized") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated ()))))))

data ProperTrailers_ (f :: Type -> Type) #

Instances

Instances details
Generic ProperTrailers 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Associated Types

type Rep (ProperTrailers_ Undecorated) 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

type Rep (ProperTrailers_ Undecorated) = D1 ('MetaData "ProperTrailers_" "Network.GRPC.Spec.Headers.Response" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "ProperTrailers" 'PrefixI 'True) ((S1 ('MetaSel ('Just "properTrailersGrpcStatus") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated GrpcStatus)) :*: (S1 ('MetaSel ('Just "properTrailersGrpcMessage") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe Text))) :*: S1 ('MetaSel ('Just "properTrailersStatusDetails") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe ByteString))))) :*: ((S1 ('MetaSel ('Just "properTrailersPushback") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe Pushback))) :*: S1 ('MetaSel ('Just "properTrailersOrcaLoadReport") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe OrcaLoadReport)))) :*: (S1 ('MetaSel ('Just "properTrailersMetadata") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 CustomMetadataMap) :*: S1 ('MetaSel ('Just "properTrailersUnrecognized") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated ()))))))
Show ProperTrailers 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Eq ProperTrailers 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Coerce ProperTrailers_ 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Methods

undecorate :: ProperTrailers_ (DecoratedWith Identity) -> ProperTrailers_ Undecorated

decorate :: ProperTrailers_ Undecorated -> ProperTrailers_ (DecoratedWith Identity)

Traversable ProperTrailers_ 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Methods

traverse :: Applicative m => (forall a. f a -> m (g a)) -> ProperTrailers_ (DecoratedWith f) -> m (ProperTrailers_ (DecoratedWith g))

Show e => Show (ProperTrailers_ (Checked e)) 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Methods

showsPrec :: Int -> ProperTrailers_ (Checked e) -> ShowS #

show :: ProperTrailers_ (Checked e) -> String #

showList :: [ProperTrailers_ (Checked e)] -> ShowS #

Eq e => Eq (ProperTrailers_ (Checked e)) 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Methods

(==) :: ProperTrailers_ (Checked e) -> ProperTrailers_ (Checked e) -> Bool #

(/=) :: ProperTrailers_ (Checked e) -> ProperTrailers_ (Checked e) -> Bool #

type Rep (ProperTrailers_ Undecorated) 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

type Rep (ProperTrailers_ Undecorated) = D1 ('MetaData "ProperTrailers_" "Network.GRPC.Spec.Headers.Response" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "ProperTrailers" 'PrefixI 'True) ((S1 ('MetaSel ('Just "properTrailersGrpcStatus") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated GrpcStatus)) :*: (S1 ('MetaSel ('Just "properTrailersGrpcMessage") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe Text))) :*: S1 ('MetaSel ('Just "properTrailersStatusDetails") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe ByteString))))) :*: ((S1 ('MetaSel ('Just "properTrailersPushback") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe Pushback))) :*: S1 ('MetaSel ('Just "properTrailersOrcaLoadReport") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe OrcaLoadReport)))) :*: (S1 ('MetaSel ('Just "properTrailersMetadata") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 CustomMetadataMap) :*: S1 ('MetaSel ('Just "properTrailersUnrecognized") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated ()))))))

type ProperTrailers = ProperTrailers_ Undecorated #

data TrailersOnly_ (f :: Type -> Type) #

Instances

Instances details
Generic TrailersOnly 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Associated Types

type Rep (TrailersOnly_ Undecorated) 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

type Rep (TrailersOnly_ Undecorated) = D1 ('MetaData "TrailersOnly_" "Network.GRPC.Spec.Headers.Response" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "TrailersOnly" 'PrefixI 'True) (S1 ('MetaSel ('Just "trailersOnlyContentType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe ContentType))) :*: S1 ('MetaSel ('Just "trailersOnlyProper") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (ProperTrailers_ Undecorated))))
Show TrailersOnly 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Eq TrailersOnly 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

HasRequiredHeaders TrailersOnly_ Source # 
Instance details

Defined in Network.GRPC.Common.Headers

Coerce TrailersOnly_ 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Methods

undecorate :: TrailersOnly_ (DecoratedWith Identity) -> TrailersOnly_ Undecorated

decorate :: TrailersOnly_ Undecorated -> TrailersOnly_ (DecoratedWith Identity)

Traversable TrailersOnly_ 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Methods

traverse :: Applicative m => (forall a. f a -> m (g a)) -> TrailersOnly_ (DecoratedWith f) -> m (TrailersOnly_ (DecoratedWith g))

Show e => Show (TrailersOnly_ (Checked e)) 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Methods

showsPrec :: Int -> TrailersOnly_ (Checked e) -> ShowS #

show :: TrailersOnly_ (Checked e) -> String #

showList :: [TrailersOnly_ (Checked e)] -> ShowS #

Eq e => Eq (TrailersOnly_ (Checked e)) 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Methods

(==) :: TrailersOnly_ (Checked e) -> TrailersOnly_ (Checked e) -> Bool #

(/=) :: TrailersOnly_ (Checked e) -> TrailersOnly_ (Checked e) -> Bool #

data RequiredHeaders TrailersOnly_ Source # 
Instance details

Defined in Network.GRPC.Common.Headers

type Rep (TrailersOnly_ Undecorated) 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

type Rep (TrailersOnly_ Undecorated) = D1 ('MetaData "TrailersOnly_" "Network.GRPC.Spec.Headers.Response" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "TrailersOnly" 'PrefixI 'True) (S1 ('MetaSel ('Just "trailersOnlyContentType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe ContentType))) :*: S1 ('MetaSel ('Just "trailersOnlyProper") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (ProperTrailers_ Undecorated))))

type TrailersOnly = TrailersOnly_ Undecorated #

recvNextOutputElem :: forall {k} m (rpc :: k). (MonadIO m, HasCallStack) => Call rpc -> m (NextElem (Output rpc)) Source #

Receive an output from the peer, if one exists

If this is the final output, the next call to recvNextOutputElem will return NoNextElem; see also recvNextInputElem for detailed discussion.

recvInitialResponse :: forall {k} (rpc :: k) m. MonadIO m => Call rpc -> m (Either (TrailersOnly' HandledSynthesized) (ResponseHeaders' HandledSynthesized)) Source #

Return the initial response from the server

This is a low-level function, and generalizes recvResponseInitialMetadata. If the server returns a gRPC error, that will be returned as a value here rather than thrown as an exception.

Most applications will never need to use this function.

recvOutputWithMeta :: forall {k} (rpc :: k) m. (MonadIO m, HasCallStack) => Call rpc -> m (StreamElem ProperTrailers' (InboundMeta, Output rpc)) Source #

Generalization of recvOutput, providing additional meta-information

This returns the full set of trailers, /even if those trailers indicate a gRPC failure, or if any trailers fail to parse/. Put another way, gRPC failures are returned as values here, rather than throwing an exception.

Most applications will never need to use this function.

See also recvInputWithMeta.

sendInputWithMeta :: forall {k} m (rpc :: k). (HasCallStack, MonadIO m) => Call rpc -> StreamElem NoMetadata (OutboundMeta, Input rpc) -> m () Source #

Generalization of sendInput, providing additional control

See also sendOutputWithMeta.

Most applications will never need to use this function.

Communication patterns

rpc :: forall {k} (rpc :: k) (styp :: StreamingType) (m :: Type -> Type). (CanCallRPC m, SupportsClientRpc rpc, SupportsStreamingType rpc styp, Default (RequestMetadata rpc)) => ClientHandler' styp m rpc Source #

Construct RPC handler

This has an ambiguous type, and is intended to be called using a type application indicating the rpc method to call, such as

rpc @Ping

provided that Ping is some type with an IsRPC instance. In some cases it may also be needed to provide a streaming type:

rpc @Ping @NonStreaming

though in most cases the streaming type should be clear from the context or from the choice of rpc.

See nonStreaming and co for examples. See also rpcWith.

rpcWith :: forall {k} (rpc :: k) (styp :: StreamingType) (m :: Type -> Type). (CanCallRPC m, SupportsClientRpc rpc, SupportsStreamingType rpc styp) => CallParams rpc -> ClientHandler' styp m rpc Source #

Generalization of rpc with custom CallParams

Exceptions

data InvalidTrailers Source #

We failed to parse the response trailers

Constructors

InvalidTrailers

Some of the trailers could not be parsed