{-# LANGUAGE OverloadedStrings #-}
module Network.GRPC.Spec.Serialization.Headers.Request (
buildRequestHeaders
, parseRequestHeaders
, parseRequestHeaders'
) where
import Control.Monad
import Control.Monad.Except (MonadError(throwError))
import Control.Monad.State (State, execState, modify)
import Data.Bifunctor
import Data.ByteString qualified as Strict (ByteString)
import Data.ByteString.Char8 qualified as BS.Strict.C8
import Data.Functor (($>))
import Data.List (intercalate)
import Data.Maybe (catMaybes)
import Data.Proxy
import Network.HTTP.Types qualified as HTTP
import Text.Read (readMaybe)
import Network.GRPC.Spec
import Network.GRPC.Spec.Serialization.CustomMetadata
import Network.GRPC.Spec.Serialization.Headers.Common
import Network.GRPC.Spec.Serialization.Timeout
import Network.GRPC.Spec.Serialization.TraceContext
import Network.GRPC.Spec.Util.HKD qualified as HKD
buildRequestHeaders ::
IsRPC rpc
=> Proxy rpc -> RequestHeaders -> [HTTP.Header]
Proxy rpc
proxy callParams :: RequestHeaders
callParams@RequestHeaders{CustomMetadataMap
requestMetadata :: CustomMetadataMap
requestMetadata :: forall (f :: * -> *). RequestHeaders_ f -> CustomMetadataMap
requestMetadata} = [[Header]] -> [Header]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
Proxy rpc -> RequestHeaders -> [Header]
forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc -> RequestHeaders -> [Header]
callDefinition Proxy rpc
proxy RequestHeaders
callParams
, (CustomMetadata -> Header) -> [CustomMetadata] -> [Header]
forall a b. (a -> b) -> [a] -> [b]
map CustomMetadata -> Header
buildCustomMetadata ([CustomMetadata] -> [Header]) -> [CustomMetadata] -> [Header]
forall a b. (a -> b) -> a -> b
$ CustomMetadataMap -> [CustomMetadata]
customMetadataMapToList CustomMetadataMap
requestMetadata
]
callDefinition :: forall rpc.
IsRPC rpc
=> Proxy rpc -> RequestHeaders -> [HTTP.Header]
callDefinition :: forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc -> RequestHeaders -> [Header]
callDefinition Proxy rpc
proxy = \RequestHeaders
hdrs -> [Maybe Header] -> [Header]
forall a. [Maybe a] -> [a]
catMaybes [
Timeout -> Header
hdrTimeout (Timeout -> Header) -> Maybe Timeout -> Maybe Header
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RequestHeaders -> HKD Undecorated (Maybe Timeout)
forall (f :: * -> *). RequestHeaders_ f -> HKD f (Maybe Timeout)
requestTimeout RequestHeaders
hdrs
, Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RequestHeaders -> HKD Undecorated Bool
forall (f :: * -> *). RequestHeaders_ f -> HKD f Bool
requestIncludeTE RequestHeaders
hdrs) Maybe () -> Header -> Maybe Header
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Header
buildTe
, Maybe ByteString -> Header
buildContentType (Maybe ByteString -> Header)
-> (ContentType -> Maybe ByteString) -> ContentType -> Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (ContentType -> ByteString) -> ContentType -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy rpc -> ContentType -> ByteString
forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc -> ContentType -> ByteString
chooseContentType Proxy rpc
proxy (ContentType -> Header) -> Maybe ContentType -> Maybe Header
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
RequestHeaders -> HKD Undecorated (Maybe ContentType)
forall (f :: * -> *).
RequestHeaders_ f -> HKD f (Maybe ContentType)
requestContentType RequestHeaders
hdrs
, Maybe (Maybe Header) -> Maybe Header
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Header) -> Maybe Header)
-> Maybe (Maybe Header) -> Maybe Header
forall a b. (a -> b) -> a -> b
$ Proxy rpc -> MessageType -> Maybe Header
forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc -> MessageType -> Maybe Header
buildMessageType Proxy rpc
proxy (MessageType -> Maybe Header)
-> Maybe MessageType -> Maybe (Maybe Header)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RequestHeaders -> HKD Undecorated (Maybe MessageType)
forall (f :: * -> *).
RequestHeaders_ f -> HKD f (Maybe MessageType)
requestMessageType RequestHeaders
hdrs
, CompressionId -> Header
buildMessageEncoding (CompressionId -> Header) -> Maybe CompressionId -> Maybe Header
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RequestHeaders -> HKD Undecorated (Maybe CompressionId)
forall (f :: * -> *).
RequestHeaders_ f -> HKD f (Maybe CompressionId)
requestCompression RequestHeaders
hdrs
, NonEmpty CompressionId -> Header
buildMessageAcceptEncoding (NonEmpty CompressionId -> Header)
-> Maybe (NonEmpty CompressionId) -> Maybe Header
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RequestHeaders -> HKD Undecorated (Maybe (NonEmpty CompressionId))
forall (f :: * -> *).
RequestHeaders_ f -> HKD f (Maybe (NonEmpty CompressionId))
requestAcceptCompression RequestHeaders
hdrs
, ByteString -> Header
buildUserAgent (ByteString -> Header) -> Maybe ByteString -> Maybe Header
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RequestHeaders -> HKD Undecorated (Maybe ByteString)
forall (f :: * -> *). RequestHeaders_ f -> HKD f (Maybe ByteString)
requestUserAgent RequestHeaders
hdrs
, TraceContext -> Header
buildGrpcTraceBin (TraceContext -> Header) -> Maybe TraceContext -> Maybe Header
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RequestHeaders -> HKD Undecorated (Maybe TraceContext)
forall (f :: * -> *).
RequestHeaders_ f -> HKD f (Maybe TraceContext)
requestTraceContext RequestHeaders
hdrs
, Int -> Header
buildPreviousRpcAttempts (Int -> Header) -> Maybe Int -> Maybe Header
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RequestHeaders -> HKD Undecorated (Maybe Int)
forall (f :: * -> *). RequestHeaders_ f -> HKD f (Maybe Int)
requestPreviousRpcAttempts RequestHeaders
hdrs
]
where
hdrTimeout :: Timeout -> HTTP.Header
hdrTimeout :: Timeout -> Header
hdrTimeout Timeout
t = (HeaderName
"grpc-timeout", Timeout -> ByteString
buildTimeout Timeout
t)
buildTe :: HTTP.Header
buildTe :: Header
buildTe = (HeaderName
"te", ByteString
"trailers")
buildUserAgent :: Strict.ByteString -> HTTP.Header
buildUserAgent :: ByteString -> Header
buildUserAgent ByteString
userAgent = (
HeaderName
"user-agent"
, ByteString
userAgent
)
buildGrpcTraceBin :: TraceContext -> HTTP.Header
buildGrpcTraceBin :: TraceContext -> Header
buildGrpcTraceBin TraceContext
ctxt = (
HeaderName
"grpc-trace-bin"
, ByteString -> ByteString
buildBinaryValue (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ TraceContext -> ByteString
buildTraceContext TraceContext
ctxt
)
buildPreviousRpcAttempts :: Int -> HTTP.Header
buildPreviousRpcAttempts :: Int -> Header
buildPreviousRpcAttempts Int
n = (
HeaderName
"grpc-previous-rpc-attempts"
, String -> ByteString
BS.Strict.C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n
)
parseRequestHeaders :: forall rpc m.
(IsRPC rpc, MonadError (InvalidHeaders GrpcException) m)
=> Proxy rpc
-> [HTTP.Header] -> m RequestHeaders
Proxy rpc
proxy = RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> m RequestHeaders
forall e (m :: * -> *) (t :: (* -> *) -> *).
(MonadError e m, Traversable t) =>
t (Checked e) -> m (t Undecorated)
HKD.sequenceChecked (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> m RequestHeaders)
-> ([Header]
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> [Header]
-> m RequestHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy rpc
-> [Header]
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc
-> [Header]
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
parseRequestHeaders' Proxy rpc
proxy
parseRequestHeaders' :: forall rpc.
IsRPC rpc
=> Proxy rpc
-> [HTTP.Header] -> RequestHeaders' GrpcException
Proxy rpc
proxy =
(State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
forall s a. State s a -> s -> s
execState RequestHeaders_ (Checked (InvalidHeaders GrpcException))
uninitRequestHeaders
(State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> ([Header]
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ())
-> [Header]
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ())
-> [Header]
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Header
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
parseHeader (Header
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ())
-> (Header -> Header)
-> Header
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> Header -> Header
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ByteString -> ByteString
trim)
where
parseHeader :: HTTP.Header -> State (RequestHeaders' GrpcException) ()
parseHeader :: Header
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
parseHeader hdr :: Header
hdr@(HeaderName
name, ByteString
value)
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"user-agent"
= (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ())
-> (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall a b. (a -> b) -> a -> b
$ \RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x -> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x {
requestUserAgent = return (Just value)
}
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"grpc-timeout"
= (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ())
-> (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall a b. (a -> b) -> a -> b
$ \RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x -> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x {
requestTimeout = fmap Just $
httpError hdr $
parseTimeout value
}
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"grpc-encoding"
= (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ())
-> (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall a b. (a -> b) -> a -> b
$ \RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x -> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x {
requestCompression = fmap Just $
parseMessageEncoding hdr
}
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"grpc-accept-encoding"
= (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ())
-> (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall a b. (a -> b) -> a -> b
$ \RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x -> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x {
requestAcceptCompression = fmap Just $
parseMessageAcceptEncoding hdr
}
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"grpc-trace-bin"
= (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ())
-> (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall a b. (a -> b) -> a -> b
$ \RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x -> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x {
requestTraceContext = fmap Just $
httpError hdr $
parseBinaryValue value >>= parseTraceContext
}
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"content-type"
= (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ())
-> (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall a b. (a -> b) -> a -> b
$ \RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x -> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x {
requestContentType = fmap Just $
parseContentType' proxy hdr
}
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"grpc-message-type"
= (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ())
-> (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall a b. (a -> b) -> a -> b
$ \RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x -> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x {
requestMessageType = return . Just $
parseMessageType proxy hdr
}
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"te"
= (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ())
-> (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall a b. (a -> b) -> a -> b
$ \RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x -> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x {
requestIncludeTE = do
expectHeaderValue hdr ["trailers"]
return True
}
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"grpc-previous-rpc-attempts"
= (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ())
-> (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall a b. (a -> b) -> a -> b
$ \RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x -> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x {
requestPreviousRpcAttempts = do
httpError hdr $
maybe
(Left $ "grpc-previous-rpc-attempts: invalid " ++ show value)
(Right . Just)
(readMaybe $ BS.Strict.C8.unpack value)
}
| Bool
otherwise
= (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ())
-> (RequestHeaders_ (Checked (InvalidHeaders GrpcException))
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException)))
-> State
(RequestHeaders_ (Checked (InvalidHeaders GrpcException))) ()
forall a b. (a -> b) -> a -> b
$ \RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x ->
case Header -> Either (InvalidHeaders GrpcException) CustomMetadata
forall (m :: * -> *).
MonadError (InvalidHeaders GrpcException) m =>
Header -> m CustomMetadata
parseCustomMetadata Header
hdr of
Left InvalidHeaders GrpcException
invalid -> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x {
requestUnrecognized = Left $
case requestUnrecognized x of
Left InvalidHeaders GrpcException
invalid' -> InvalidHeaders GrpcException
invalid InvalidHeaders GrpcException
-> InvalidHeaders GrpcException -> InvalidHeaders GrpcException
forall a. Semigroup a => a -> a -> a
<> InvalidHeaders GrpcException
invalid'
Right () -> InvalidHeaders GrpcException
invalid
}
Right CustomMetadata
md -> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
x {
requestMetadata = customMetadataMapInsert md $ requestMetadata x
}
uninitRequestHeaders :: RequestHeaders' GrpcException
uninitRequestHeaders :: RequestHeaders_ (Checked (InvalidHeaders GrpcException))
uninitRequestHeaders = RequestHeaders {
requestTimeout :: HKD (Checked (InvalidHeaders GrpcException)) (Maybe Timeout)
requestTimeout = Maybe Timeout
-> Either (InvalidHeaders GrpcException) (Maybe Timeout)
forall a. a -> Either (InvalidHeaders GrpcException) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Timeout
forall a. Maybe a
Nothing
, requestCompression :: HKD (Checked (InvalidHeaders GrpcException)) (Maybe CompressionId)
requestCompression = Maybe CompressionId
-> Either (InvalidHeaders GrpcException) (Maybe CompressionId)
forall a. a -> Either (InvalidHeaders GrpcException) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CompressionId
forall a. Maybe a
Nothing
, requestAcceptCompression :: HKD
(Checked (InvalidHeaders GrpcException))
(Maybe (NonEmpty CompressionId))
requestAcceptCompression = Maybe (NonEmpty CompressionId)
-> Either
(InvalidHeaders GrpcException) (Maybe (NonEmpty CompressionId))
forall a. a -> Either (InvalidHeaders GrpcException) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (NonEmpty CompressionId)
forall a. Maybe a
Nothing
, requestIncludeTE :: HKD (Checked (InvalidHeaders GrpcException)) Bool
requestIncludeTE = Bool -> Either (InvalidHeaders GrpcException) Bool
forall a. a -> Either (InvalidHeaders GrpcException) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
, requestUserAgent :: HKD (Checked (InvalidHeaders GrpcException)) (Maybe ByteString)
requestUserAgent = Maybe ByteString
-> Either (InvalidHeaders GrpcException) (Maybe ByteString)
forall a. a -> Either (InvalidHeaders GrpcException) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
, requestTraceContext :: HKD (Checked (InvalidHeaders GrpcException)) (Maybe TraceContext)
requestTraceContext = Maybe TraceContext
-> Either (InvalidHeaders GrpcException) (Maybe TraceContext)
forall a. a -> Either (InvalidHeaders GrpcException) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TraceContext
forall a. Maybe a
Nothing
, requestPreviousRpcAttempts :: HKD (Checked (InvalidHeaders GrpcException)) (Maybe Int)
requestPreviousRpcAttempts = Maybe Int -> Either (InvalidHeaders GrpcException) (Maybe Int)
forall a. a -> Either (InvalidHeaders GrpcException) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
, requestMetadata :: CustomMetadataMap
requestMetadata = CustomMetadataMap
forall a. Monoid a => a
mempty
, requestUnrecognized :: HKD (Checked (InvalidHeaders GrpcException)) ()
requestUnrecognized = () -> Either (InvalidHeaders GrpcException) ()
forall a. a -> Either (InvalidHeaders GrpcException) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, requestContentType :: HKD (Checked (InvalidHeaders GrpcException)) (Maybe ContentType)
requestContentType =
InvalidHeaders GrpcException
-> Either (InvalidHeaders GrpcException) (Maybe ContentType)
forall a.
InvalidHeaders GrpcException
-> Either (InvalidHeaders GrpcException) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (InvalidHeaders GrpcException
-> Either (InvalidHeaders GrpcException) (Maybe ContentType))
-> InvalidHeaders GrpcException
-> Either (InvalidHeaders GrpcException) (Maybe ContentType)
forall a b. (a -> b) -> a -> b
$ Maybe Status -> HeaderName -> InvalidHeaders GrpcException
forall e. Maybe Status -> HeaderName -> InvalidHeaders e
missingHeader Maybe Status
invalidContentType HeaderName
"content-type"
, requestMessageType :: HKD (Checked (InvalidHeaders GrpcException)) (Maybe MessageType)
requestMessageType =
case Proxy rpc -> Maybe ByteString
forall k (rpc :: k).
(IsRPC rpc, HasCallStack) =>
Proxy rpc -> Maybe ByteString
rpcMessageType Proxy rpc
proxy of
Maybe ByteString
Nothing -> Maybe MessageType
-> Either (InvalidHeaders GrpcException) (Maybe MessageType)
forall a. a -> Either (InvalidHeaders GrpcException) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MessageType
-> Either (InvalidHeaders GrpcException) (Maybe MessageType))
-> Maybe MessageType
-> Either (InvalidHeaders GrpcException) (Maybe MessageType)
forall a b. (a -> b) -> a -> b
$ MessageType -> Maybe MessageType
forall a. a -> Maybe a
Just MessageType
MessageTypeDefault
Just ByteString
_ -> Maybe MessageType
-> Either (InvalidHeaders GrpcException) (Maybe MessageType)
forall a. a -> Either (InvalidHeaders GrpcException) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MessageType
-> Either (InvalidHeaders GrpcException) (Maybe MessageType))
-> Maybe MessageType
-> Either (InvalidHeaders GrpcException) (Maybe MessageType)
forall a b. (a -> b) -> a -> b
$ Maybe MessageType
forall a. Maybe a
Nothing
}
httpError ::
MonadError (InvalidHeaders GrpcException) m'
=> HTTP.Header -> Either String a -> m' a
httpError :: forall (m' :: * -> *) a.
MonadError (InvalidHeaders GrpcException) m' =>
Header -> Either String a -> m' a
httpError Header
_ (Right a
a) = a -> m' a
forall a. a -> m' a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
httpError Header
hdr (Left String
err) = InvalidHeaders GrpcException -> m' a
forall a. InvalidHeaders GrpcException -> m' a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (InvalidHeaders GrpcException -> m' a)
-> InvalidHeaders GrpcException -> m' a
forall a b. (a -> b) -> a -> b
$ Maybe Status -> Header -> String -> InvalidHeaders GrpcException
forall e. Maybe Status -> Header -> String -> InvalidHeaders e
invalidHeader Maybe Status
forall a. Maybe a
Nothing Header
hdr String
err
parseContentType' ::
IsRPC rpc
=> Proxy rpc
-> HTTP.Header
-> Either (InvalidHeaders GrpcException) ContentType
parseContentType' :: forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc
-> Header -> Either (InvalidHeaders GrpcException) ContentType
parseContentType' Proxy rpc
proxy Header
hdr =
Proxy rpc
-> (String -> InvalidHeaders GrpcException)
-> Header
-> Either (InvalidHeaders GrpcException) ContentType
forall {k} (m :: * -> *) (rpc :: k).
(MonadError (InvalidHeaders GrpcException) m, IsRPC rpc) =>
Proxy rpc
-> (String -> InvalidHeaders GrpcException)
-> Header
-> m ContentType
parseContentType
Proxy rpc
proxy
(Maybe Status -> Header -> String -> InvalidHeaders GrpcException
forall e. Maybe Status -> Header -> String -> InvalidHeaders e
invalidHeader Maybe Status
invalidContentType Header
hdr)
Header
hdr
invalidContentType :: Maybe HTTP.Status
invalidContentType :: Maybe Status
invalidContentType = Status -> Maybe Status
forall a. a -> Maybe a
Just Status
HTTP.unsupportedMediaType415
expectHeaderValue ::
MonadError (InvalidHeaders GrpcException) m
=> HTTP.Header -> [Strict.ByteString] -> m ()
hdr :: Header
hdr@(HeaderName
_name, ByteString
actual) [ByteString]
expected =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString
actual ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
expected) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
InvalidHeaders GrpcException -> m ()
forall a. InvalidHeaders GrpcException -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (InvalidHeaders GrpcException -> m ())
-> InvalidHeaders GrpcException -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe Status -> Header -> String -> InvalidHeaders GrpcException
forall e. Maybe Status -> Header -> String -> InvalidHeaders e
invalidHeader Maybe Status
forall a. Maybe a
Nothing Header
hdr String
err
where
err :: String
err :: String
err = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
String
"Expected "
, String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" or " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
(ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ByteString
e -> String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BS.Strict.C8.unpack ByteString
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"") [ByteString]
expected
, String
"."
]