grpc-spec
Safe HaskellNone
LanguageHaskell2010

Network.GRPC.Spec

Description

Pure implementation of the gRPC spec

Most code will not need to use this module directly.

Intended for unqualified import.

Synopsis

RPC

class (NFData (Input rpc), NFData (Output rpc), Show (Input rpc), Show (Output rpc), Show (RequestMetadata rpc), Show (ResponseInitialMetadata rpc), Show (ResponseTrailingMetadata rpc)) => IsRPC (rpc :: k) where Source #

Abstract definition of an RPC

Note on encoding: the gRPC specification does not say anything about text encoding issues for paths (service names and method names) or message types. The Protobuf compiler (by far the most common instantation of gRPC) does not allow for non-ASCII character at all ("interpreting non ascii codepoint"). We therefore punt on the encoding issue here, and use bytestrings. If applications want to use non-ASCII characters, they can choose their own encoding.

Methods

rpcContentType :: Proxy rpc -> ByteString Source #

Content-type

gRPC is agnostic to the message format; the spec defines the Content-Type header as

Content-Type →
  "content-type"
  "application/grpc"
  [("+proto" / "+json" / {custom})]

defaultRpcContentType can be used in the case that the format (such as proto) is known.

Note on terminology: throughout this codebase we avoid the terms "encoding" and "decoding", which can be ambiguous. Instead we use "serialize"/"deserialize" and "compress"/"decompress".

rpcServiceName :: Proxy rpc -> ByteString Source #

Service name

For Protobuf, this is the fully qualified service name.

rpcMethodName :: Proxy rpc -> ByteString Source #

Method name

For Protobuf, this is just the method name (no qualifier required).

rpcMessageType :: Proxy rpc -> Maybe ByteString Source #

Message type, if specified

This is used to set the (optional) grpc-message-type header. For Protobuf, this is the fully qualified message type.

Instances

