Safe Haskell | None |
---|---|
Language | Haskell2010 |
Network.GRPC.Client
Synopsis
- data Connection
- data Server
- data ConnParams = ConnParams {}
- withConnection :: ConnParams -> Server -> (Connection -> IO a) -> IO a
- data ReconnectPolicy
- data ReconnectTo
- exponentialBackoff :: (Int -> IO ()) -> Double -> (Double, Double) -> Word -> ReconnectPolicy
- data Scheme
- data Address = Address {}
- data ServerValidation
- data CertificateStoreSpec
- certStoreFromSystem :: CertificateStoreSpec
- certStoreFromCerts :: [SignedCertificate] -> CertificateStoreSpec
- certStoreFromPath :: FilePath -> CertificateStoreSpec
- data Call (rpc :: k)
- 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
- data CallParams (rpc :: k)
- callTimeout :: CallParams rpc -> Maybe Timeout
- callRequestMetadata :: CallParams rpc -> RequestMetadata rpc
- data Timeout = Timeout TimeoutUnit TimeoutValue
- data TimeoutValue where
- pattern TimeoutValue :: Word -> TimeoutValue
- data TimeoutUnit
- = Hour
- | Minute
- | Second
- | Millisecond
- | Microsecond
- | Nanosecond
- timeoutToMicro :: Timeout -> Integer
- sendInput :: forall {k} m (rpc :: k). (HasCallStack, MonadIO m) => Call rpc -> StreamElem NoMetadata (Input rpc) -> m ()
- recvOutput :: forall {k} (rpc :: k) m. (MonadIO m, HasCallStack) => Call rpc -> m (StreamElem (ResponseTrailingMetadata rpc) (Output rpc))
- recvResponseMetadata :: forall {k} (rpc :: k) m. MonadIO m => Call rpc -> m (ResponseMetadata rpc)
- sendNextInput :: forall {k} m (rpc :: k). MonadIO m => Call rpc -> Input rpc -> m ()
- sendFinalInput :: forall {k} m (rpc :: k). MonadIO m => Call rpc -> Input rpc -> m ()
- sendEndOfInput :: forall {k} m (rpc :: k). MonadIO m => Call rpc -> m ()
- recvResponseInitialMetadata :: forall {k} (rpc :: k) m. MonadIO m => Call rpc -> m (ResponseInitialMetadata rpc)
- recvNextOutput :: forall {k} (rpc :: k) m. (MonadIO m, HasCallStack) => Call rpc -> m (Output rpc)
- recvFinalOutput :: forall {k} (rpc :: k) m. (MonadIO m, HasCallStack) => Call rpc -> m (Output rpc, ResponseTrailingMetadata rpc)
- recvTrailers :: forall {k} (rpc :: k) m. (MonadIO m, HasCallStack) => Call rpc -> m (ResponseTrailingMetadata rpc)
- data ResponseHeaders_ (f :: Type -> Type) = ResponseHeaders {
- responseCompression :: HKD f (Maybe CompressionId)
- responseAcceptCompression :: HKD f (Maybe (NonEmpty CompressionId))
- responseContentType :: HKD f (Maybe ContentType)
- responseMetadata :: CustomMetadataMap
- responseUnrecognized :: HKD f ()
- type ResponseHeaders = ResponseHeaders_ Undecorated
- type ResponseHeaders' e = ResponseHeaders_ (Checked (InvalidHeaders e))
- data ProperTrailers_ (f :: Type -> Type) = ProperTrailers {
- properTrailersGrpcStatus :: HKD f GrpcStatus
- properTrailersGrpcMessage :: HKD f (Maybe Text)
- properTrailersStatusDetails :: HKD f (Maybe ByteString)
- properTrailersPushback :: HKD f (Maybe Pushback)
- properTrailersOrcaLoadReport :: HKD f (Maybe OrcaLoadReport)
- properTrailersMetadata :: CustomMetadataMap
- properTrailersUnrecognized :: HKD f ()
- type ProperTrailers = ProperTrailers_ Undecorated
- type ProperTrailers' = ProperTrailers_ (Checked (InvalidHeaders GrpcException))
- data TrailersOnly_ (f :: Type -> Type) = TrailersOnly {
- trailersOnlyContentType :: HKD f (Maybe ContentType)
- trailersOnlyProper :: ProperTrailers_ f
- type TrailersOnly = TrailersOnly_ Undecorated
- type TrailersOnly' e = TrailersOnly_ (Checked (InvalidHeaders e))
- recvNextOutputElem :: forall {k} m (rpc :: k). (MonadIO m, HasCallStack) => Call rpc -> m (NextElem (Output rpc))
- recvInitialResponse :: forall {k} (rpc :: k) m. MonadIO m => Call rpc -> m (Either (TrailersOnly' HandledSynthesized) (ResponseHeaders' HandledSynthesized))
- recvOutputWithMeta :: forall {k} (rpc :: k) m. (MonadIO m, HasCallStack) => Call rpc -> m (StreamElem ProperTrailers' (InboundMeta, Output rpc))
- sendInputWithMeta :: forall {k} m (rpc :: k). (HasCallStack, MonadIO m) => Call rpc -> StreamElem NoMetadata (OutboundMeta, Input rpc) -> m ()
- rpc :: forall {k} (rpc :: k) (styp :: StreamingType) (m :: Type -> Type). (CanCallRPC m, SupportsClientRpc rpc, SupportsStreamingType rpc styp, Default (RequestMetadata rpc)) => ClientHandler' styp m rpc
- rpcWith :: forall {k} (rpc :: k) (styp :: StreamingType) (m :: Type -> Type). (CanCallRPC m, SupportsClientRpc rpc, SupportsStreamingType rpc styp) => CallParams rpc -> ClientHandler' styp m rpc
- data ServerDisconnected = ServerDisconnected {}
- data CallSetupFailure
- data InvalidTrailers = InvalidTrailers {}
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
(MonadIO m, MonadMask m) => CanCallRPC (ReaderT Connection m) Source # | |
Defined in Network.GRPC.Client.StreamType Methods |
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 |
data ConnParams Source #
Connection configuration
You may wish to override connReconnectPolicy
.
Constructors
ConnParams | |
Fields
|
Instances
Default ConnParams Source # | |
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 This is a very general API: typically the IO action will call
|
Instances
Default ReconnectPolicy Source # | The default policy is The default follows the gRPC specification of Wait for Ready semantics https://github.com/grpc/grpc/blob/master/doc/wait-for-ready.md. |
Defined in Network.GRPC.Client.Connection Methods def :: ReconnectPolicy # |
data ReconnectTo Source #
What server should we attempt to reconnect to?
ReconnectToPrevious
will attempt to reconnect to the last server we attempted to connect to, whether or not that attempt was successful.ReconnectToOriginal
will attempt to reconnect to the original server thatwithConnection
was given.ReconnectToNew
will attempt to connect to the newly specified server.
Constructors
ReconnectToPrevious | |
ReconnectToOriginal | |
ReconnectToNew Server |
Instances
Default ReconnectTo Source # | |
Defined in Network.GRPC.Client.Connection Methods def :: ReconnectTo # |
Arguments
:: (Int -> IO ()) | Execute the delay (in microseconds) The default choice here can simply be 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
Constructors
Address | |
Fields |
Secure connection (TLS)
data ServerValidation Source #
How does the client want to validate the server?
Constructors
ValidateServer CertificateStoreSpec | Validate the server The |
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
Show ServerValidation Source # | |
Defined in Network.GRPC.Util.TLS Methods showsPrec :: Int -> ServerValidation -> ShowS # show :: ServerValidation -> String # showList :: [ServerValidation] -> ShowS # |
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 CertificateStore
s through the Monoid
instance.
Instances
Monoid CertificateStoreSpec Source # | |
Defined in Network.GRPC.Util.TLS Methods mempty :: CertificateStoreSpec # mappend :: CertificateStoreSpec -> CertificateStoreSpec -> CertificateStoreSpec # | |
Semigroup CertificateStoreSpec Source # | |
Defined in Network.GRPC.Util.TLS Methods (<>) :: CertificateStoreSpec -> CertificateStoreSpec -> CertificateStoreSpec # sconcat :: NonEmpty CertificateStoreSpec -> CertificateStoreSpec # stimes :: Integral b => b -> CertificateStoreSpec -> CertificateStoreSpec # | |
Show CertificateStoreSpec Source # | |
Defined in Network.GRPC.Util.TLS Methods showsPrec :: Int -> CertificateStoreSpec -> ShowS # show :: CertificateStoreSpec -> String # showList :: [CertificateStoreSpec] -> ShowS # |
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
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
Default (RequestMetadata rpc) => Default (CallParams rpc) | |
Defined in Network.GRPC.Spec.Call Methods def :: CallParams rpc # | |
Show (RequestMetadata rpc) => Show (CallParams rpc) | |
Defined in Network.GRPC.Spec.Call Methods showsPrec :: Int -> CallParams rpc -> ShowS # show :: CallParams rpc -> String # showList :: [CallParams rpc] -> ShowS # |
callTimeout :: CallParams rpc -> Maybe Timeout #
callRequestMetadata :: CallParams rpc -> RequestMetadata rpc #
Timeouts
Constructors
Timeout TimeoutUnit TimeoutValue |
Instances
Generic Timeout | |||||
Defined in Network.GRPC.Spec.Timeout Associated Types
| |||||
Show Timeout | |||||
Eq Timeout | |||||
type Rep Timeout | |||||
Defined in Network.GRPC.Spec.Timeout type Rep Timeout = D1 ('MetaData "Timeout" "Network.GRPC.Spec.Timeout" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "Timeout" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TimeoutUnit) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TimeoutValue))) |
data TimeoutValue where #
Bundled Patterns
pattern TimeoutValue :: Word -> TimeoutValue |
Instances
Generic TimeoutValue | |||||
Defined in Network.GRPC.Spec.Timeout Associated Types
| |||||
Show TimeoutValue | |||||
Defined in Network.GRPC.Spec.Timeout Methods showsPrec :: Int -> TimeoutValue -> ShowS # show :: TimeoutValue -> String # showList :: [TimeoutValue] -> ShowS # | |||||
Eq TimeoutValue | |||||
Defined in Network.GRPC.Spec.Timeout | |||||
type Rep TimeoutValue | |||||
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 #
Constructors
Hour | |
Minute | |
Second | |
Millisecond | |
Microsecond | |
Nanosecond |
Instances
timeoutToMicro :: Timeout -> Integer #
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) #
Constructors
ResponseHeaders | |
Fields
|
Instances
Generic ResponseHeaders | |||||
Defined in Network.GRPC.Spec.Headers.Response Associated Types
Methods from :: ResponseHeaders -> Rep ResponseHeaders x # to :: Rep ResponseHeaders x -> ResponseHeaders # | |||||
Show ResponseHeaders | |||||
Defined in Network.GRPC.Spec.Headers.Response Methods showsPrec :: Int -> ResponseHeaders -> ShowS # show :: ResponseHeaders -> String # showList :: [ResponseHeaders] -> ShowS # | |||||
Eq ResponseHeaders | |||||
Defined in Network.GRPC.Spec.Headers.Response Methods (==) :: ResponseHeaders -> ResponseHeaders -> Bool # (/=) :: ResponseHeaders -> ResponseHeaders -> Bool # | |||||
HasRequiredHeaders ResponseHeaders_ Source # | |||||
Defined in Network.GRPC.Common.Headers Associated Types
Methods requiredHeaders :: ResponseHeaders_ (Checked e) -> Either e (RequiredHeaders ResponseHeaders_) Source # | |||||
Coerce ResponseHeaders_ | |||||
Defined in Network.GRPC.Spec.Headers.Response Methods undecorate :: ResponseHeaders_ (DecoratedWith Identity) -> ResponseHeaders_ Undecorated decorate :: ResponseHeaders_ Undecorated -> ResponseHeaders_ (DecoratedWith Identity) | |||||
Traversable ResponseHeaders_ | |||||
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)) | |||||
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)) | |||||
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 # | |||||
type Rep (ResponseHeaders_ Undecorated) | |||||
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 ())))))) |
type ResponseHeaders = ResponseHeaders_ Undecorated #
type ResponseHeaders' e = ResponseHeaders_ (Checked (InvalidHeaders e)) #
data ProperTrailers_ (f :: Type -> Type) #
Constructors
ProperTrailers | |
Fields
|
Instances
Generic ProperTrailers | |||||
Defined in Network.GRPC.Spec.Headers.Response Associated Types
Methods from :: ProperTrailers -> Rep ProperTrailers x # to :: Rep ProperTrailers x -> ProperTrailers # | |||||
Show ProperTrailers | |||||
Defined in Network.GRPC.Spec.Headers.Response Methods showsPrec :: Int -> ProperTrailers -> ShowS # show :: ProperTrailers -> String # showList :: [ProperTrailers] -> ShowS # | |||||
Eq ProperTrailers | |||||
Defined in Network.GRPC.Spec.Headers.Response Methods (==) :: ProperTrailers -> ProperTrailers -> Bool # (/=) :: ProperTrailers -> ProperTrailers -> Bool # | |||||
Coerce ProperTrailers_ | |||||
Defined in Network.GRPC.Spec.Headers.Response Methods undecorate :: ProperTrailers_ (DecoratedWith Identity) -> ProperTrailers_ Undecorated decorate :: ProperTrailers_ Undecorated -> ProperTrailers_ (DecoratedWith Identity) | |||||
Traversable ProperTrailers_ | |||||
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)) | |||||
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)) | |||||
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) | |||||
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 #
type ProperTrailers' = ProperTrailers_ (Checked (InvalidHeaders GrpcException)) #
data TrailersOnly_ (f :: Type -> Type) #
Constructors
TrailersOnly | |
Fields
|
Instances
Generic TrailersOnly | |||||
Defined in Network.GRPC.Spec.Headers.Response Associated Types
| |||||
Show TrailersOnly | |||||
Defined in Network.GRPC.Spec.Headers.Response Methods showsPrec :: Int -> TrailersOnly -> ShowS # show :: TrailersOnly -> String # showList :: [TrailersOnly] -> ShowS # | |||||
Eq TrailersOnly | |||||
Defined in Network.GRPC.Spec.Headers.Response | |||||
HasRequiredHeaders TrailersOnly_ Source # | |||||
Defined in Network.GRPC.Common.Headers Associated Types
Methods requiredHeaders :: TrailersOnly_ (Checked e) -> Either e (RequiredHeaders TrailersOnly_) Source # | |||||
Coerce TrailersOnly_ | |||||
Defined in Network.GRPC.Spec.Headers.Response Methods undecorate :: TrailersOnly_ (DecoratedWith Identity) -> TrailersOnly_ Undecorated decorate :: TrailersOnly_ Undecorated -> TrailersOnly_ (DecoratedWith Identity) | |||||
Traversable TrailersOnly_ | |||||
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)) | |||||
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)) | |||||
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 # | |||||
Defined in Network.GRPC.Common.Headers | |||||
type Rep (TrailersOnly_ Undecorated) | |||||
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 #
type TrailersOnly' e = TrailersOnly_ (Checked (InvalidHeaders e)) #
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 ServerDisconnected Source #
Server disconnected unexpectedly
See comments for ClientDisconnected
on how to catch this exception.
Constructors
ServerDisconnected | |
Instances
Exception ServerDisconnected Source # | |
Defined in Network.GRPC.Util.HTTP2.Stream Methods toException :: ServerDisconnected -> SomeException # fromException :: SomeException -> Maybe ServerDisconnected # | |
Show ServerDisconnected Source # | |
Defined in Network.GRPC.Util.HTTP2.Stream Methods showsPrec :: Int -> ServerDisconnected -> ShowS # show :: ServerDisconnected -> String # showList :: [ServerDisconnected] -> ShowS # |
data CallSetupFailure Source #
Constructors
CallSetupUnsupportedCompression CompressionId | Server chose an unsupported compression algorithm |
CallSetupInvalidResponseHeaders (InvalidHeaders HandledSynthesized) | We failed to parse the response headers |
Instances
Exception CallSetupFailure Source # | |
Defined in Network.GRPC.Client.Session Methods toException :: CallSetupFailure -> SomeException # fromException :: SomeException -> Maybe CallSetupFailure # | |
Show CallSetupFailure Source # | |
Defined in Network.GRPC.Client.Session Methods showsPrec :: Int -> CallSetupFailure -> ShowS # show :: CallSetupFailure -> String # showList :: [CallSetupFailure] -> ShowS # |
data InvalidTrailers Source #
We failed to parse the response trailers
Constructors
InvalidTrailers | Some of the trailers could not be parsed |
Fields |
Instances
Exception InvalidTrailers Source # | |
Defined in Network.GRPC.Client.Session Methods toException :: InvalidTrailers -> SomeException # fromException :: SomeException -> Maybe InvalidTrailers # displayException :: InvalidTrailers -> String # backtraceDesired :: InvalidTrailers -> Bool # | |
Show InvalidTrailers Source # | |
Defined in Network.GRPC.Client.Session Methods showsPrec :: Int -> InvalidTrailers -> ShowS # show :: InvalidTrailers -> String # showList :: [InvalidTrailers] -> ShowS # |