{-# LANGUAGE OverloadedStrings #-}

module Network.GRPC.Spec.Serialization.Headers.Request (
    buildRequestHeaders
    --
    -- Throws an error if any headers fail to parse; if this is not desired, see
    -- 'parseRequestHeaders'' instead.
  , parseRequestHeaders
  --
  -- Throws an error if any headers fail to parse; if this is not desired, see
  -- 'parseRequestHeaders'' instead.
  , 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

{-------------------------------------------------------------------------------
  Construction
-------------------------------------------------------------------------------}

-- | Request headers
--
-- > Request-Headers →
-- >   Call-Definition
-- >   *Custom-Metadata
buildRequestHeaders ::
     IsRPC rpc
  => Proxy rpc -> RequestHeaders -> [HTTP.Header]
buildRequestHeaders :: forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc -> RequestHeaders -> [Header]
buildRequestHeaders 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
    ]

-- | Call definition
--
-- > Call-Definition →
-- >   Method
-- >   Scheme
-- >   Path
-- >   TE
-- >   [Authority]
-- >   [Timeout]
-- >   Content-Type
-- >   [Message-Type]
-- >   [Message-Encoding]
-- >   [Message-Accept-Encoding]
-- >   [User-Agent]
--
-- However, the spec additionally mandates that
--
--   HTTP2 requires that reserved headers, ones starting with ":" appear
--   before all other headers. Additionally implementations should send
--   Timeout immediately after the reserved headers and they should send the
--   Call-Definition headers before sending Custom-Metadata.
--
-- (Relevant part of the HTTP2 spec:
-- <https://www.rfc-editor.org/rfc/rfc7540#section-8.1.2.1>.) This means
-- @TE@ should come /after/ @Authority@ (if using). However, we will not include
-- the reserved headers here /at all/, as they are automatically added by
-- @http2@.
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)

    -- > TE → "te" "trailers" # Used to detect incompatible proxies
    buildTe :: HTTP.Header
    buildTe :: Header
buildTe  = (HeaderName
"te", ByteString
"trailers")

    -- > User-Agent → "user-agent" {structured user-agent string}
    --
    -- The spec says:
    --
    --   While the protocol does not require a user-agent to function it is
    --   recommended that clients provide a structured user-agent string that
    --   provides a basic description of the calling library, version & platform
    --   to facilitate issue diagnosis in heterogeneous environments. The
    --   following structure is recommended to library developers
    --
    -- > User-Agent →
    -- >   "grpc-"
    -- >   Language
    -- >   ?("-" Variant)
    -- >   "/"
    -- >   Version
    -- >   ?( " ("  *(AdditionalProperty ";") ")" )
    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
        )

{-------------------------------------------------------------------------------
  Parsing
-------------------------------------------------------------------------------}

-- | Parse t'RequestHeaders'
--
-- Throws an error if any headers fail to parse; if this is not desired, see
-- 'parseRequestHeaders'' instead.
parseRequestHeaders :: forall rpc m.
     (IsRPC rpc, MonadError (InvalidHeaders GrpcException) m)
  => Proxy rpc
  -> [HTTP.Header] -> m RequestHeaders
parseRequestHeaders :: forall {k} (rpc :: k) (m :: * -> *).
(IsRPC rpc, MonadError (InvalidHeaders GrpcException) m) =>
Proxy rpc -> [Header] -> m RequestHeaders
parseRequestHeaders 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

-- | Parse request headers
--
-- This can report invalid headers on a per-header basis; see also
-- 'parseRequestHeaders'.
parseRequestHeaders' :: forall rpc.
     IsRPC rpc
  => Proxy rpc
  -> [HTTP.Header] -> RequestHeaders' GrpcException
parseRequestHeaders' :: forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc
-> [Header]
-> RequestHeaders_ (Checked (InvalidHeaders GrpcException))
parseRequestHeaders' 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 ()

        -- Special cases

        , 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 =
            -- If the default is that this header should be absent, then /start/
            -- with 'MessageTypeDefault'; if it happens to present, parse it as
            -- an override.
            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

{-------------------------------------------------------------------------------
  Content type

  See 'parseContentType' for discussion.
-------------------------------------------------------------------------------}

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

{-------------------------------------------------------------------------------
  Internal auxiliary
-------------------------------------------------------------------------------}

expectHeaderValue ::
     MonadError (InvalidHeaders GrpcException) m
  => HTTP.Header -> [Strict.ByteString] -> m ()
expectHeaderValue :: forall (m :: * -> *).
MonadError (InvalidHeaders GrpcException) m =>
Header -> [ByteString] -> m ()
expectHeaderValue 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
"."
        ]