Instances details
(KnownSymbol serv, KnownSymbol meth, NFData (Input (JsonRpc serv meth)), NFData (Output (JsonRpc serv meth)), Show (Input (JsonRpc serv meth)), Show (Output (JsonRpc serv meth)), Show (RequestMetadata (JsonRpc serv meth)), Show (ResponseInitialMetadata (JsonRpc serv meth)), Show (ResponseTrailingMetadata (JsonRpc serv meth))) => IsRPC (JsonRpc serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

(HasMethodImpl serv meth, Show (MethodInput serv meth), Show (MethodOutput serv meth), NFData (MethodInput serv meth), NFData (MethodOutput serv meth), Show (RequestMetadata (Protobuf serv meth)), Show (ResponseInitialMetadata (Protobuf serv meth)), Show (ResponseTrailingMetadata (Protobuf serv meth))) => IsRPC (Protobuf serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

(KnownSymbol serv, KnownSymbol meth, Show (RequestMetadata (RawRpc serv meth)), Show (ResponseInitialMetadata (RawRpc serv meth)), Show (ResponseTrailingMetadata (RawRpc serv meth))) => IsRPC (RawRpc serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Raw

type family Input (rpc :: k) Source #

Messages from the client to the server

Instances

Instances details
type Input (Protobuf serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

type Input (Protobuf serv meth :: Type) = Proto (MethodInput serv meth)
type Input (RawRpc serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Raw

type Input (RawRpc serv meth :: Type) = ByteString

type family Output (rpc :: k) Source #

Messages from the server to the client

Instances

Instances details
type Output (Protobuf serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

type Output (Protobuf serv meth :: Type) = Proto (MethodOutput serv meth)
type Output (RawRpc serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Raw

type Output (RawRpc serv meth :: Type) = ByteString

class (IsRPC rpc, BuildMetadata (RequestMetadata rpc), ParseMetadata (ResponseInitialMetadata rpc), ParseMetadata (ResponseTrailingMetadata rpc)) => SupportsClientRpc (rpc :: k) where Source #

Client-side RPC

Methods

rpcSerializeInput :: Proxy rpc -> Input rpc -> ByteString Source #

Serialize RPC input

We don't ask for a builder here, but instead ask for the complete serialized form. gRPC insists that individual messages are length prefixed, so we must compute the full serialization in memory before we can send anything.

We use the terms "serialize" and "deserialize" here, and "compress"/"decompress" for compression, rather than "encode"/"decode", which could refer to either process.

rpcDeserializeOutput :: Proxy rpc -> ByteString -> Either String (Output rpc) Source #

Deserialize RPC output

Discussion of rpcDeserializeInput applies here, also.

Instances

Instances details
(IsRPC (JsonRpc serv meth), ToJSON (Input (JsonRpc serv meth)), FromJSON (Output (JsonRpc serv meth)), BuildMetadata (RequestMetadata (JsonRpc serv meth)), ParseMetadata (ResponseInitialMetadata (JsonRpc serv meth)), ParseMetadata (ResponseTrailingMetadata (JsonRpc serv meth))) => SupportsClientRpc (JsonRpc serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

rpcSerializeInput :: Proxy (JsonRpc serv meth) -> Input (JsonRpc serv meth) -> ByteString Source #

rpcDeserializeOutput :: Proxy (JsonRpc serv meth) -> ByteString -> Either String (Output (JsonRpc serv meth)) Source #

(IsRPC (Protobuf serv meth), HasMethodImpl serv meth, BuildMetadata (RequestMetadata (Protobuf serv meth)), ParseMetadata (ResponseInitialMetadata (Protobuf serv meth)), ParseMetadata (ResponseTrailingMetadata (Protobuf serv meth))) => SupportsClientRpc (Protobuf serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Methods

rpcSerializeInput :: Proxy (Protobuf serv meth) -> Input (Protobuf serv meth) -> ByteString Source #

rpcDeserializeOutput :: Proxy (Protobuf serv meth) -> ByteString -> Either String (Output (Protobuf serv meth)) Source #

(IsRPC (RawRpc serv meth), BuildMetadata (RequestMetadata (RawRpc serv meth)), ParseMetadata (ResponseInitialMetadata (RawRpc serv meth)), ParseMetadata (ResponseTrailingMetadata (RawRpc serv meth))) => SupportsClientRpc (RawRpc serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Raw

Methods

rpcSerializeInput :: Proxy (RawRpc serv meth) -> Input (RawRpc serv meth) -> ByteString Source #

rpcDeserializeOutput :: Proxy (RawRpc serv meth) -> ByteString -> Either String (Output (RawRpc serv meth)) Source #

class (IsRPC rpc, ParseMetadata (RequestMetadata rpc), BuildMetadata (ResponseInitialMetadata rpc), StaticMetadata (ResponseTrailingMetadata rpc)) => SupportsServerRpc (rpc :: k) where Source #

Server-side RPC

Methods

rpcDeserializeInput :: Proxy rpc -> ByteString -> Either String (Input rpc) Source #

Deserialize RPC input

This function does not have to deal with compression or length prefixes, and can assume fully consume the given bytestring (if there are unconsumed bytes, this should be considered a parse failure).

rpcSerializeOutput :: Proxy rpc -> Output rpc -> ByteString Source #

Serialize RPC output

Instances

Instances details
(IsRPC (JsonRpc serv meth), FromJSON (Input (JsonRpc serv meth)), ToJSON (Output (JsonRpc serv meth)), ParseMetadata (RequestMetadata (JsonRpc serv meth)), BuildMetadata (ResponseInitialMetadata (JsonRpc serv meth)), StaticMetadata (ResponseTrailingMetadata (JsonRpc serv meth))) => SupportsServerRpc (JsonRpc serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

rpcDeserializeInput :: Proxy (JsonRpc serv meth) -> ByteString -> Either String (Input (JsonRpc serv meth)) Source #

rpcSerializeOutput :: Proxy (JsonRpc serv meth) -> Output (JsonRpc serv meth) -> ByteString Source #

(IsRPC (Protobuf serv meth), HasMethodImpl serv meth, ParseMetadata (RequestMetadata (Protobuf serv meth)), BuildMetadata (ResponseInitialMetadata (Protobuf serv meth)), StaticMetadata (ResponseTrailingMetadata (Protobuf serv meth))) => SupportsServerRpc (Protobuf serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Methods

rpcDeserializeInput :: Proxy (Protobuf serv meth) -> ByteString -> Either String (Input (Protobuf serv meth)) Source #

rpcSerializeOutput :: Proxy (Protobuf serv meth) -> Output (Protobuf serv meth) -> ByteString Source #

(IsRPC (RawRpc serv meth), ParseMetadata (RequestMetadata (RawRpc serv meth)), BuildMetadata (ResponseInitialMetadata (RawRpc serv meth)), StaticMetadata (ResponseTrailingMetadata (RawRpc serv meth))) => SupportsServerRpc (RawRpc serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Raw

Methods

rpcDeserializeInput :: Proxy (RawRpc serv meth) -> ByteString -> Either String (Input (RawRpc serv meth)) Source #

rpcSerializeOutput :: Proxy (RawRpc serv meth) -> Output (RawRpc serv meth) -> ByteString Source #

defaultRpcContentType :: ByteString -> ByteString Source #

Default content type string

This is equal to "application/grpc+format for some format such as proto or json. See also rpcContentType.

Instances

Protobuf

data Protobuf serv (meth :: Symbol) Source #

Protobuf RPC

This exists only as a type-level marker

Instances

Instances details
(HasMethodImpl serv meth, Show (MethodInput serv meth), Show (MethodOutput serv meth), NFData (MethodInput serv meth), NFData (MethodOutput serv meth), Show (RequestMetadata (Protobuf serv meth)), Show (ResponseInitialMetadata (Protobuf serv meth)), Show (ResponseTrailingMetadata (Protobuf serv meth))) => IsRPC (Protobuf serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

(IsRPC (Protobuf serv meth), HasMethodImpl serv meth, BuildMetadata (RequestMetadata (Protobuf serv meth)), ParseMetadata (ResponseInitialMetadata (Protobuf serv meth)), ParseMetadata (ResponseTrailingMetadata (Protobuf serv meth))) => SupportsClientRpc (Protobuf serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Methods

rpcSerializeInput :: Proxy (Protobuf serv meth) -> Input (Protobuf serv meth) -> ByteString Source #

rpcDeserializeOutput :: Proxy (Protobuf serv meth) -> ByteString -> Either String (Output (Protobuf serv meth)) Source #

(IsRPC (Protobuf serv meth), HasMethodImpl serv meth, ParseMetadata (RequestMetadata (Protobuf serv meth)), BuildMetadata (ResponseInitialMetadata (Protobuf serv meth)), StaticMetadata (ResponseTrailingMetadata (Protobuf serv meth))) => SupportsServerRpc (Protobuf serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Methods

rpcDeserializeInput :: Proxy (Protobuf serv meth) -> ByteString -> Either String (Input (Protobuf serv meth)) Source #

rpcSerializeOutput :: Proxy (Protobuf serv meth) -> Output (Protobuf serv meth) -> ByteString Source #

ValidStreamingType (MethodStreamingType serv meth) => HasStreamingType (Protobuf serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Associated Types

type RpcStreamingType (Protobuf serv meth :: Type) 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

type RpcStreamingType (Protobuf serv meth :: Type) = MethodStreamingType serv meth
(styp ~ MethodStreamingType serv meth, ValidStreamingType styp) => SupportsStreamingType (Protobuf serv meth :: Type) styp Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

type Input (Protobuf serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

type Input (Protobuf serv meth :: Type) = Proto (MethodInput serv meth)
type Output (Protobuf serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

type Output (Protobuf serv meth :: Type) = Proto (MethodOutput serv meth)
type RpcStreamingType (Protobuf serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

type RpcStreamingType (Protobuf serv meth :: Type) = MethodStreamingType serv meth

newtype Proto msg Source #

Wrapper around Protobuf messages and Protobuf enums

Protobuf messages and enums behave differently to normal Haskell datatypes. Fields in messages always have defaults, enums can have unknown values, etc. We therefore mark them at the type-level with this Proto wrapper. Most of the time you can work with Proto values as if the wrapper is not there, because Proto msg inherits Message and Data.ProtoLens.Field HasField instances from msg. For example, you can create a 'Proto Point' value as

p = defMessage
      & #latitude  .~ ..
      & #longitude .~ ..

and access fields from such a value using

p ^. #latitude

as per usual.

One advantage of the Proto wrapper is that we can give blanket instances for all Protobuf messages; we use this to provide GHC.Records HasField and GHC.Records.Compat HasField instances. This means that you can also use OverloadedRecordDot to access fields

p.latitude

or even OverloadedRecordUpdate to set fields

p{latitude = ..}

Constructors

Proto msg 

Instances

Instances details
HasField (Proto rec) fldName fldType => HasField (fldName :: Symbol) (Proto rec) fldType Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Methods

getField :: Proto rec -> fldType #

HasField (Proto rec) fldName fldType => HasField (fldName :: Symbol) (Proto rec) fldType Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Methods

hasField :: Proto rec -> (fldType -> Proto rec, fldType) #

NFData msg => NFData (Proto msg) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Methods

rnf :: Proto msg -> () #

Bounded msg => Bounded (Proto msg) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Methods

minBound :: Proto msg #

maxBound :: Proto msg #

Enum msg => Enum (Proto msg) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Methods

succ :: Proto msg -> Proto msg #

pred :: Proto msg -> Proto msg #

toEnum :: Int -> Proto msg #

fromEnum :: Proto msg -> Int #

enumFrom :: Proto msg -> [Proto msg] #

enumFromThen :: Proto msg -> Proto msg -> [Proto msg] #

enumFromTo :: Proto msg -> Proto msg -> [Proto msg] #

enumFromThenTo :: Proto msg -> Proto msg -> Proto msg -> [Proto msg] #

Show msg => Show (Proto msg) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Methods

showsPrec :: Int -> Proto msg -> ShowS #

show :: Proto msg -> String #

showList :: [Proto msg] -> ShowS #

Eq msg => Eq (Proto msg) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Methods

(==) :: Proto msg -> Proto msg -> Bool #

(/=) :: Proto msg -> Proto msg -> Bool #

Ord msg => Ord (Proto msg) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Methods

compare :: Proto msg -> Proto msg -> Ordering #

(<) :: Proto msg -> Proto msg -> Bool #

(<=) :: Proto msg -> Proto msg -> Bool #

(>) :: Proto msg -> Proto msg -> Bool #

(>=) :: Proto msg -> Proto msg -> Bool #

max :: Proto msg -> Proto msg -> Proto msg #

min :: Proto msg -> Proto msg -> Proto msg #

FieldDefault msg => FieldDefault (Proto msg) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Methods

fieldDefault :: Proto msg #

Message msg => Message (Proto msg) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

MessageEnum msg => MessageEnum (Proto msg) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Methods

maybeToEnum :: Int -> Maybe (Proto msg) #

showEnum :: Proto msg -> String #

readEnum :: String -> Maybe (Proto msg) #

(HasField rec fldName x, RewrapField (Describe x) x fldType) => HasField (Proto rec) fldName fldType Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Methods

fieldOf :: Functor f => Proxy# fldName -> (fldType -> f fldType) -> Proto rec -> f (Proto rec) #

getProto :: Proto msg -> msg Source #

Field accessor for Proto

JSON

data JsonRpc (serv :: Symbol) (meth :: Symbol) Source #

gRPC using JSON as the message encoding

"JSON over gRPC" is a bit of an ambiguous phrase. It can be a very general term, simply meaning using an otherwise-unspecified JSON encoding, or it can refer to "Protobuf over JSON" (see https://protobuf.dev/programming-guides/proto3/#json). In this module we deal with the former, and don't deal with anything Protobuf-specific at all, nor do we rely on any of the infrastructure generated by the Protobuf compiler (in other words, there is no need to use protoc). See https://grpc.io/blog/grpc-with-json/ for a Java example of using gRPC with JSON without Protobuf.

In the absence of the infrastructure provided by protoc, you will need to manually provide Input and Output instances for each RPC you use. For example:

type Create   = JsonRpc KeyValueService "Create"
type Delete   = JsonRpc KeyValueService "Delete"
..

type instance Input  Create   = ..
type instance Output Create   = ..
type instance Input  Retrieve = ..
type instance Output Retrieve = ..
..

On the client, you will need ToJSON instances for inputs and FromJSON instances for outputs; on the server the situation is dual. You may find it convenient to use JsonObject (but this is certainly not required).

TODO: https://github.com/well-typed/grapesy/issues/166 We don't currently offer explicit support for "Protobuf JSON".

Instances

Instances details
(KnownSymbol serv, KnownSymbol meth, NFData (Input (JsonRpc serv meth)), NFData (Output (JsonRpc serv meth)), Show (Input (JsonRpc serv meth)), Show (Output (JsonRpc serv meth)), Show (RequestMetadata (JsonRpc serv meth)), Show (ResponseInitialMetadata (JsonRpc serv meth)), Show (ResponseTrailingMetadata (JsonRpc serv meth))) => IsRPC (JsonRpc serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

(IsRPC (JsonRpc serv meth), ToJSON (Input (JsonRpc serv meth)), FromJSON (Output (JsonRpc serv meth)), BuildMetadata (RequestMetadata (JsonRpc serv meth)), ParseMetadata (ResponseInitialMetadata (JsonRpc serv meth)), ParseMetadata (ResponseTrailingMetadata (JsonRpc serv meth))) => SupportsClientRpc (JsonRpc serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

rpcSerializeInput :: Proxy (JsonRpc serv meth) -> Input (JsonRpc serv meth) -> ByteString Source #

rpcDeserializeOutput :: Proxy (JsonRpc serv meth) -> ByteString -> Either String (Output (JsonRpc serv meth)) Source #

(IsRPC (JsonRpc serv meth), FromJSON (Input (JsonRpc serv meth)), ToJSON (Output (JsonRpc serv meth)), ParseMetadata (RequestMetadata (JsonRpc serv meth)), BuildMetadata (ResponseInitialMetadata (JsonRpc serv meth)), StaticMetadata (ResponseTrailingMetadata (JsonRpc serv meth))) => SupportsServerRpc (JsonRpc serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

rpcDeserializeInput :: Proxy (JsonRpc serv meth) -> ByteString -> Either String (Input (JsonRpc serv meth)) Source #

rpcSerializeOutput :: Proxy (JsonRpc serv meth) -> Output (JsonRpc serv meth) -> ByteString Source #

ValidStreamingType styp => SupportsStreamingType (JsonRpc serv meth :: Type) styp Source #

For JSON protocol we do not check communication protocols

Instance details

Defined in Network.GRPC.Spec.RPC.JSON

data JsonObject (a :: [(Symbol, Type)]) where Source #

Convenient way to construct JSON values

Example:

type instance Input Create =
  JsonObject '[ '("key"   , Required Key)
              , '("value" , Required Value)
              ]

Constructors

JsonObject :: JsonObject ('[] :: [(Symbol, Type)]) 
(:*) :: forall (f :: Symbol) x (fs :: [(Symbol, Type)]). x -> JsonObject fs -> JsonObject ('(f, x) ': fs) infixr 5 

Instances

Instances details
DecodeFields fs => FromJSON (JsonObject fs) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

EncodeFields fs => ToJSON (JsonObject fs) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

(NFData x, NFData (JsonObject fs)) => NFData (JsonObject ('(f, x) ': fs)) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

rnf :: JsonObject ('(f, x) ': fs) -> () #

NFData (JsonObject ('[] :: [(Symbol, Type)])) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

rnf :: JsonObject ('[] :: [(Symbol, Type)]) -> () #

(Show x, Show (JsonObject fs)) => Show (JsonObject ('(f, x) ': fs)) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

showsPrec :: Int -> JsonObject ('(f, x) ': fs) -> ShowS #

show :: JsonObject ('(f, x) ': fs) -> String #

showList :: [JsonObject ('(f, x) ': fs)] -> ShowS #

Show (JsonObject ('[] :: [(Symbol, Type)])) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

showsPrec :: Int -> JsonObject ('[] :: [(Symbol, Type)]) -> ShowS #

show :: JsonObject ('[] :: [(Symbol, Type)]) -> String #

showList :: [JsonObject ('[] :: [(Symbol, Type)])] -> ShowS #

newtype Required a Source #

Required field

Constructors

Required 

Fields

Instances

Instances details
NFData a => NFData (Required a) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

rnf :: Required a -> () #

Show a => Show (Required a) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

showsPrec :: Int -> Required a -> ShowS #

show :: Required a -> String #

showList :: [Required a] -> ShowS #

(KnownSymbol f, FromJSON x, DecodeFields fs) => DecodeFields ('(f, Required x) ': fs) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

decodeFields :: Object -> Parser (JsonObject ('(f, Required x) ': fs))

(KnownSymbol f, ToJSON x, EncodeFields fs) => EncodeFields ('(f, Required x) ': fs) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

encodeFields :: JsonObject ('(f, Required x) ': fs) -> [Pair]

newtype Optional a Source #

Optional field

Maybe will be represented by the absence of the field in the object.

Constructors

Optional 

Fields

Instances

Instances details
NFData a => NFData (Optional a) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

rnf :: Optional a -> () #

Show a => Show (Optional a) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

showsPrec :: Int -> Optional a -> ShowS #

show :: Optional a -> String #

showList :: [Optional a] -> ShowS #

(KnownSymbol f, FromJSON x, DecodeFields fs) => DecodeFields ('(f, Optional x) ': fs) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

decodeFields :: Object -> Parser (JsonObject ('(f, Optional x) ': fs))

(KnownSymbol f, ToJSON x, EncodeFields fs) => EncodeFields ('(f, Optional x) ': fs) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

encodeFields :: JsonObject ('(f, Optional x) ': fs) -> [Pair]

class DecodeFields (fs :: [(Symbol, Type)]) Source #

Auxiliary class used for the FromJSON instance for JsonObject

It is not possible (nor necessary) to define additional instances.

Instances

Instances details
DecodeFields ('[] :: [(Symbol, Type)]) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

decodeFields :: Object -> Parser (JsonObject ('[] :: [(Symbol, Type)]))

(KnownSymbol f, FromJSON x, DecodeFields fs) => DecodeFields ('(f, Optional x) ': fs) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

decodeFields :: Object -> Parser (JsonObject ('(f, Optional x) ': fs))

(KnownSymbol f, FromJSON x, DecodeFields fs) => DecodeFields ('(f, Required x) ': fs) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

decodeFields :: Object -> Parser (JsonObject ('(f, Required x) ': fs))

class EncodeFields (fs :: [(Symbol, Type)]) Source #

Auxiliary class used for the ToJSON instance for JsonObject

It is not possible (nor necessary) to define additional instances.

Instances

Instances details
EncodeFields ('[] :: [(Symbol, Type)]) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

encodeFields :: JsonObject ('[] :: [(Symbol, Type)]) -> [Pair]

(KnownSymbol f, ToJSON x, EncodeFields fs) => EncodeFields ('(f, Optional x) ': fs) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

encodeFields :: JsonObject ('(f, Optional x) ': fs) -> [Pair]

(KnownSymbol f, ToJSON x, EncodeFields fs) => EncodeFields ('(f, Required x) ': fs) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.JSON

Methods

encodeFields :: JsonObject ('(f, Required x) ': fs) -> [Pair]

Raw

data RawRpc (serv :: Symbol) (meth :: Symbol) Source #

Custom gRPC format

Usually gRPC runs over Protobuf, but it does not have to. RawRpc provides an alternative format, which does not use serialization/deserialization at all, just using raw bytestrings for messages. This is a non-standard format (which the gRPC specification explicitly permits).

Instances

Instances details
(KnownSymbol serv, KnownSymbol meth, Show (RequestMetadata (RawRpc serv meth)), Show (ResponseInitialMetadata (RawRpc serv meth)), Show (ResponseTrailingMetadata (RawRpc serv meth))) => IsRPC (RawRpc serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Raw

(IsRPC (RawRpc serv meth), BuildMetadata (RequestMetadata (RawRpc serv meth)), ParseMetadata (ResponseInitialMetadata (RawRpc serv meth)), ParseMetadata (ResponseTrailingMetadata (RawRpc serv meth))) => SupportsClientRpc (RawRpc serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Raw

Methods

rpcSerializeInput :: Proxy (RawRpc serv meth) -> Input (RawRpc serv meth) -> ByteString Source #

rpcDeserializeOutput :: Proxy (RawRpc serv meth) -> ByteString -> Either String (Output (RawRpc serv meth)) Source #

(IsRPC (RawRpc serv meth), ParseMetadata (RequestMetadata (RawRpc serv meth)), BuildMetadata (ResponseInitialMetadata (RawRpc serv meth)), StaticMetadata (ResponseTrailingMetadata (RawRpc serv meth))) => SupportsServerRpc (RawRpc serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Raw

Methods

rpcDeserializeInput :: Proxy (RawRpc serv meth) -> ByteString -> Either String (Input (RawRpc serv meth)) Source #

rpcSerializeOutput :: Proxy (RawRpc serv meth) -> Output (RawRpc serv meth) -> ByteString Source #

ValidStreamingType styp => SupportsStreamingType (RawRpc serv meth :: Type) styp Source #

For the raw protocol we do not check communication protocols

Instance details

Defined in Network.GRPC.Spec.RPC.Raw

type Input (RawRpc serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Raw

type Input (RawRpc serv meth :: Type) = ByteString
type Output (RawRpc serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Raw

type Output (RawRpc serv meth :: Type) = ByteString

Streaming types

data StreamingType #

Data type to be used as a promoted type for MethodStreamingType.

Instances

Instances details
Bounded StreamingType 
Instance details

Defined in Data.ProtoLens.Service.Types

Enum StreamingType 
Instance details

Defined in Data.ProtoLens.Service.Types

Read StreamingType 
Instance details

Defined in Data.ProtoLens.Service.Types

Show StreamingType 
Instance details

Defined in Data.ProtoLens.Service.Types

Eq StreamingType 
Instance details

Defined in Data.ProtoLens.Service.Types

Ord StreamingType 
Instance details

Defined in Data.ProtoLens.Service.Types

Link RPCs to streaming types

class ValidStreamingType styp => SupportsStreamingType (rpc :: k) (styp :: StreamingType) Source #

This RPC supports the given streaming type

This is a weaker condition than HasStreamingType: some (non-Protobuf) RPCs may support more than one streaming type.

Instances

Instances details
ValidStreamingType styp => SupportsStreamingType (JsonRpc serv meth :: Type) styp Source #

For JSON protocol we do not check communication protocols

Instance details

Defined in Network.GRPC.Spec.RPC.JSON

(styp ~ MethodStreamingType serv meth, ValidStreamingType styp) => SupportsStreamingType (Protobuf serv meth :: Type) styp Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

ValidStreamingType styp => SupportsStreamingType (RawRpc serv meth :: Type) styp Source #

For the raw protocol we do not check communication protocols

Instance details

Defined in Network.GRPC.Spec.RPC.Raw

class SupportsStreamingType rpc (RpcStreamingType rpc) => HasStreamingType (rpc :: k) Source #

The streaming type supported by this RPC

Associated Types

type RpcStreamingType (rpc :: k) :: StreamingType Source #

The (single) streaming type supported by this RPC

Instances

Instances details
ValidStreamingType (MethodStreamingType serv meth) => HasStreamingType (Protobuf serv meth :: Type) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

Associated Types

type RpcStreamingType (Protobuf serv meth :: Type) 
Instance details

Defined in Network.GRPC.Spec.RPC.Protobuf

type RpcStreamingType (Protobuf serv meth :: Type) = MethodStreamingType serv meth

Handler type definition

data NextElem a Source #

Is there a next element in a stream?

Constructors

NoNextElem 
NextElem !a 

Instances

Instances details
Functor NextElem Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.StreamType

Methods

fmap :: (a -> b) -> NextElem a -> NextElem b #

(<$) :: a -> NextElem b -> NextElem a #

Foldable NextElem Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.StreamType

Methods

fold :: Monoid m => NextElem m -> m #

foldMap :: Monoid m => (a -> m) -> NextElem a -> m #

foldMap' :: Monoid m => (a -> m) -> NextElem a -> m #

foldr :: (a -> b -> b) -> b -> NextElem a -> b #

foldr' :: (a -> b -> b) -> b -> NextElem a -> b #

foldl :: (b -> a -> b) -> b -> NextElem a -> b #

foldl' :: (b -> a -> b) -> b -> NextElem a -> b #

foldr1 :: (a -> a -> a) -> NextElem a -> a #

foldl1 :: (a -> a -> a) -> NextElem a -> a #

toList :: NextElem a -> [a] #

null :: NextElem a -> Bool #

length :: NextElem a -> Int #

elem :: Eq a => a -> NextElem a -> Bool #

maximum :: Ord a => NextElem a -> a #

minimum :: Ord a => NextElem a -> a #

sum :: Num a => NextElem a -> a #

product :: Num a => NextElem a -> a #

Traversable NextElem Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.StreamType

Methods

traverse :: Applicative f => (a -> f b) -> NextElem a -> f (NextElem b) #

sequenceA :: Applicative f => NextElem (f a) -> f (NextElem a) #

mapM :: Monad m => (a -> m b) -> NextElem a -> m (NextElem b) #

sequence :: Monad m => NextElem (m a) -> m (NextElem a) #

Show a => Show (NextElem a) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.StreamType

Methods

showsPrec :: Int -> NextElem a -> ShowS #

show :: NextElem a -> String #

showList :: [NextElem a] -> ShowS #

Eq a => Eq (NextElem a) Source # 
Instance details

Defined in Network.GRPC.Spec.RPC.StreamType

Methods

(==) :: NextElem a -> NextElem a -> Bool #

(/=) :: NextElem a -> NextElem a -> Bool #

type Send a = NextElem a -> IO () Source #

Send a value

type Recv a = IO (NextElem a) Source #

Receive a value

Nothing indicates no more values. Calling this function again after receiving Nothing is a bug.

type Positive (m :: k -> Type) a (b :: k) = a -> m b Source #

Positive use of a

newtype Negative (m :: Type -> Type) a b Source #

Negative use of a

Constructors

Negative 

Fields

data HandlerRole Source #

Handler role

Constructors

Server

Deal with an incoming request

Client

Initiate an outgoing request

type family Handler (r :: HandlerRole) (s :: StreamingType) (m :: Type -> Type) (rpc :: k) where ... Source #

Type of a handler

Equations

Handler 'Server 'NonStreaming m (rpc :: k) = Input rpc -> m (Output rpc) 
Handler 'Client 'NonStreaming m (rpc :: k) = Input rpc -> m (Output rpc) 
Handler 'Server 'ClientStreaming m (rpc :: k) = Positive m (Recv (Input rpc)) (Output rpc) 
Handler 'Client 'ClientStreaming m (rpc :: k) = Negative m (Send (Input rpc)) (Output rpc) 
Handler 'Server 'ServerStreaming m (rpc :: k) = Input rpc -> Positive m (Send (Output rpc)) () 
Handler 'Client 'ServerStreaming m (rpc :: k) = Input rpc -> Negative m (Recv (Output rpc)) () 
Handler 'Server 'BiDiStreaming m (rpc :: k) = Positive m (Recv (Input rpc), Send (Output rpc)) () 
Handler 'Client 'BiDiStreaming m (rpc :: k) = Negative m (Send (Input rpc), Recv (Output rpc)) () 

Handler newtype wrappers

data ServerHandler' (styp :: StreamingType) (m :: Type -> Type) (rpc :: k) where Source #

Wrapper around Handler Server to avoid ambiguous types

Constructors

ServerHandler :: forall {k} (rpc :: k) (styp :: StreamingType) (m :: Type -> Type). SupportsStreamingType rpc styp => Handler 'Server styp m rpc -> ServerHandler' styp m rpc 

type ServerHandler (m :: Type -> Type) (rpc :: k) = ServerHandler' (RpcStreamingType rpc) m rpc Source #

Alias for ServerHandler' with the streaming type determined by the rpc

data ClientHandler' (s :: StreamingType) (m :: Type -> Type) (rpc :: k) where Source #

Wrapper around Handler Client to avoid ambiguous types

Constructors

ClientHandler :: forall {k} (rpc :: k) (s :: StreamingType) (m :: Type -> Type). SupportsStreamingType rpc s => Handler 'Client s m rpc -> ClientHandler' s m rpc 

type ClientHandler (m :: Type -> Type) (rpc :: k) = ClientHandler' (RpcStreamingType rpc) m rpc Source #

Alias for ClientHandler' with the streaming type determined by the rpc

hoistServerHandler :: forall {k} (styp :: StreamingType) m n (rpc :: k). ValidStreamingType styp => (forall a. m a -> n a) -> ServerHandler' styp m rpc -> ServerHandler' styp n rpc Source #

Hoist server handler from one monad to another

Compression

data CompressionId Source #

Compression ID

The gRPC specification defines

Content-Coding → "identity" / "gzip" / "deflate" / "snappy" / {custom}

Instances

Instances details
IsString CompressionId Source # 
Instance details

Defined in Network.GRPC.Spec.Compression

Generic CompressionId Source # 
Instance details

Defined in Network.GRPC.Spec.Compression

Associated Types

type Rep CompressionId 
Instance details

Defined in Network.GRPC.Spec.Compression

type Rep CompressionId = D1 ('MetaData "CompressionId" "Network.GRPC.Spec.Compression" "grpc-spec-1.0.0-inplace" 'False) ((C1 ('MetaCons "Identity" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GZip" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Deflate" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Snappy" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Custom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String)))))
Show CompressionId Source # 
Instance details

Defined in Network.GRPC.Spec.Compression

Eq CompressionId Source # 
Instance details

Defined in Network.GRPC.Spec.Compression

Ord CompressionId Source # 
Instance details

Defined in Network.GRPC.Spec.Compression

type Rep CompressionId Source # 
Instance details

Defined in Network.GRPC.Spec.Compression

type Rep CompressionId = D1 ('MetaData "CompressionId" "Network.GRPC.Spec.Compression" "grpc-spec-1.0.0-inplace" 'False) ((C1 ('MetaCons "Identity" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GZip" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Deflate" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "Snappy" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Custom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String)))))

data Compression Source #

Compression scheme

Constructors

Compression 

Fields

Instances

Instances details
Show Compression Source # 
Instance details

Defined in Network.GRPC.Spec.Compression

noCompression :: Compression Source #

Disable compression (referred to as identity in the gRPC spec)

allSupportedCompression :: NonEmpty Compression Source #

All supported compression algorithms supported

The order of this list is important: algorithms listed earlier are preferred over algorithms listed later.

Message metadata

data OutboundMeta Source #

Meta-information for outbound messages

Constructors

OutboundMeta 

Fields

  • outboundEnableCompression :: Bool

    Enable compression for this message

    Even if enabled, compression will only be used if this results in a smaller message.

Instances

Instances details
Default OutboundMeta Source # 
Instance details

Defined in Network.GRPC.Spec.MessageMeta

Methods

def :: OutboundMeta #

NFData OutboundMeta Source # 
Instance details

Defined in Network.GRPC.Spec.MessageMeta

Methods

rnf :: OutboundMeta -> () #

Generic OutboundMeta Source # 
Instance details

Defined in Network.GRPC.Spec.MessageMeta

Associated Types

type Rep OutboundMeta 
Instance details

Defined in Network.GRPC.Spec.MessageMeta

type Rep OutboundMeta = D1 ('MetaData "OutboundMeta" "Network.GRPC.Spec.MessageMeta" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "OutboundMeta" 'PrefixI 'True) (S1 ('MetaSel ('Just "outboundEnableCompression") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool)))
Show OutboundMeta Source # 
Instance details

Defined in Network.GRPC.Spec.MessageMeta

type Rep OutboundMeta Source # 
Instance details

Defined in Network.GRPC.Spec.MessageMeta

type Rep OutboundMeta = D1 ('MetaData "OutboundMeta" "Network.GRPC.Spec.MessageMeta" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "OutboundMeta" 'PrefixI 'True) (S1 ('MetaSel ('Just "outboundEnableCompression") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool)))

data InboundMeta Source #

Meta-information about inbound messages

Constructors

InboundMeta 

Fields

Instances

Instances details
Show InboundMeta Source # 
Instance details

Defined in Network.GRPC.Spec.MessageMeta

Requests

data RequestHeaders_ (f :: Type -> Type) Source #

Full set of call parameters required to construct the RPC call

This is constructed internally; it is not part of the public API.

Constructors

RequestHeaders 

Fields

Instances

Instances details
Generic RequestHeaders Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Request

Associated Types

type Rep (RequestHeaders_ Undecorated) 
Instance details

Defined in Network.GRPC.Spec.Headers.Request

type Rep (RequestHeaders_ Undecorated) = D1 ('MetaData "RequestHeaders_" "Network.GRPC.Spec.Headers.Request" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "RequestHeaders" 'PrefixI 'True) (((S1 ('MetaSel ('Just "requestTimeout") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe Timeout))) :*: S1 ('MetaSel ('Just "requestCompression") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe CompressionId)))) :*: (S1 ('MetaSel ('Just "requestAcceptCompression") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe (NonEmpty CompressionId)))) :*: (S1 ('MetaSel ('Just "requestContentType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe ContentType))) :*: S1 ('MetaSel ('Just "requestMessageType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe MessageType)))))) :*: ((S1 ('MetaSel ('Just "requestUserAgent") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe ByteString))) :*: (S1 ('MetaSel ('Just "requestIncludeTE") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated Bool)) :*: S1 ('MetaSel ('Just "requestTraceContext") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe TraceContext))))) :*: (S1 ('MetaSel ('Just "requestPreviousRpcAttempts") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe Int))) :*: (S1 ('MetaSel ('Just "requestMetadata") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 CustomMetadataMap) :*: S1 ('MetaSel ('Just "requestUnrecognized") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated ())))))))
Show RequestHeaders Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Request

Eq RequestHeaders Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Request

Coerce RequestHeaders_ Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Request

Traversable RequestHeaders_ Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Request

Methods

traverse :: Applicative m => (forall a. f a -> m (g a)) -> RequestHeaders_ (DecoratedWith f) -> m (RequestHeaders_ (DecoratedWith g)) Source #

Show e => Show (RequestHeaders' e) Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Request

Eq e => Eq (RequestHeaders' e) Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Request

type Rep (RequestHeaders_ Undecorated) Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Request

type Rep (RequestHeaders_ Undecorated) = D1 ('MetaData "RequestHeaders_" "Network.GRPC.Spec.Headers.Request" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "RequestHeaders" 'PrefixI 'True) (((S1 ('MetaSel ('Just "requestTimeout") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe Timeout))) :*: S1 ('MetaSel ('Just "requestCompression") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe CompressionId)))) :*: (S1 ('MetaSel ('Just "requestAcceptCompression") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe (NonEmpty CompressionId)))) :*: (S1 ('MetaSel ('Just "requestContentType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe ContentType))) :*: S1 ('MetaSel ('Just "requestMessageType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe MessageType)))))) :*: ((S1 ('MetaSel ('Just "requestUserAgent") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe ByteString))) :*: (S1 ('MetaSel ('Just "requestIncludeTE") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated Bool)) :*: S1 ('MetaSel ('Just "requestTraceContext") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe TraceContext))))) :*: (S1 ('MetaSel ('Just "requestPreviousRpcAttempts") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated (Maybe Int))) :*: (S1 ('MetaSel ('Just "requestMetadata") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 CustomMetadataMap) :*: S1 ('MetaSel ('Just "requestUnrecognized") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (HKD Undecorated ())))))))

type RequestHeaders = RequestHeaders_ Undecorated Source #

Request headers (without allowing for invalid headers)

NOTE: The HKD type

RequestHeaders_ Undecorated

means that each field of type HKD f a is simply of type a (that is, undecorated).

type RequestHeaders' e = RequestHeaders_ (Checked (InvalidHeaders e)) Source #

Request headers allowing for invalid headers

NOTE: The HKD type

RequestHeaders_ (Checked InvalidHeaders)

means that each field of type HKD f a is of type

Either InvalidHeaders a

(i.e., either valid or invalid).

See InvalidHeaderSynthesize for an explanation of the e parameter.

Parameters

data CallParams (rpc :: k) Source #

RPC parameters that can be chosen on a per-call basis

Instances

Instances details
Default (RequestMetadata rpc) => Default (CallParams rpc) Source #

Default CallParams

Instance details

Defined in Network.GRPC.Spec.Call

Methods

def :: CallParams rpc #

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

Defined in Network.GRPC.Spec.Call

Methods

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

show :: CallParams rpc -> String #

showList :: [CallParams rpc] -> ShowS #

Pseudo-headers

data PseudoHeaders Source #

All pseudo-headers

Instances

Instances details
Show PseudoHeaders Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.PseudoHeaders

data ServerHeaders Source #

Partial pseudo headers: identify the server, but not a specific resource

Instances

Instances details
Show ServerHeaders Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.PseudoHeaders

data Path Source #

Path

The gRPC spec specifies:

Path → ":path" "/" Service-Name "/" {method name} # But see note below.

Moreover, it says:

Path is case-sensitive. Some gRPC implementations may allow the Path format
shown above to be overridden, but this functionality is strongly
discouraged. gRPC does not go out of its way to break users that are using
this kind of override, but we do not actively support it, and some
functionality (e.g., service config support) will not work when the path is
not of the form shown above.

We don't support these non-standard paths at all.

Constructors

Path 

Instances

Instances details
Show Path Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.PseudoHeaders

Methods

showsPrec :: Int -> Path -> ShowS #

show :: Path -> String #

showList :: [Path] -> ShowS #

Eq Path Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.PseudoHeaders

Methods

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

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

Hashable Path Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.PseudoHeaders

Methods

hashWithSalt :: Int -> Path -> Int #

hash :: Path -> Int #

data Address Source #

Address

The address of a server to connect to. This is not standard gRPC nomenclature, but follows convention such as adopted by grpcurl and grpc-client-cli, which distinguish between the address of a server to connect to (hostname and port), and the (optional) HTTP authority, which is an (optional) string to be included as the HTTP2 :authority pseudo-header.

Constructors

Address 

Fields

  • addressHost :: HostName

    Hostname

  • addressPort :: PortNumber

    TCP port

  • addressAuthority :: Maybe String

    Authority

    When the authority is not specified, it defaults to addressHost.

    This is used both for the HTTP2 :authority pseudo-header as well as for TLS SNI (if using a secure connection).

    Although the HTTP(2) specification allows the authority to include a port number, and many servers can accept this, this will not work with TLS, and it is therefore recommended not to include a port number. Note that the HTTP2 spec explicitly disallows the authority to include userinfo@.

Instances

Instances details
Show Address Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.PseudoHeaders

data Scheme Source #

Constructors

Http 
Https 

Instances

Instances details
Show Scheme Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.PseudoHeaders

data Method Source #

Method

The only method supported by gRPC is POST.

See also https://datatracker.ietf.org/doc/html/rfc7231#section-4.

Constructors

Post 

Instances

Instances details
Show Method Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.PseudoHeaders

rpcPath :: forall {k} (rpc :: k). IsRPC rpc => Proxy rpc -> Path Source #

Construct path

Timeouts

data Timeout Source #

Timeout

Instances

Instances details
Generic Timeout Source # 
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 Source # 
Instance details

Defined in Network.GRPC.Spec.Timeout

Eq Timeout Source # 
Instance details

Defined in Network.GRPC.Spec.Timeout

Methods

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

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

type Rep Timeout Source # 
Instance details

Defined in Network.GRPC.Spec.Timeout

data TimeoutValue where Source #

Positive integer with ASCII representation of at most 8 digits

Bundled Patterns

pattern TimeoutValue :: Word -> TimeoutValue 

Instances

Instances details
Generic TimeoutValue Source # 
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 Source #

Show instance relies on the TimeoutValue pattern synonym

Instance details

Defined in Network.GRPC.Spec.Timeout

Eq TimeoutValue Source # 
Instance details

Defined in Network.GRPC.Spec.Timeout

type Rep TimeoutValue Source # 
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 Source #

Timeout unit

Constructors

Hour

Hours

Minute

Minutes

Second

Seconds

Millisecond

Milliseconds

Microsecond

Microseconds

Nanosecond

Nanoseconds

Although some servers may be able to interpret this in a meaningful way, we cannot, and round this up to the nearest microsecond.

Instances

Instances details
Generic TimeoutUnit Source # 
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 Source # 
Instance details

Defined in Network.GRPC.Spec.Timeout

Eq TimeoutUnit Source # 
Instance details

Defined in Network.GRPC.Spec.Timeout

type Rep TimeoutUnit Source # 
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))))

timeoutToMicro :: Timeout -> Integer Source #

Translate Timeout to microseconds

For Nanosecond timeout we round up.

Note: the choice of Integer for the result is important: timeouts can be quite long, and might easily exceed the range of a 32-bit int: 2^31 microseconds is roughly 35 minutes (on 64-bit architectures this is much less important; 2^63 microseconds is 292,277.2 years). We could use Int64 or Word64, but Integer works nicely with the unbounded-delays package.

isValidTimeoutValue :: Word -> Bool Source #

Valid timeout values

Timeout values cannot exceed 8 digits. If you need a longer timeout, consider using a different TimeoutUnit instead.

Responses

Headers

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

Response headers

Constructors

ResponseHeaders 

Fields

Instances

Instances details
Generic ResponseHeaders Source # 
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 Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Eq ResponseHeaders Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Coerce ResponseHeaders_ Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Traversable ResponseHeaders_ Source # 
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)) Source #

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

Defined in Network.GRPC.Spec.Headers.Response

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

Defined in Network.GRPC.Spec.Headers.Response

type Rep (ResponseHeaders_ Undecorated) Source # 
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 ()))))))

type ResponseHeaders = ResponseHeaders_ Undecorated Source #

Response headers (without allowing for invalid headers)

See RequestHeaders for an explanation of Undecorated.

type ResponseHeaders' e = ResponseHeaders_ (Checked (InvalidHeaders e)) Source #

Response headers allowing for invalid headers

See RequestHeaders' for an explanation of Checked and the purpose of e.

Trailers

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

Information sent by the peer after the final output

Response trailers are a HTTP2 concept: they are HTTP headers that are sent after the content body. For example, imagine the server is streaming a file that it's reading from disk; it could use trailers to give the client an MD5 checksum when streaming is complete.

Constructors

ProperTrailers 

Fields

Instances

Instances details
Generic ProperTrailers Source # 
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 Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Eq ProperTrailers Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Coerce ProperTrailers_ Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Traversable ProperTrailers_ Source # 
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)) Source #

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

Defined in Network.GRPC.Spec.Headers.Response

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

Defined in Network.GRPC.Spec.Headers.Response

type Rep (ProperTrailers_ Undecorated) Source # 
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 Source #

Trailers sent after the response (without allowing for invalid trailers)

type ProperTrailers' = ProperTrailers_ (Checked (InvalidHeaders GrpcException)) Source #

Trailers sent after the response, allowing for invalid trailers

We do not parameterize this over the type of synthesized errors: unlike response (or request) headers, we have no opportunity to check the trailers for synthesized errors ahead of time, so having a type to signal "trailers without synthesized errors" is not particularly useful.

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

Trailers sent in the gRPC Trailers-Only case

We deal with the HTTP status elsewhere.

Constructors

TrailersOnly 

Fields

Instances

Instances details
Generic TrailersOnly Source # 
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 Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Eq TrailersOnly Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Coerce TrailersOnly_ Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Traversable TrailersOnly_ Source # 
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)) Source #

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

Defined in Network.GRPC.Spec.Headers.Response

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

Defined in Network.GRPC.Spec.Headers.Response

type Rep (TrailersOnly_ Undecorated) Source # 
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 Source #

Trailers for the Trailers-Only case (without allowing for invalid trailers)

type TrailersOnly' e = TrailersOnly_ (Checked (InvalidHeaders e)) Source #

Trailers for the Trailers-Only case, allowing for invalid headers

data Pushback Source #

Pushback

The server adds this header to push back against client retries. We do not yet support automatic retries (https://github.com/well-typed/grapesy/issues/104), but do we parse this header so that if the server includes it, we do not throw a parser error.

See also https://github.com/grpc/proposal/blob/master/A6-client-retries.md

Constructors

RetryAfter Word 
DoNotRetry 

Instances

Instances details
Generic Pushback Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Associated Types

type Rep Pushback 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

type Rep Pushback = D1 ('MetaData "Pushback" "Network.GRPC.Spec.Headers.Response" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "RetryAfter" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word)) :+: C1 ('MetaCons "DoNotRetry" 'PrefixI 'False) (U1 :: Type -> Type))

Methods

from :: Pushback -> Rep Pushback x #

to :: Rep Pushback x -> Pushback #

Show Pushback Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

Eq Pushback Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

type Rep Pushback Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Response

type Rep Pushback = D1 ('MetaData "Pushback" "Network.GRPC.Spec.Headers.Response" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "RetryAfter" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word)) :+: C1 ('MetaCons "DoNotRetry" 'PrefixI 'False) (U1 :: Type -> Type))

Termination

grpcExceptionToTrailers :: GrpcException -> ProperTrailers Source #

Translate gRPC exception to response trailers

grpcClassifyTermination :: ProperTrailers' -> Either GrpcException GrpcNormalTermination Source #

Check if trailers correspond to an exceptional response

The gRPC spec states that

Trailers-Only is permitted for calls that produce an immediate error

However, in practice gRPC servers can also respond with Trailers-Only in non-error cases, simply indicating that the server considers the conversation over. To distinguish, we look at properTrailersGrpcStatus.

Status

data GrpcStatus Source #

Constructors

GrpcOk 
GrpcError GrpcError 

Instances

Instances details
Generic GrpcStatus Source # 
Instance details

Defined in Network.GRPC.Spec.Status

Associated Types

type Rep GrpcStatus 
Instance details

Defined in Network.GRPC.Spec.Status

type Rep GrpcStatus = D1 ('MetaData "GrpcStatus" "Network.GRPC.Spec.Status" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "GrpcOk" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 GrpcError)))
Show GrpcStatus Source # 
Instance details

Defined in Network.GRPC.Spec.Status

Eq GrpcStatus Source # 
Instance details

Defined in Network.GRPC.Spec.Status

type Rep GrpcStatus Source # 
Instance details

Defined in Network.GRPC.Spec.Status

type Rep GrpcStatus = D1 ('MetaData "GrpcStatus" "Network.GRPC.Spec.Status" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "GrpcOk" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 GrpcError)))

data GrpcError Source #

gRPC error code

This is a subset of the gRPC status codes. See GrpcStatus.

Constructors

GrpcCancelled

Cancelled

The operation was cancelled, typically by the caller.

GrpcUnknown

Unknown error

For example, this error may be returned when a Status value received from another address space belongs to an error space that is not known in this address space. Also errors raised by APIs that do not return enough error information may be converted to this error.

GrpcInvalidArgument

Invalid argument

The client specified an invalid argument. Note that this differs from GrpcFailedPrecondition: GrpcInvalidArgument indicates arguments that are problematic regardless of the state of the system (e.g., a malformed file name).

GrpcDeadlineExceeded

Deadline exceeded

The deadline expired before the operation could complete. For operations that change the state of the system, this error may be returned even if the operation has completed successfully. For example, a successful response from a server could have been delayed long.

GrpcNotFound

Not found

Some requested entity (e.g., file or directory) was not found.

Note to server developers: if a request is denied for an entire class of users, such as gradual feature rollout or undocumented allowlist, GrpcNotFound may be used.

If a request is denied for some users within a class of users, such as user-based access control, GrpcPermissionDenied must be used.

GrpcAlreadyExists

Already exists

The entity that a client attempted to create (e.g., file or directory) already exists.

GrpcPermissionDenied

Permission denied

The caller does not have permission to execute the specified operation.

This error code does not imply the request is valid or the requested entity exists or satisfies other pre-conditions.

GrpcResourceExhausted

Resource exhausted

Some resource has been exhausted, perhaps a per-user quota, or perhaps the entire file system is out of space.

GrpcFailedPrecondition

Failed precondition

The operation was rejected because the system is not in a state required for the operation's execution. For example, the directory to be deleted is non-empty, an rmdir operation is applied to a non-directory, etc.

Service implementors can use the following guidelines to decide between GrpcFailedPrecondition, GrpcAborted, and GrpcUnavailable:

(a) Use GrpcUnavailable if the client can retry just the failing call. (b) Use GrpcAborted if the client should retry at a higher level (e.g., when a client-specified test-and-set fails, indicating the client should restart a read-modify-write sequence). (c) Use GrpcFailedPrecondition if the client should not retry until the system state has been explicitly fixed. E.g., if an rmdir fails because the directory is non-empty, GrpcFailedPrecondition should be returned since the client should not retry unless the files are deleted from the directory.

GrpcAborted

Aborted

The operation was aborted, typically due to a concurrency issue such as a sequencer check failure or transaction abort. See the guidelines above for deciding between GrpcFailedPrecondition, GrpcAborted, and GrpcUnavailable.

GrpcOutOfRange

Out of range

The operation was attempted past the valid range. E.g., seeking or reading past end-of-file.

Unlike GrpcInvalidArgument, this error indicates a problem that may be fixed if the system state changes. For example, a 32-bit file system will generate GrpcInvalidArgument if asked to read at an offset that is not in the range [0, 2^32-1], but it will generate GrpcOutOfRange if asked to read from an offset past the current file size.

There is a fair bit of overlap between GrpcFailedPrecondition and GrpcOutOfRange. We recommend using GrpcOutOfRange (the more specific error) when it applies so that callers who are iterating through a space can easily look for an GrpcOutOfRange error to detect when they are done.

GrpcUnimplemented

Unimplemented

The operation is not implemented or is not supported/enabled in this service.

GrpcInternal

Internal errors

This means that some invariants expected by the underlying system have been broken. This error code is reserved for serious errors.

GrpcUnavailable

Unavailable

The service is currently unavailable. This is most likely a transient condition, which can be corrected by retrying with a backoff. Note that it is not always safe to retry non-idempotent operations.

GrpcDataLoss

Data loss

Unrecoverable data loss or corruption.

GrpcUnauthenticated

Unauthenticated

The request does not have valid authentication credentials for the operation.

Instances

Instances details
Exception GrpcError Source # 
Instance details

Defined in Network.GRPC.Spec.Status

Generic GrpcError Source # 
Instance details

Defined in Network.GRPC.Spec.Status

Associated Types

type Rep GrpcError 
Instance details

Defined in Network.GRPC.Spec.Status

type Rep GrpcError = D1 ('MetaData "GrpcError" "Network.GRPC.Spec.Status" "grpc-spec-1.0.0-inplace" 'False) ((((C1 ('MetaCons "GrpcCancelled" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcUnknown" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "GrpcInvalidArgument" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcDeadlineExceeded" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "GrpcNotFound" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcAlreadyExists" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "GrpcPermissionDenied" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcResourceExhausted" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "GrpcFailedPrecondition" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcAborted" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "GrpcOutOfRange" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcUnimplemented" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "GrpcInternal" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcUnavailable" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "GrpcDataLoss" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcUnauthenticated" 'PrefixI 'False) (U1 :: Type -> Type)))))
Show GrpcError Source # 
Instance details

Defined in Network.GRPC.Spec.Status

Eq GrpcError Source # 
Instance details

Defined in Network.GRPC.Spec.Status

Ord GrpcError Source # 
Instance details

Defined in Network.GRPC.Spec.Status

type Rep GrpcError Source # 
Instance details

Defined in Network.GRPC.Spec.Status

type Rep GrpcError = D1 ('MetaData "GrpcError" "Network.GRPC.Spec.Status" "grpc-spec-1.0.0-inplace" 'False) ((((C1 ('MetaCons "GrpcCancelled" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcUnknown" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "GrpcInvalidArgument" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcDeadlineExceeded" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "GrpcNotFound" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcAlreadyExists" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "GrpcPermissionDenied" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcResourceExhausted" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: (((C1 ('MetaCons "GrpcFailedPrecondition" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcAborted" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "GrpcOutOfRange" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcUnimplemented" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "GrpcInternal" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcUnavailable" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "GrpcDataLoss" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "GrpcUnauthenticated" 'PrefixI 'False) (U1 :: Type -> Type)))))

Numerical status codes

fromGrpcError :: GrpcError -> Word Source #

Translate GrpcError to numerical status code

See also fromGrpcStatus

Exceptions

throwGrpcError :: GrpcError -> IO a Source #

Convenience function to throw an GrpcException with the specified error

Details

data Status Source #

Fields :

  • code :: Lens' Status Data.Int.Int32
  • message :: Lens' Status Data.Text.Text
  • details :: Lens' Status [Proto.Google.Protobuf.Any.Any]
  • vec'details :: Lens' Status (Data.Vector.Vector Proto.Google.Protobuf.Any.Any)

Instances

Instances details
NFData Status Source # 
Instance details

Defined in Proto.Status

Methods

rnf :: Status -> () #

Show Status Source # 
Instance details

Defined in Proto.Status

Eq Status Source # 
Instance details

Defined in Proto.Status

Methods

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

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

Ord Status Source # 
Instance details

Defined in Proto.Status

Message Status Source # 
Instance details

Defined in Proto.Status

HasField Status "code" Int32 Source # 
Instance details

Defined in Proto.Status

Methods

fieldOf :: Functor f => Proxy# "code" -> (Int32 -> f Int32) -> Status -> f Status #

HasField Status "message" Text Source # 
Instance details

Defined in Proto.Status

Methods

fieldOf :: Functor f => Proxy# "message" -> (Text -> f Text) -> Status -> f Status #

HasField Status "details" [Any] Source # 
Instance details

Defined in Proto.Status

Methods

fieldOf :: Functor f => Proxy# "details" -> ([Any] -> f [Any]) -> Status -> f Status #

HasField Status "vec'details" (Vector Any) Source # 
Instance details

Defined in Proto.Status

Methods

fieldOf :: Functor f => Proxy# "vec'details" -> (Vector Any -> f (Vector Any)) -> Status -> f Status #

Metadata

data CustomMetadata where Source #

Custom metadata

This is an arbitrary set of key-value pairs defined by the application layer.

Custom metadata order is not guaranteed to be preserved except for values with duplicate header names. Duplicate header names may have their values joined with "," as the delimiter and be considered semantically equivalent.

Bundled Patterns

pattern CustomMetadata :: HasCallStack => HeaderName -> ByteString -> CustomMetadata 

Instances

Instances details
NFData CustomMetadata Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Raw

Methods

rnf :: CustomMetadata -> () #

Generic CustomMetadata Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Raw

Associated Types

type Rep CustomMetadata 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Raw

type Rep CustomMetadata = D1 ('MetaData "CustomMetadata" "Network.GRPC.Spec.CustomMetadata.Raw" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "UnsafeCustomMetadata" 'PrefixI 'True) (S1 ('MetaSel ('Just "customMetadataName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HeaderName) :*: S1 ('MetaSel ('Just "customMetadataValue") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)))
Show CustomMetadata Source #

Show instance relies on the CustomMetadata pattern synonym

Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Raw

Eq CustomMetadata Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Raw

type Rep CustomMetadata Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Raw

type Rep CustomMetadata = D1 ('MetaData "CustomMetadata" "Network.GRPC.Spec.CustomMetadata.Raw" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "UnsafeCustomMetadata" 'PrefixI 'True) (S1 ('MetaSel ('Just "customMetadataName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 HeaderName) :*: S1 ('MetaSel ('Just "customMetadataValue") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)))

customMetadataName :: CustomMetadata -> HeaderName Source #

Header name

The header name determines if this is an ASCII header or a binary header; see the CustomMetadata pattern synonym.

safeCustomMetadata :: HeaderName -> ByteString -> Maybe CustomMetadata Source #

Construct CustomMetadata

Returns Nothing if the HeaderName indicates an ASCII header but the value is not valid ASCII (consider using a binary header instead).

data HeaderName where Source #

Header name

To construct a HeaderName, you can either use the IsString instance

"foo"     :: HeaderName -- an ASCII header
"bar-bin" :: HeaderName -- a binary header

or alternatively use the AsciiHeader and BinaryHeader patterns

AsciiHeader  "foo"
BinaryHeader "bar-bin"

The latter style is more explicit, and can catch more errors:

AsciiHeader  "foo-bin" -- exception: unexpected -bin suffix
BinaryHeader "bar"     -- exception: expected   -bin suffix

Header names cannot be empty, and must consist of digits (0-9), lowercase letters (a-z), underscore (_), hyphen (-), or period (.). Reserved header names are disallowed.

See also safeHeaderName.

Bundled Patterns

pattern BinaryHeader :: HasCallStack => ByteString -> HeaderName 
pattern AsciiHeader :: HasCallStack => ByteString -> HeaderName 

Instances

Instances details
NFData HeaderName Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Raw

Methods

rnf :: HeaderName -> () #

IsString HeaderName Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Raw

Generic HeaderName Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Raw

Associated Types

type Rep HeaderName 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Raw

type Rep HeaderName = D1 ('MetaData "HeaderName" "Network.GRPC.Spec.CustomMetadata.Raw" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "UnsafeBinaryHeader" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)) :+: C1 ('MetaCons "UnsafeAsciiHeader" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)))
Show HeaderName Source #

Show instance relies on the IsString instance

Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Raw

Eq HeaderName Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Raw

Ord HeaderName Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Raw

type Rep HeaderName Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Raw

type Rep HeaderName = D1 ('MetaData "HeaderName" "Network.GRPC.Spec.CustomMetadata.Raw" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "UnsafeBinaryHeader" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)) :+: C1 ('MetaCons "UnsafeAsciiHeader" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)))

safeHeaderName :: ByteString -> Maybe HeaderName Source #

Check for header name validity

We choose between BinaryHeader and AsciiHeader based on the presence or absence of a @-bin suffix.

isValidAsciiValue :: ByteString -> Bool Source #

Check for valid ASCII header value

ASCII-Value → 1*( %x20-%x7E ) ; space and printable ASCII

NOTE: By rights this should verify that the header is non-empty. However, empty header values do occasionally show up, and so we permit them. The main reason for checking for validity at all is to ensure that we don't confuse binary headers and ASCII headers.

data NoMetadata Source #

Indicate the absence of custom metadata

NOTE: The ParseMetadata instance for NoMetadata throws an exception if any metadata is present (that is, metadata is not silently ignored).

Constructors

NoMetadata 

Handling of duplicate metadata entries

data CustomMetadataMap Source #

Map from header names to values

The gRPC spec mandates

Custom-Metadata header order is not guaranteed to be preserved except for
values with duplicate header names. Duplicate header names may have their
values joined with "," as the delimiter and be considered semantically
equivalent.

Internally we don't allow for these duplicates, but instead join the headers as mandated by the spec.

Instances

Instances details
Monoid CustomMetadataMap Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Map

Semigroup CustomMetadataMap Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Map

Generic CustomMetadataMap Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Map

Associated Types

type Rep CustomMetadataMap 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Map

type Rep CustomMetadataMap = D1 ('MetaData "CustomMetadataMap" "Network.GRPC.Spec.CustomMetadata.Map" "grpc-spec-1.0.0-inplace" 'True) (C1 ('MetaCons "CustomMetadataMap" 'PrefixI 'True) (S1 ('MetaSel ('Just "getCustomMetadataMap") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map HeaderName ByteString))))
Show CustomMetadataMap Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Map

Eq CustomMetadataMap Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Map

type Rep CustomMetadataMap Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.Map

type Rep CustomMetadataMap = D1 ('MetaData "CustomMetadataMap" "Network.GRPC.Spec.CustomMetadata.Map" "grpc-spec-1.0.0-inplace" 'True) (C1 ('MetaCons "CustomMetadataMap" 'PrefixI 'True) (S1 ('MetaSel ('Just "getCustomMetadataMap") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map HeaderName ByteString))))

customMetadataMapToList :: CustomMetadataMap -> [CustomMetadata] Source #

Flatten CustomMetadataMap to a list

Precondition: the map must be valid.

customMetadataMapInsert :: CustomMetadata -> CustomMetadataMap -> CustomMetadataMap Source #

Insert value into CustomMetadataMap

If a header with the same name already exists, the value is appended to (the end of) the existing value.

Typed

type family RequestMetadata (rpc :: k) Source #

Metadata included in the request

Often you can give a blanket metadata definition for all methods in a service. For example:

type instance RequestMetadata          (Protobuf RouteGuide meth) = NoMetadata
type instance ResponseInitialMetadata  (Protobuf RouteGuide meth) = NoMetadata
type instance ResponseTrailingMetadata (Protobuf RouteGuide meth) = NoMetadata

If you want to give specific types of metadata for specific methods but not for others, it can sometimes be useful to introduce an auxiliary closed type, so that you can give a catch-all case. For example:

type instance ResponseInitialMetadata (Protobuf Greeter meth) = GreeterResponseInitialMetadata meth

type family GreeterResponseInitialMetadata (meth :: Symbol) where
  GreeterResponseInitialMetadata "sayHelloStreamReply" = SayHelloMetadata
  GreeterResponseInitialMetadata meth                  = NoMetadata

type family ResponseInitialMetadata (rpc :: k) Source #

Metadata included in the initial response

See RequestMetadata for discussion.

type family ResponseTrailingMetadata (rpc :: k) Source #

Metadata included in the response trailers

See RequestMetadata for discussion.

data ResponseMetadata (rpc :: k) Source #

Response metadata

It occassionally happens that we do not know if we should expect the initial metadata from the server or the trailing metadata (when the server uses Trailers-Only); for example, see recvResponseInitialMetadata.

Serialization

class BuildMetadata a where Source #

Serialize metadata to custom metadata headers

Instances

Instances details
BuildMetadata NoMetadata Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.NoMetadata

class ParseMetadata a where Source #

Parse metadata from custom metadata headers

Some guidelines for defining instances:

  • You can assume that the list of headers will not contain duplicates. The gRPC spec does allow for duplicate headers and specifies how to process them, but this will be taken care of before parseMetadata is called.
  • However, you should assume no particular order.
  • If there are unexpected headers present, you have a choice whether you want to consider this a error and throw an exception, or regard the additional headers as merely additional information and simply ignore them. There is no single right answer here: ignoring additional metadata runs the risk of not realizing that the peer is trying to tell you something important, but throwing an error runs the risk of unnecessarily aborting an RPC.

Instances

Instances details
ParseMetadata NoMetadata Source # 
Instance details

Defined in Network.GRPC.Spec.CustomMetadata.NoMetadata

class BuildMetadata a => StaticMetadata a where Source #

Metadata with statically known fields

This is required for the response trailing metadata. When the server sends the initial set of headers to the client, it must tell the client which trailers to expect (by means of the HTTP Trailer header; see https://datatracker.ietf.org/doc/html/rfc7230#section-4.4).

Any headers constructed in buildMetadata must be listed here; not doing so is a bug. However, the converse is not true: it is acceptable for a header to be listed in metadataHeaderNames but not in buildMetadata. Put another way: the list of "trailers to expect" included in the initial request headers is allowed to be an overapproximation, but not an underapproximation.

buildMetadataIO :: BuildMetadata a => a -> IO [CustomMetadata] Source #

Wrapper around buildMetadata that catches any pure exceptions

These pure exceptions can arise when invalid headers are generated (for example, ASCII headers with non-ASCII values).

Invalid headers

newtype InvalidHeaders e Source #

Invalid headers

This is used for request headers, response headers, and response trailers.

Constructors

InvalidHeaders 

data InvalidHeader e Source #

Invalid header

This corresponds to a single "raw" HTTP header. It is possible that a particular field of, say, RequestHeaders corresponds to multiple InvalidHeader, when the value of that field is determined by combining multiple HTTP headers. A special case of this is the field for unrecognized headers (see requestUnrecognized, responseUnrecognized, etc.), which collects all unrecognized headers in one field (and has value () if there are none).

For some invalid headers the gRPC spec mandates a specific HTTP status; if this status is not specified, then we use 400 Bad Request.

Constructors

InvalidHeader (Maybe Status) Header String

We failed to parse this header

We record the original header and the reason parsing failed.

MissingHeader (Maybe Status) HeaderName

Missing header (header that should have been present but was not)

UnexpectedHeader HeaderName

Unexpected header (header that should not have been present but was)

InvalidHeaderSynthesize e (InvalidHeader HandledSynthesized)

Synthesize gRPC exception

This will be instantiated to GrpcException after parsing, and to HandledSynthesized once synthesized errors have been handled. See HandledSynthesized for more details.

We record both the actual error and the synthesized error.

Instances

Instances details
Show e => Show (InvalidHeader e) Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Invalid

Eq e => Eq (InvalidHeader e) Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Invalid

Construction

invalidHeader :: Maybe Status -> Header -> String -> InvalidHeaders e Source #

Convenience constructor around InvalidHeader

missingHeader :: Maybe Status -> HeaderName -> InvalidHeaders e Source #

Convenience constructor around MissingHeader

unexpectedHeader :: HeaderName -> InvalidHeaders e Source #

Convenience constructor around UnexpectedHeader

throwInvalidHeader :: MonadError (InvalidHeaders e) m => Header -> Either String a -> m a Source #

Convenience function for throwing an invalidHeader exception.

Synthesized errors

data HandledSynthesized Source #

Indicate that all synthesized errors have been handled

For some headers the gRPC spec mandates a specific gRPC error that should be synthesized when the header is invalid. We use HandledSynthesized in types to indicate that all errors that should have been synthesized have already been thrown.

For example, RequestHeaders' HandledSynthesized indicates that these request headers may still contain errors for some headers, but no errors for which the spec mandates that we synthesize a specific gRPC exception.

handledSynthesized :: HandledSynthesized -> a Source #

Evidence that HandledSynthesized is an empty type

dropSynthesized :: InvalidHeaders e -> InvalidHeaders HandledSynthesized Source #

Drop all synthesized errors, leaving just the original

mapSynthesizedM :: Monad m => (e -> m e') -> InvalidHeaders e -> m (InvalidHeaders e') Source #

Map over the errors

mapSynthesized :: (e -> e') -> InvalidHeaders e -> InvalidHeaders e' Source #

Pure version of mapSynthesizedM

throwSynthesized :: (Traversable h, Monad m) => (forall a. GrpcException -> m a) -> h (Checked (InvalidHeaders GrpcException)) -> m (h (Checked (InvalidHeaders HandledSynthesized))) Source #

Throw all synthesized errors

After this we are guaranteed that the synthesized errors have been handlded.

Use

invalidHeaders :: InvalidHeaders e -> [Header] Source #

Extract all invalid headers

statusInvalidHeaders :: InvalidHeaders HandledSynthesized -> Status Source #

HTTP status to report

If there are multiple headers, each of which with a mandated status, we just use the first; the spec is essentially ambiguous in this case.

Common infrastructure to all headers

data ContentType Source #

Content type

Constructors

ContentTypeDefault

The default content type for this RPC

This is given by rpcContentType, and is typically application/grpc+format, where format is proto, json, .. (see also defaultRpcContentType).

ContentTypeOverride ByteString

Override the content type

Depending on the choice of override, this may or may not be conform spec. See https://datatracker.ietf.org/doc/html/rfc2045#section-5 for a spec of the Content-Type header; the gRPC spec however disallows most of what is technically allowed by this RPC.

Instances

Instances details
Default ContentType Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Common

Methods

def :: ContentType #

Generic ContentType Source # 
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 Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Common

Eq ContentType Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Common

type Rep ContentType Source # 
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)))

chooseContentType :: forall {k} (rpc :: k). IsRPC rpc => Proxy rpc -> ContentType -> ByteString Source #

Interpret ContentType

data MessageType Source #

Message type

Constructors

MessageTypeDefault

Default message type for this RPC

This is given by rpcMessageType. For the specific case Protobuf this is the fully qualified proto message name (and we currently omit the grpc-message-type header altogether for JSON).

MessageTypeOverride ByteString

Override the message type

Instances

Instances details
Default MessageType Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Common

Methods

def :: MessageType #

Generic MessageType Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Common

Associated Types

type Rep MessageType 
Instance details

Defined in Network.GRPC.Spec.Headers.Common

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

Defined in Network.GRPC.Spec.Headers.Common

Eq MessageType Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Common

type Rep MessageType Source # 
Instance details

Defined in Network.GRPC.Spec.Headers.Common

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

chooseMessageType :: forall {k} (rpc :: k). IsRPC rpc => Proxy rpc -> MessageType -> Maybe ByteString Source #

Interpret MessageType

OpenTelemetry

data TraceContext Source #

Trace context

Representation of the "trace context" in OpenTelemetry, corresponding directly to the W3C traceparent header.

References:

Relation to Haskell OpenTelemetry implementations:

  • The Haskell opentelemetry package calls this a SpanContext, but provides no binary PropagationFormat, and does not support TraceOptions.

https://hackage.haskell.org/package/opentelemetry

  • The Haskell hs-opentelemetry ecosystem defines SpanContext, which is the combination of the W3C traceparent header (our TraceContext) and the W3C tracestate header (which we do not support). It too does not support the grpc-trace-bin binary format.

https://github.com/iand675/hs-opentelemetry https://hackage.haskell.org/package/hs-opentelemetry-propagator-w3c

Instances

Instances details
Binary TraceContext Source # 
Instance details

Defined in Network.GRPC.Spec.Serialization.TraceContext

Default TraceContext Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

Methods

def :: TraceContext #

Generic TraceContext Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

Associated Types

type Rep TraceContext 
Instance details

Defined in Network.GRPC.Spec.TraceContext

type Rep TraceContext = D1 ('MetaData "TraceContext" "Network.GRPC.Spec.TraceContext" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "TraceContext" 'PrefixI 'True) (S1 ('MetaSel ('Just "traceContextTraceId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe TraceId)) :*: (S1 ('MetaSel ('Just "traceContextSpanId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe SpanId)) :*: S1 ('MetaSel ('Just "traceContextOptions") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe TraceOptions)))))
Show TraceContext Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

Eq TraceContext Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

type Rep TraceContext Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

type Rep TraceContext = D1 ('MetaData "TraceContext" "Network.GRPC.Spec.TraceContext" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "TraceContext" 'PrefixI 'True) (S1 ('MetaSel ('Just "traceContextTraceId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe TraceId)) :*: (S1 ('MetaSel ('Just "traceContextSpanId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe SpanId)) :*: S1 ('MetaSel ('Just "traceContextOptions") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe TraceOptions)))))

newtype TraceId Source #

Trace ID

The ID of the whole trace forest. Must be a 16-byte string.

Constructors

TraceId 

Instances

Instances details
Binary TraceId Source # 
Instance details

Defined in Network.GRPC.Spec.Serialization.TraceContext

Methods

put :: TraceId -> Put #

get :: Get TraceId #

putList :: [TraceId] -> Put #

IsString TraceId Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

Methods

fromString :: String -> TraceId #

Generic TraceId Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

Associated Types

type Rep TraceId 
Instance details

Defined in Network.GRPC.Spec.TraceContext

type Rep TraceId = D1 ('MetaData "TraceId" "Network.GRPC.Spec.TraceContext" "grpc-spec-1.0.0-inplace" 'True) (C1 ('MetaCons "TraceId" 'PrefixI 'True) (S1 ('MetaSel ('Just "getTraceId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)))

Methods

from :: TraceId -> Rep TraceId x #

to :: Rep TraceId x -> TraceId #

Show TraceId Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

Eq TraceId Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

Methods

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

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

type Rep TraceId Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

type Rep TraceId = D1 ('MetaData "TraceId" "Network.GRPC.Spec.TraceContext" "grpc-spec-1.0.0-inplace" 'True) (C1 ('MetaCons "TraceId" 'PrefixI 'True) (S1 ('MetaSel ('Just "getTraceId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)))

newtype SpanId Source #

Span ID

ID of the caller span (parent). Must be an 8-byte string.

Constructors

SpanId 

Instances

Instances details
Binary SpanId Source # 
Instance details

Defined in Network.GRPC.Spec.Serialization.TraceContext

Methods

put :: SpanId -> Put #

get :: Get SpanId #

putList :: [SpanId] -> Put #

IsString SpanId Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

Methods

fromString :: String -> SpanId #

Generic SpanId Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

Associated Types

type Rep SpanId 
Instance details

Defined in Network.GRPC.Spec.TraceContext

type Rep SpanId = D1 ('MetaData "SpanId" "Network.GRPC.Spec.TraceContext" "grpc-spec-1.0.0-inplace" 'True) (C1 ('MetaCons "SpanId" 'PrefixI 'True) (S1 ('MetaSel ('Just "getSpanId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)))

Methods

from :: SpanId -> Rep SpanId x #

to :: Rep SpanId x -> SpanId #

Show SpanId Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

Eq SpanId Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

Methods

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

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

type Rep SpanId Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

type Rep SpanId = D1 ('MetaData "SpanId" "Network.GRPC.Spec.TraceContext" "grpc-spec-1.0.0-inplace" 'True) (C1 ('MetaCons "SpanId" 'PrefixI 'True) (S1 ('MetaSel ('Just "getSpanId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ByteString)))

data TraceOptions Source #

Tracing options

The flags are recommendations given by the caller rather than strict rules to follow for 3 reasons:

  • Trust and abuse.
  • Bug in caller
  • Different load between caller service and callee service might force callee to down sample.

Constructors

TraceOptions 

Fields

  • traceOptionsSampled :: Bool

    Sampled

    When set, denotes that the caller may have recorded trace data. When unset, the caller did not record trace data out-of-band.

Instances

Instances details
Binary TraceOptions Source # 
Instance details

Defined in Network.GRPC.Spec.Serialization.TraceContext

Generic TraceOptions Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

Associated Types

type Rep TraceOptions 
Instance details

Defined in Network.GRPC.Spec.TraceContext

type Rep TraceOptions = D1 ('MetaData "TraceOptions" "Network.GRPC.Spec.TraceContext" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "TraceOptions" 'PrefixI 'True) (S1 ('MetaSel ('Just "traceOptionsSampled") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool)))
Show TraceOptions Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

Eq TraceOptions Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

type Rep TraceOptions Source # 
Instance details

Defined in Network.GRPC.Spec.TraceContext

type Rep TraceOptions = D1 ('MetaData "TraceOptions" "Network.GRPC.Spec.TraceContext" "grpc-spec-1.0.0-inplace" 'False) (C1 ('MetaCons "TraceOptions" 'PrefixI 'True) (S1 ('MetaSel ('Just "traceOptionsSampled") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool)))

ORCA

data OrcaLoadReport Source #

Fields :

  • cpuUtilization :: Lens' OrcaLoadReport Prelude.Double
  • memUtilization :: Lens' OrcaLoadReport Prelude.Double
  • rps :: Lens' OrcaLoadReport Data.Word.Word64
  • requestCost :: Lens' OrcaLoadReport (Data.Map.Map Data.Text.Text Prelude.Double)
  • utilization :: Lens' OrcaLoadReport (Data.Map.Map Data.Text.Text Prelude.Double)
  • rpsFractional :: Lens' OrcaLoadReport Prelude.Double
  • eps :: Lens' OrcaLoadReport Prelude.Double
  • namedMetrics :: Lens' OrcaLoadReport (Data.Map.Map Data.Text.Text Prelude.Double)
  • applicationUtilization :: Lens' OrcaLoadReport Prelude.Double

Instances

Instances details
NFData OrcaLoadReport Source # 
Instance details

Defined in Proto.OrcaLoadReport

Methods

rnf :: OrcaLoadReport -> () #

Show OrcaLoadReport Source # 
Instance details

Defined in Proto.OrcaLoadReport

Eq OrcaLoadReport Source # 
Instance details

Defined in Proto.OrcaLoadReport

Ord OrcaLoadReport Source # 
Instance details

Defined in Proto.OrcaLoadReport

Message OrcaLoadReport Source # 
Instance details

Defined in Proto.OrcaLoadReport

HasField OrcaLoadReport "applicationUtilization" Double Source # 
Instance details

Defined in Proto.OrcaLoadReport

Methods

fieldOf :: Functor f => Proxy# "applicationUtilization" -> (Double -> f Double) -> OrcaLoadReport -> f OrcaLoadReport #

HasField OrcaLoadReport "cpuUtilization" Double Source # 
Instance details

Defined in Proto.OrcaLoadReport

Methods

fieldOf :: Functor f => Proxy# "cpuUtilization" -> (Double -> f Double) -> OrcaLoadReport -> f OrcaLoadReport #

HasField OrcaLoadReport "eps" Double Source # 
Instance details

Defined in Proto.OrcaLoadReport

Methods

fieldOf :: Functor f => Proxy# "eps" -> (Double -> f Double) -> OrcaLoadReport -> f OrcaLoadReport #

HasField OrcaLoadReport "memUtilization" Double Source # 
Instance details

Defined in Proto.OrcaLoadReport

Methods

fieldOf :: Functor f => Proxy# "memUtilization" -> (Double -> f Double) -> OrcaLoadReport -> f OrcaLoadReport #

HasField OrcaLoadReport "rps" Word64 Source # 
Instance details

Defined in Proto.OrcaLoadReport

Methods

fieldOf :: Functor f => Proxy# "rps" -> (Word64 -> f Word64) -> OrcaLoadReport -> f OrcaLoadReport #

HasField OrcaLoadReport "rpsFractional" Double Source # 
Instance details

Defined in Proto.OrcaLoadReport

Methods

fieldOf :: Functor f => Proxy# "rpsFractional" -> (Double -> f Double) -> OrcaLoadReport -> f OrcaLoadReport #

HasField OrcaLoadReport "namedMetrics" (Map Text Double) Source # 
Instance details

Defined in Proto.OrcaLoadReport

Methods

fieldOf :: Functor f => Proxy# "namedMetrics" -> (Map Text Double -> f (Map Text Double)) -> OrcaLoadReport -> f OrcaLoadReport #

HasField OrcaLoadReport "requestCost" (Map Text Double) Source # 
Instance details

Defined in Proto.OrcaLoadReport

Methods

fieldOf :: Functor f => Proxy# "requestCost" -> (Map Text Double -> f (Map Text Double)) -> OrcaLoadReport -> f OrcaLoadReport #

HasField OrcaLoadReport "utilization" (Map Text Double) Source # 
Instance details

Defined in Proto.OrcaLoadReport

Methods

fieldOf :: Functor f => Proxy# "utilization" -> (Map Text Double -> f (Map Text Double)) -> OrcaLoadReport -> f OrcaLoadReport #