{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.GRPC.Spec.Serialization.Headers.Response (
buildResponseHeaders
, parseResponseHeaders
, parseResponseHeaders'
, buildProperTrailers
, parseProperTrailers
, parseProperTrailers'
, buildTrailersOnly
, parseTrailersOnly
, parseTrailersOnly'
, classifyServerResponse
, buildPushback
, parsePushback
) where
import Control.Monad.Except
import Control.Monad.State
import Data.Bifunctor
import Data.ByteString qualified as BS.Strict
import Data.ByteString qualified as Strict (ByteString)
import Data.ByteString.Char8 qualified as BS.Strict.C8
import Data.ByteString.Lazy qualified as BS.Lazy
import Data.ByteString.Lazy qualified as Lazy (ByteString)
import Data.CaseInsensitive qualified as CI
import Data.Maybe (isJust)
import Data.Proxy
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Network.HTTP.Types qualified as HTTP
import Text.Read (readMaybe)
#if !MIN_VERSION_text(2,0,0)
import Data.Text.Encoding.Error qualified as Text
#endif
import Network.GRPC.Spec
import Network.GRPC.Spec.PercentEncoding qualified as PercentEncoding
import Network.GRPC.Spec.Serialization.CustomMetadata
import Network.GRPC.Spec.Serialization.Headers.Common
import Network.GRPC.Spec.Util.HKD qualified as HKD
import Network.GRPC.Spec.Util.Protobuf qualified as Protobuf
classifyServerResponse :: forall rpc.
IsRPC rpc
=> Proxy rpc
-> HTTP.Status
-> [HTTP.Header]
-> Maybe Lazy.ByteString
-> Either (TrailersOnly' GrpcException) (ResponseHeaders' GrpcException)
classifyServerResponse :: forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc
-> Status
-> [Header]
-> Maybe ByteString
-> Either
(TrailersOnly' GrpcException) (ResponseHeaders' GrpcException)
classifyServerResponse Proxy rpc
rpc Status
status [Header]
headers Maybe ByteString
mBody
| [Header] -> Bool
hasGrpcStatus [Header]
headers
= TrailersOnly' GrpcException
-> Either
(TrailersOnly' GrpcException) (ResponseHeaders' GrpcException)
forall a b. a -> Either a b
Left (TrailersOnly' GrpcException
-> Either
(TrailersOnly' GrpcException) (ResponseHeaders' GrpcException))
-> TrailersOnly' GrpcException
-> Either
(TrailersOnly' GrpcException) (ResponseHeaders' GrpcException)
forall a b. (a -> b) -> a -> b
$ Proxy rpc -> [Header] -> TrailersOnly' GrpcException
forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc -> [Header] -> TrailersOnly' GrpcException
parseTrailersOnly' Proxy rpc
rpc [Header]
headers
| Int
200 <- Int
statusCode
= ResponseHeaders' GrpcException
-> Either
(TrailersOnly' GrpcException) (ResponseHeaders' GrpcException)
forall a b. b -> Either a b
Right (ResponseHeaders' GrpcException
-> Either
(TrailersOnly' GrpcException) (ResponseHeaders' GrpcException))
-> ResponseHeaders' GrpcException
-> Either
(TrailersOnly' GrpcException) (ResponseHeaders' GrpcException)
forall a b. (a -> b) -> a -> b
$ Proxy rpc -> [Header] -> ResponseHeaders' GrpcException
forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc -> [Header] -> ResponseHeaders' GrpcException
parseResponseHeaders' Proxy rpc
rpc [Header]
headers
| Bool
otherwise
= TrailersOnly' GrpcException
-> Either
(TrailersOnly' GrpcException) (ResponseHeaders' GrpcException)
forall a b. a -> Either a b
Left (TrailersOnly' GrpcException
-> Either
(TrailersOnly' GrpcException) (ResponseHeaders' GrpcException))
-> TrailersOnly' GrpcException
-> Either
(TrailersOnly' GrpcException) (ResponseHeaders' GrpcException)
forall a b. (a -> b) -> a -> b
$
case Int
statusCode of
Int
400 -> GrpcError -> TrailersOnly' GrpcException
synthesize GrpcError
GrpcInternal
Int
401 -> GrpcError -> TrailersOnly' GrpcException
synthesize GrpcError
GrpcUnauthenticated
Int
403 -> GrpcError -> TrailersOnly' GrpcException
synthesize GrpcError
GrpcPermissionDenied
Int
404 -> GrpcError -> TrailersOnly' GrpcException
synthesize GrpcError
GrpcUnimplemented
Int
429 -> GrpcError -> TrailersOnly' GrpcException
synthesize GrpcError
GrpcUnavailable
Int
502 -> GrpcError -> TrailersOnly' GrpcException
synthesize GrpcError
GrpcUnavailable
Int
503 -> GrpcError -> TrailersOnly' GrpcException
synthesize GrpcError
GrpcUnavailable
Int
504 -> GrpcError -> TrailersOnly' GrpcException
synthesize GrpcError
GrpcUnavailable
Int
_ -> GrpcError -> TrailersOnly' GrpcException
synthesize GrpcError
GrpcUnknown
where
HTTP.Status{Int
statusCode :: Int
statusCode :: Status -> Int
statusCode, ByteString
statusMessage :: ByteString
statusMessage :: Status -> ByteString
statusMessage} = Status
status
synthesize :: GrpcError -> TrailersOnly' GrpcException
synthesize :: GrpcError -> TrailersOnly' GrpcException
synthesize GrpcError
err = TrailersOnly' GrpcException
parsed {
trailersOnlyContentType =
case trailersOnlyContentType parsed of
Left InvalidHeaders GrpcException
_err -> Maybe ContentType
-> Either (InvalidHeaders GrpcException) (Maybe ContentType)
forall a b. b -> Either a b
Right Maybe ContentType
forall a. Maybe a
Nothing
Right Maybe ContentType
mCType -> Maybe ContentType
-> Either (InvalidHeaders GrpcException) (Maybe ContentType)
forall a b. b -> Either a b
Right Maybe ContentType
mCType
, trailersOnlyProper = parsedTrailers {
properTrailersGrpcStatus = Right $
GrpcError err
, properTrailersGrpcMessage = Right $
case properTrailersGrpcMessage parsedTrailers of
Right (Just Text
msg) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
msg
HKD (Checked (InvalidHeaders GrpcException)) (Maybe Text)
_otherwise -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
defaultMsg
}
}
where
parsed :: TrailersOnly' GrpcException
parsed :: TrailersOnly' GrpcException
parsed = Proxy rpc -> [Header] -> TrailersOnly' GrpcException
forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc -> [Header] -> TrailersOnly' GrpcException
parseTrailersOnly' Proxy rpc
rpc [Header]
headers
parsedTrailers :: ProperTrailers'
parsedTrailers :: ProperTrailers_ (Checked (InvalidHeaders GrpcException))
parsedTrailers = TrailersOnly' GrpcException
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException))
forall (f :: * -> *). TrailersOnly_ f -> ProperTrailers_ f
trailersOnlyProper TrailersOnly' GrpcException
parsed
defaultMsg :: Text
defaultMsg :: Text
defaultMsg = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [
Text
"Unexpected HTTP status code "
, String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
statusCode)
, if Bool -> Bool
not (ByteString -> Bool
BS.Strict.null ByteString
statusMessage)
then Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decodeUtf8Lenient ByteString
statusMessage Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
else Text
forall a. Monoid a => a
mempty
, case Maybe ByteString
mBody of
Just ByteString
body | Bool -> Bool
not (ByteString -> Bool
BS.Lazy.null ByteString
body) -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [
Text
"\nResponse body:\n"
, ByteString -> Text
decodeUtf8Lenient (ByteString -> ByteString
BS.Lazy.toStrict ByteString
body)
]
Maybe ByteString
_otherwise ->
Text
forall a. Monoid a => a
mempty
]
hasGrpcStatus :: [HTTP.Header] -> Bool
hasGrpcStatus :: [Header] -> Bool
hasGrpcStatus = Maybe ByteString -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ByteString -> Bool)
-> ([Header] -> Maybe ByteString) -> [Header] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> [Header] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"grpc-status"
buildResponseHeaders :: forall rpc.
SupportsServerRpc rpc
=> Proxy rpc -> ResponseHeaders -> [HTTP.Header]
Proxy rpc
proxy
ResponseHeaders{ HKD Undecorated (Maybe CompressionId)
responseCompression :: HKD Undecorated (Maybe CompressionId)
responseCompression :: forall (f :: * -> *).
ResponseHeaders_ f -> HKD f (Maybe CompressionId)
responseCompression
, HKD Undecorated (Maybe (NonEmpty CompressionId))
responseAcceptCompression :: HKD Undecorated (Maybe (NonEmpty CompressionId))
responseAcceptCompression :: forall (f :: * -> *).
ResponseHeaders_ f -> HKD f (Maybe (NonEmpty CompressionId))
responseAcceptCompression
, CustomMetadataMap
responseMetadata :: CustomMetadataMap
responseMetadata :: forall (f :: * -> *). ResponseHeaders_ f -> CustomMetadataMap
responseMetadata
, HKD Undecorated (Maybe ContentType)
responseContentType :: HKD Undecorated (Maybe ContentType)
responseContentType :: forall (f :: * -> *).
ResponseHeaders_ f -> HKD f (Maybe ContentType)
responseContentType
} = [[Header]] -> [Header]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
[ Maybe ByteString -> Header
buildContentType (Maybe ByteString -> Header) -> Maybe ByteString -> Header
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Proxy rpc -> ContentType -> ByteString
forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc -> ContentType -> ByteString
chooseContentType Proxy rpc
proxy ContentType
x)
| Just ContentType
x <- [Maybe ContentType
HKD Undecorated (Maybe ContentType)
responseContentType]
]
, [ CompressionId -> Header
buildMessageEncoding CompressionId
x
| Just CompressionId
x <- [Maybe CompressionId
HKD Undecorated (Maybe CompressionId)
responseCompression]
]
, [ NonEmpty CompressionId -> Header
buildMessageAcceptEncoding NonEmpty CompressionId
x
| Just NonEmpty CompressionId
x <- [Maybe (NonEmpty CompressionId)
HKD Undecorated (Maybe (NonEmpty CompressionId))
responseAcceptCompression]
]
, [ Proxy rpc -> Header
forall {k} (rpc :: k). SupportsServerRpc rpc => Proxy rpc -> Header
buildTrailer Proxy rpc
proxy ]
, [ CustomMetadata -> Header
buildCustomMetadata CustomMetadata
x
| CustomMetadata
x <- CustomMetadataMap -> [CustomMetadata]
customMetadataMapToList CustomMetadataMap
responseMetadata
]
]
parseResponseHeaders :: forall rpc m.
(IsRPC rpc, MonadError (InvalidHeaders GrpcException) m)
=> Proxy rpc -> [HTTP.Header] -> m ResponseHeaders
Proxy rpc
proxy = ResponseHeaders' GrpcException -> m ResponseHeaders
forall e (m :: * -> *) (t :: (* -> *) -> *).
(MonadError e m, Traversable t) =>
t (Checked e) -> m (t Undecorated)
HKD.sequenceChecked (ResponseHeaders' GrpcException -> m ResponseHeaders)
-> ([Header] -> ResponseHeaders' GrpcException)
-> [Header]
-> m ResponseHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy rpc -> [Header] -> ResponseHeaders' GrpcException
forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc -> [Header] -> ResponseHeaders' GrpcException
parseResponseHeaders' Proxy rpc
proxy
parseResponseHeaders' :: forall rpc.
IsRPC rpc
=> Proxy rpc -> [HTTP.Header] -> ResponseHeaders' GrpcException
Proxy rpc
proxy =
(State (ResponseHeaders' GrpcException) ()
-> ResponseHeaders' GrpcException
-> ResponseHeaders' GrpcException)
-> ResponseHeaders' GrpcException
-> State (ResponseHeaders' GrpcException) ()
-> ResponseHeaders' GrpcException
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (ResponseHeaders' GrpcException) ()
-> ResponseHeaders' GrpcException -> ResponseHeaders' GrpcException
forall s a. State s a -> s -> s
execState ResponseHeaders' GrpcException
uninitResponseHeaders
(State (ResponseHeaders' GrpcException) ()
-> ResponseHeaders' GrpcException)
-> ([Header] -> State (ResponseHeaders' GrpcException) ())
-> [Header]
-> ResponseHeaders' GrpcException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header -> State (ResponseHeaders' GrpcException) ())
-> [Header] -> State (ResponseHeaders' GrpcException) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Header -> State (ResponseHeaders' GrpcException) ()
parseHeader (Header -> State (ResponseHeaders' GrpcException) ())
-> (Header -> Header)
-> Header
-> State (ResponseHeaders' 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 (ResponseHeaders' GrpcException) ()
parseHeader :: Header -> State (ResponseHeaders' GrpcException) ()
parseHeader hdr :: Header
hdr@(HeaderName
name, ByteString
_value)
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"content-type"
= (ResponseHeaders' GrpcException -> ResponseHeaders' GrpcException)
-> State (ResponseHeaders' GrpcException) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ResponseHeaders' GrpcException -> ResponseHeaders' GrpcException)
-> State (ResponseHeaders' GrpcException) ())
-> (ResponseHeaders' GrpcException
-> ResponseHeaders' GrpcException)
-> State (ResponseHeaders' GrpcException) ()
forall a b. (a -> b) -> a -> b
$ \ResponseHeaders' GrpcException
x -> ResponseHeaders' GrpcException
x {
responseContentType = Just <$> parseContentType' proxy hdr
}
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"grpc-encoding"
= (ResponseHeaders' GrpcException -> ResponseHeaders' GrpcException)
-> State (ResponseHeaders' GrpcException) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ResponseHeaders' GrpcException -> ResponseHeaders' GrpcException)
-> State (ResponseHeaders' GrpcException) ())
-> (ResponseHeaders' GrpcException
-> ResponseHeaders' GrpcException)
-> State (ResponseHeaders' GrpcException) ()
forall a b. (a -> b) -> a -> b
$ \ResponseHeaders' GrpcException
x -> ResponseHeaders' GrpcException
x {
responseCompression = Just <$> parseMessageEncoding hdr
}
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"grpc-accept-encoding"
= (ResponseHeaders' GrpcException -> ResponseHeaders' GrpcException)
-> State (ResponseHeaders' GrpcException) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ResponseHeaders' GrpcException -> ResponseHeaders' GrpcException)
-> State (ResponseHeaders' GrpcException) ())
-> (ResponseHeaders' GrpcException
-> ResponseHeaders' GrpcException)
-> State (ResponseHeaders' GrpcException) ()
forall a b. (a -> b) -> a -> b
$ \ResponseHeaders' GrpcException
x -> ResponseHeaders' GrpcException
x {
responseAcceptCompression = Just <$> parseMessageAcceptEncoding hdr
}
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"trailer"
= () -> State (ResponseHeaders' GrpcException) ()
forall a. a -> StateT (ResponseHeaders' GrpcException) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise
= (ResponseHeaders' GrpcException -> ResponseHeaders' GrpcException)
-> State (ResponseHeaders' GrpcException) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ResponseHeaders' GrpcException -> ResponseHeaders' GrpcException)
-> State (ResponseHeaders' GrpcException) ())
-> (ResponseHeaders' GrpcException
-> ResponseHeaders' GrpcException)
-> State (ResponseHeaders' GrpcException) ()
forall a b. (a -> b) -> a -> b
$ \ResponseHeaders' 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 -> ResponseHeaders' GrpcException
x{
responseUnrecognized = Left $ mconcat [
invalid
, otherInvalid $ responseUnrecognized x
]
}
Right CustomMetadata
md -> ResponseHeaders' GrpcException
x{
responseMetadata =
customMetadataMapInsert md $ responseMetadata x
}
uninitResponseHeaders :: ResponseHeaders' GrpcException
uninitResponseHeaders :: ResponseHeaders' GrpcException
uninitResponseHeaders = ResponseHeaders {
responseCompression :: HKD (Checked (InvalidHeaders GrpcException)) (Maybe CompressionId)
responseCompression = 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
, responseAcceptCompression :: HKD
(Checked (InvalidHeaders GrpcException))
(Maybe (NonEmpty CompressionId))
responseAcceptCompression = 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
, responseMetadata :: CustomMetadataMap
responseMetadata = CustomMetadataMap
forall a. Monoid a => a
mempty
, responseUnrecognized :: HKD (Checked (InvalidHeaders GrpcException)) ()
responseUnrecognized = () -> Either (InvalidHeaders GrpcException) ()
forall a. a -> Either (InvalidHeaders GrpcException) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
, responseContentType :: HKD (Checked (InvalidHeaders GrpcException)) (Maybe ContentType)
responseContentType =
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
$
String
-> InvalidHeader HandledSynthesized -> InvalidHeaders GrpcException
invalidContentType
String
"Missing content-type header"
(Maybe Status -> HeaderName -> InvalidHeader HandledSynthesized
forall e. Maybe Status -> HeaderName -> InvalidHeader e
MissingHeader Maybe Status
forall a. Maybe a
Nothing HeaderName
"content-type")
}
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
(\String
err -> String
-> InvalidHeader HandledSynthesized -> InvalidHeaders GrpcException
invalidContentType String
err (Maybe Status
-> Header -> String -> InvalidHeader HandledSynthesized
forall e. Maybe Status -> Header -> String -> InvalidHeader e
InvalidHeader Maybe Status
forall a. Maybe a
Nothing Header
hdr String
err))
Header
hdr
invalidContentType ::
String
-> InvalidHeader HandledSynthesized
-> InvalidHeaders GrpcException
invalidContentType :: String
-> InvalidHeader HandledSynthesized -> InvalidHeaders GrpcException
invalidContentType String
err = GrpcException
-> InvalidHeader HandledSynthesized -> InvalidHeaders GrpcException
forall e. e -> InvalidHeader HandledSynthesized -> InvalidHeaders e
invalidHeaderSynthesize GrpcException {
grpcError :: GrpcError
grpcError = GrpcError
GrpcUnknown
, grpcErrorMessage :: Maybe Text
grpcErrorMessage = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
err
, grpcErrorDetails :: Maybe ByteString
grpcErrorDetails = Maybe ByteString
forall a. Maybe a
Nothing
, grpcErrorMetadata :: [CustomMetadata]
grpcErrorMetadata = []
}
buildTrailer :: forall rpc. SupportsServerRpc rpc => Proxy rpc -> HTTP.Header
buildTrailer :: forall {k} (rpc :: k). SupportsServerRpc rpc => Proxy rpc -> Header
buildTrailer Proxy rpc
_ = (
HeaderName
"Trailer"
, ByteString -> [ByteString] -> ByteString
BS.Strict.intercalate ByteString
", " [ByteString]
allPotentialTrailers
)
where
allPotentialTrailers :: [Strict.ByteString]
allPotentialTrailers :: [ByteString]
allPotentialTrailers = [[ByteString]] -> [ByteString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
[ByteString]
reservedTrailers
, (HeaderName -> ByteString) -> [HeaderName] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (HeaderName -> ByteString
forall s. CI s -> s
CI.original (HeaderName -> ByteString)
-> (HeaderName -> HeaderName) -> HeaderName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> HeaderName
buildHeaderName) ([HeaderName] -> [ByteString]) -> [HeaderName] -> [ByteString]
forall a b. (a -> b) -> a -> b
$
Proxy (ResponseTrailingMetadata rpc) -> [HeaderName]
forall a. StaticMetadata a => Proxy a -> [HeaderName]
metadataHeaderNames (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ResponseTrailingMetadata rpc))
]
reservedTrailers :: [Strict.ByteString]
reservedTrailers :: [ByteString]
reservedTrailers = [
ByteString
"grpc-status"
, ByteString
"grpc-message"
, ByteString
"grpc-retry-pushback-ms"
, ByteString
"endpoint-load-metrics-bin"
]
buildProperTrailers :: ProperTrailers -> [HTTP.Header]
buildProperTrailers :: ProperTrailers -> [Header]
buildProperTrailers ProperTrailers{
HKD Undecorated GrpcStatus
properTrailersGrpcStatus :: forall (f :: * -> *). ProperTrailers_ f -> HKD f GrpcStatus
properTrailersGrpcStatus :: HKD Undecorated GrpcStatus
properTrailersGrpcStatus
, HKD Undecorated (Maybe Text)
properTrailersGrpcMessage :: forall (f :: * -> *). ProperTrailers_ f -> HKD f (Maybe Text)
properTrailersGrpcMessage :: HKD Undecorated (Maybe Text)
properTrailersGrpcMessage
, HKD Undecorated (Maybe ByteString)
properTrailersStatusDetails :: HKD Undecorated (Maybe ByteString)
properTrailersStatusDetails :: forall (f :: * -> *). ProperTrailers_ f -> HKD f (Maybe ByteString)
properTrailersStatusDetails
, CustomMetadataMap
properTrailersMetadata :: CustomMetadataMap
properTrailersMetadata :: forall (f :: * -> *). ProperTrailers_ f -> CustomMetadataMap
properTrailersMetadata
, HKD Undecorated (Maybe Pushback)
properTrailersPushback :: HKD Undecorated (Maybe Pushback)
properTrailersPushback :: forall (f :: * -> *). ProperTrailers_ f -> HKD f (Maybe Pushback)
properTrailersPushback
, HKD Undecorated (Maybe OrcaLoadReport)
properTrailersOrcaLoadReport :: HKD Undecorated (Maybe OrcaLoadReport)
properTrailersOrcaLoadReport :: forall (f :: * -> *).
ProperTrailers_ f -> HKD f (Maybe OrcaLoadReport)
properTrailersOrcaLoadReport
} = [[Header]] -> [Header]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
[ ( HeaderName
"grpc-status"
, String -> ByteString
BS.Strict.C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Word -> String
forall a. Show a => a -> String
show (Word -> String) -> Word -> String
forall a b. (a -> b) -> a -> b
$ GrpcStatus -> Word
fromGrpcStatus HKD Undecorated GrpcStatus
GrpcStatus
properTrailersGrpcStatus
)
]
, [ (HeaderName
"grpc-message", Text -> ByteString
PercentEncoding.encode Text
x)
| Just Text
x <- [Maybe Text
HKD Undecorated (Maybe Text)
properTrailersGrpcMessage]
]
, [ (HeaderName
"grpc-status-details-bin", ByteString -> ByteString
buildBinaryValue ByteString
x)
| Just ByteString
x <- [Maybe ByteString
HKD Undecorated (Maybe ByteString)
properTrailersStatusDetails]
]
, [ ( HeaderName
"grpc-retry-pushback-ms"
, Pushback -> ByteString
buildPushback Pushback
x
)
| Just Pushback
x <- [Maybe Pushback
HKD Undecorated (Maybe Pushback)
properTrailersPushback]
]
, [ ( HeaderName
"endpoint-load-metrics-bin"
, ByteString -> ByteString
buildBinaryValue (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ OrcaLoadReport -> ByteString
forall msg. Message msg => msg -> ByteString
Protobuf.buildStrict OrcaLoadReport
x
)
| Just OrcaLoadReport
x <- [Maybe OrcaLoadReport
HKD Undecorated (Maybe OrcaLoadReport)
properTrailersOrcaLoadReport]
]
, [ CustomMetadata -> Header
buildCustomMetadata CustomMetadata
x
| CustomMetadata
x <- CustomMetadataMap -> [CustomMetadata]
customMetadataMapToList CustomMetadataMap
properTrailersMetadata
]
]
buildTrailersOnly ::
(ContentType -> Maybe BS.Strict.C8.ByteString)
-> TrailersOnly -> [HTTP.Header]
buildTrailersOnly :: (ContentType -> Maybe ByteString) -> TrailersOnly -> [Header]
buildTrailersOnly ContentType -> Maybe ByteString
f TrailersOnly{
HKD Undecorated (Maybe ContentType)
trailersOnlyContentType :: forall (f :: * -> *). TrailersOnly_ f -> HKD f (Maybe ContentType)
trailersOnlyContentType :: HKD Undecorated (Maybe ContentType)
trailersOnlyContentType
, ProperTrailers
trailersOnlyProper :: forall (f :: * -> *). TrailersOnly_ f -> ProperTrailers_ f
trailersOnlyProper :: ProperTrailers
trailersOnlyProper
} = [[Header]] -> [Header]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
[ Maybe ByteString -> Header
buildContentType (Maybe ByteString -> Header) -> Maybe ByteString -> Header
forall a b. (a -> b) -> a -> b
$ ContentType -> Maybe ByteString
f ContentType
x
| Just ContentType
x <- [Maybe ContentType
HKD Undecorated (Maybe ContentType)
trailersOnlyContentType]
]
, ProperTrailers -> [Header]
buildProperTrailers ProperTrailers
trailersOnlyProper
]
parseProperTrailers :: forall rpc m.
(IsRPC rpc, MonadError (InvalidHeaders GrpcException) m)
=> Proxy rpc -> [HTTP.Header] -> m ProperTrailers
parseProperTrailers :: forall {k} (rpc :: k) (m :: * -> *).
(IsRPC rpc, MonadError (InvalidHeaders GrpcException) m) =>
Proxy rpc -> [Header] -> m ProperTrailers
parseProperTrailers Proxy rpc
proxy = ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> m ProperTrailers
forall e (m :: * -> *) (t :: (* -> *) -> *).
(MonadError e m, Traversable t) =>
t (Checked e) -> m (t Undecorated)
HKD.sequenceChecked (ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> m ProperTrailers)
-> ([Header]
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> [Header]
-> m ProperTrailers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy rpc
-> [Header]
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException))
forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc
-> [Header]
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException))
parseProperTrailers' Proxy rpc
proxy
parseProperTrailers' :: forall rpc.
IsRPC rpc
=> Proxy rpc -> [HTTP.Header] -> ProperTrailers'
parseProperTrailers' :: forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc
-> [Header]
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException))
parseProperTrailers' Proxy rpc
proxy [Header]
hdrs =
case TrailersOnly' GrpcException
-> (ProperTrailers_ (Checked (InvalidHeaders GrpcException)),
HKD (Checked (InvalidHeaders GrpcException)) (Maybe ContentType))
forall (f :: * -> *).
TrailersOnly_ f -> (ProperTrailers_ f, HKD f (Maybe ContentType))
trailersOnlyToProperTrailers TrailersOnly' GrpcException
trailersOnly of
(ProperTrailers_ (Checked (InvalidHeaders GrpcException))
properTrailers, Right Maybe ContentType
Nothing) ->
ProperTrailers_ (Checked (InvalidHeaders GrpcException))
properTrailers
(ProperTrailers_ (Checked (InvalidHeaders GrpcException))
properTrailers, Right (Just ContentType
_ct)) ->
ProperTrailers_ (Checked (InvalidHeaders GrpcException))
properTrailers {
properTrailersUnrecognized = Left $ mconcat [
unexpectedHeader "content-type"
, otherInvalid $ properTrailersUnrecognized properTrailers
]
}
(ProperTrailers_ (Checked (InvalidHeaders GrpcException))
properTrailers, Left InvalidHeaders GrpcException
invalid) ->
case InvalidHeaders GrpcException -> InvalidHeaders HandledSynthesized
forall e. InvalidHeaders e -> InvalidHeaders HandledSynthesized
dropSynthesized InvalidHeaders GrpcException
invalid of
InvalidHeaders [MissingHeader{}] ->
ProperTrailers_ (Checked (InvalidHeaders GrpcException))
properTrailers
InvalidHeaders HandledSynthesized
_otherwise ->
ProperTrailers_ (Checked (InvalidHeaders GrpcException))
properTrailers {
properTrailersUnrecognized = Left $ mconcat [
unexpectedHeader "content-type"
, invalid
, otherInvalid $ properTrailersUnrecognized properTrailers
]
}
where
trailersOnly :: TrailersOnly' GrpcException
trailersOnly :: TrailersOnly' GrpcException
trailersOnly = Proxy rpc -> [Header] -> TrailersOnly' GrpcException
forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc -> [Header] -> TrailersOnly' GrpcException
parseTrailersOnly' Proxy rpc
proxy [Header]
hdrs
parseTrailersOnly :: forall m rpc.
(IsRPC rpc, MonadError (InvalidHeaders GrpcException) m)
=> Proxy rpc -> [HTTP.Header] -> m TrailersOnly
parseTrailersOnly :: forall {k} (m :: * -> *) (rpc :: k).
(IsRPC rpc, MonadError (InvalidHeaders GrpcException) m) =>
Proxy rpc -> [Header] -> m TrailersOnly
parseTrailersOnly Proxy rpc
proxy = TrailersOnly' GrpcException -> m TrailersOnly
forall e (m :: * -> *) (t :: (* -> *) -> *).
(MonadError e m, Traversable t) =>
t (Checked e) -> m (t Undecorated)
HKD.sequenceChecked (TrailersOnly' GrpcException -> m TrailersOnly)
-> ([Header] -> TrailersOnly' GrpcException)
-> [Header]
-> m TrailersOnly
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy rpc -> [Header] -> TrailersOnly' GrpcException
forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc -> [Header] -> TrailersOnly' GrpcException
parseTrailersOnly' Proxy rpc
proxy
parseTrailersOnly' :: forall rpc.
IsRPC rpc
=> Proxy rpc -> [HTTP.Header] -> TrailersOnly' GrpcException
parseTrailersOnly' :: forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc -> [Header] -> TrailersOnly' GrpcException
parseTrailersOnly' Proxy rpc
proxy =
(State (TrailersOnly' GrpcException) ()
-> TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> TrailersOnly' GrpcException
-> State (TrailersOnly' GrpcException) ()
-> TrailersOnly' GrpcException
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (TrailersOnly' GrpcException) ()
-> TrailersOnly' GrpcException -> TrailersOnly' GrpcException
forall s a. State s a -> s -> s
execState TrailersOnly' GrpcException
uninitTrailersOnly
(State (TrailersOnly' GrpcException) ()
-> TrailersOnly' GrpcException)
-> ([Header] -> State (TrailersOnly' GrpcException) ())
-> [Header]
-> TrailersOnly' GrpcException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header -> State (TrailersOnly' GrpcException) ())
-> [Header] -> State (TrailersOnly' GrpcException) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Header -> State (TrailersOnly' GrpcException) ()
parseHeader (Header -> State (TrailersOnly' GrpcException) ())
-> (Header -> Header)
-> Header
-> State (TrailersOnly' 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 (TrailersOnly' GrpcException) ()
parseHeader :: Header -> State (TrailersOnly' GrpcException) ()
parseHeader hdr :: Header
hdr@(HeaderName
name, ByteString
value)
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"content-type"
= (TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ())
-> (TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ()
forall a b. (a -> b) -> a -> b
$ \TrailersOnly' GrpcException
x -> TrailersOnly' GrpcException
x {
trailersOnlyContentType = Just <$> parseContentType' proxy hdr
}
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"grpc-status"
= (TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ())
-> (TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ()
forall a b. (a -> b) -> a -> b
$ (ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException -> TrailersOnly' GrpcException
forall (f :: * -> *).
(ProperTrailers_ f -> ProperTrailers_ f)
-> TrailersOnly_ f -> TrailersOnly_ f
liftProperTrailers ((ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> (ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException
-> TrailersOnly' GrpcException
forall a b. (a -> b) -> a -> b
$ \ProperTrailers_ (Checked (InvalidHeaders GrpcException))
x -> ProperTrailers_ (Checked (InvalidHeaders GrpcException))
x{
properTrailersGrpcStatus = throwInvalidHeader hdr $
case toGrpcStatus =<< readMaybe (BS.Strict.C8.unpack value) of
Maybe GrpcStatus
Nothing -> String -> Either String GrpcStatus
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Either String GrpcStatus)
-> String -> Either String GrpcStatus
forall a b. (a -> b) -> a -> b
$ String
"Invalid status: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
value
Just GrpcStatus
v -> GrpcStatus -> Either String GrpcStatus
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return GrpcStatus
v
}
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"grpc-message"
= (TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ())
-> (TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ()
forall a b. (a -> b) -> a -> b
$ (ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException -> TrailersOnly' GrpcException
forall (f :: * -> *).
(ProperTrailers_ f -> ProperTrailers_ f)
-> TrailersOnly_ f -> TrailersOnly_ f
liftProperTrailers ((ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> (ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException
-> TrailersOnly' GrpcException
forall a b. (a -> b) -> a -> b
$ \ProperTrailers_ (Checked (InvalidHeaders GrpcException))
x -> ProperTrailers_ (Checked (InvalidHeaders GrpcException))
x{
properTrailersGrpcMessage = throwInvalidHeader hdr $
case PercentEncoding.decode value of
Left DecodeException
err -> String -> Either String (Maybe Text)
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Either String (Maybe Text))
-> String -> Either String (Maybe Text)
forall a b. (a -> b) -> a -> b
$ DecodeException -> String
forall a. Show a => a -> String
show DecodeException
err
Right Text
msg -> Maybe Text -> Either String (Maybe Text)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
msg)
}
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"grpc-status-details-bin"
= (TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ())
-> (TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ()
forall a b. (a -> b) -> a -> b
$ (ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException -> TrailersOnly' GrpcException
forall (f :: * -> *).
(ProperTrailers_ f -> ProperTrailers_ f)
-> TrailersOnly_ f -> TrailersOnly_ f
liftProperTrailers ((ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> (ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException
-> TrailersOnly' GrpcException
forall a b. (a -> b) -> a -> b
$ \ProperTrailers_ (Checked (InvalidHeaders GrpcException))
x -> ProperTrailers_ (Checked (InvalidHeaders GrpcException))
x{
properTrailersStatusDetails = throwInvalidHeader hdr $
case parseBinaryValue value of
Left String
err -> String -> Either String (Maybe ByteString)
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
err
Right ByteString
val -> Maybe ByteString -> Either String (Maybe ByteString)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
val)
}
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"grpc-retry-pushback-ms"
= (TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ())
-> (TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ()
forall a b. (a -> b) -> a -> b
$ (ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException -> TrailersOnly' GrpcException
forall (f :: * -> *).
(ProperTrailers_ f -> ProperTrailers_ f)
-> TrailersOnly_ f -> TrailersOnly_ f
liftProperTrailers ((ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> (ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException
-> TrailersOnly' GrpcException
forall a b. (a -> b) -> a -> b
$ \ProperTrailers_ (Checked (InvalidHeaders GrpcException))
x -> ProperTrailers_ (Checked (InvalidHeaders GrpcException))
x{
properTrailersPushback =
Just <$> parsePushback value
}
| HeaderName
name HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderName
"endpoint-load-metrics-bin"
= (TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ())
-> (TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ()
forall a b. (a -> b) -> a -> b
$ (ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException -> TrailersOnly' GrpcException
forall (f :: * -> *).
(ProperTrailers_ f -> ProperTrailers_ f)
-> TrailersOnly_ f -> TrailersOnly_ f
liftProperTrailers ((ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> (ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException
-> TrailersOnly' GrpcException
forall a b. (a -> b) -> a -> b
$ \ProperTrailers_ (Checked (InvalidHeaders GrpcException))
x -> ProperTrailers_ (Checked (InvalidHeaders GrpcException))
x{
properTrailersOrcaLoadReport = throwInvalidHeader hdr $ do
value' <- parseBinaryValue value
case Protobuf.parseStrict value' of
Left String
err -> String -> Either String (Maybe OrcaLoadReport)
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
err
Right OrcaLoadReport
report -> Maybe OrcaLoadReport -> Either String (Maybe OrcaLoadReport)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe OrcaLoadReport -> Either String (Maybe OrcaLoadReport))
-> Maybe OrcaLoadReport -> Either String (Maybe OrcaLoadReport)
forall a b. (a -> b) -> a -> b
$ OrcaLoadReport -> Maybe OrcaLoadReport
forall a. a -> Maybe a
Just OrcaLoadReport
report
}
| Bool
otherwise
= (TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ())
-> (TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> State (TrailersOnly' GrpcException) ()
forall a b. (a -> b) -> a -> b
$ (ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException -> TrailersOnly' GrpcException
forall (f :: * -> *).
(ProperTrailers_ f -> ProperTrailers_ f)
-> TrailersOnly_ f -> TrailersOnly_ f
liftProperTrailers ((ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException -> TrailersOnly' GrpcException)
-> (ProperTrailers_ (Checked (InvalidHeaders GrpcException))
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException)))
-> TrailersOnly' GrpcException
-> TrailersOnly' GrpcException
forall a b. (a -> b) -> a -> b
$ \ProperTrailers_ (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 -> ProperTrailers_ (Checked (InvalidHeaders GrpcException))
x{
properTrailersUnrecognized = Left $ mconcat [
invalid
, otherInvalid $ properTrailersUnrecognized x
]
}
Right CustomMetadata
md -> ProperTrailers_ (Checked (InvalidHeaders GrpcException))
x{
properTrailersMetadata =
customMetadataMapInsert md $ properTrailersMetadata x
}
uninitTrailersOnly :: TrailersOnly' GrpcException
uninitTrailersOnly :: TrailersOnly' GrpcException
uninitTrailersOnly = TrailersOnly {
trailersOnlyContentType :: HKD (Checked (InvalidHeaders GrpcException)) (Maybe ContentType)
trailersOnlyContentType =
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
$
String
-> InvalidHeader HandledSynthesized -> InvalidHeaders GrpcException
invalidContentType
String
"Missing content-type header"
(Maybe Status -> HeaderName -> InvalidHeader HandledSynthesized
forall e. Maybe Status -> HeaderName -> InvalidHeader e
MissingHeader Maybe Status
forall a. Maybe a
Nothing HeaderName
"content-type")
, trailersOnlyProper :: ProperTrailers_ (Checked (InvalidHeaders GrpcException))
trailersOnlyProper =
HKD (Checked (InvalidHeaders GrpcException)) GrpcStatus
-> HKD (Checked (InvalidHeaders GrpcException)) (Maybe Text)
-> HKD (Checked (InvalidHeaders GrpcException)) (Maybe ByteString)
-> CustomMetadataMap
-> ProperTrailers_ (Checked (InvalidHeaders GrpcException))
forall (f :: * -> *).
ValidDecoration Applicative f =>
HKD f GrpcStatus
-> HKD f (Maybe Text)
-> HKD f (Maybe ByteString)
-> CustomMetadataMap
-> ProperTrailers_ f
simpleProperTrailers
(InvalidHeaders GrpcException
-> Either (InvalidHeaders GrpcException) GrpcStatus
forall a.
InvalidHeaders GrpcException
-> Either (InvalidHeaders GrpcException) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (InvalidHeaders GrpcException
-> Either (InvalidHeaders GrpcException) GrpcStatus)
-> InvalidHeaders GrpcException
-> Either (InvalidHeaders GrpcException) GrpcStatus
forall a b. (a -> b) -> a -> b
$ Maybe Status -> HeaderName -> InvalidHeaders GrpcException
forall e. Maybe Status -> HeaderName -> InvalidHeaders e
missingHeader Maybe Status
forall a. Maybe a
Nothing HeaderName
"grpc-status")
(Maybe Text -> Either (InvalidHeaders GrpcException) (Maybe Text)
forall a. a -> Either (InvalidHeaders GrpcException) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing)
(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)
CustomMetadataMap
forall a. Monoid a => a
mempty
}
liftProperTrailers ::
(ProperTrailers_ f -> ProperTrailers_ f)
-> TrailersOnly_ f -> TrailersOnly_ f
liftProperTrailers :: forall (f :: * -> *).
(ProperTrailers_ f -> ProperTrailers_ f)
-> TrailersOnly_ f -> TrailersOnly_ f
liftProperTrailers ProperTrailers_ f -> ProperTrailers_ f
f TrailersOnly_ f
trailersOnly = TrailersOnly_ f
trailersOnly{
trailersOnlyProper = f (trailersOnlyProper trailersOnly)
}
buildPushback :: Pushback -> Strict.ByteString
buildPushback :: Pushback -> ByteString
buildPushback (RetryAfter Word
n) = String -> ByteString
BS.Strict.C8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Word -> String
forall a. Show a => a -> String
show Word
n
buildPushback Pushback
DoNotRetry = ByteString
"-1"
parsePushback :: Monad m => Strict.ByteString -> m Pushback
parsePushback :: forall (m :: * -> *). Monad m => ByteString -> m Pushback
parsePushback ByteString
bs =
case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (ByteString -> String
BS.Strict.C8.unpack ByteString
bs) of
Just (Int
n :: Int) ->
Pushback -> m Pushback
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pushback -> m Pushback) -> Pushback -> m Pushback
forall a b. (a -> b) -> a -> b
$ if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Pushback
DoNotRetry else Word -> Pushback
RetryAfter (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
Maybe Int
Nothing ->
Pushback -> m Pushback
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pushback
DoNotRetry
otherInvalid :: Either (InvalidHeaders e) () -> InvalidHeaders e
otherInvalid :: forall e. Either (InvalidHeaders e) () -> InvalidHeaders e
otherInvalid = (InvalidHeaders e -> InvalidHeaders e)
-> (() -> InvalidHeaders e)
-> Either (InvalidHeaders e) ()
-> InvalidHeaders e
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either InvalidHeaders e -> InvalidHeaders e
forall a. a -> a
id (\() -> InvalidHeaders e
forall a. Monoid a => a
mempty)
decodeUtf8Lenient :: BS.Strict.C8.ByteString -> Text
#if MIN_VERSION_text(2,0,0)
decodeUtf8Lenient :: ByteString -> Text
decodeUtf8Lenient = ByteString -> Text
Text.decodeUtf8Lenient
#else
decodeUtf8Lenient = Text.decodeUtf8With Text.lenientDecode
#endif