Generate the HTTP Trailer header

Closes #59.

src/Network/GRPC/Spec/CustomMetadata/Raw.hs

@@ -14,8 +14,12 @@ module Network.GRPC.Spec.CustomMetadata.Raw (
   , HeaderName(BinaryHeader, AsciiHeader)
   , safeHeaderName
     -- * Serialization
+  , buildHeaderName
+  , buildAsciiValue
   , buildBinaryValue
   , buildCustomMetadata
+  , parseHeaderName
+  , parseAsciiValue
   , parseBinaryValue
   , parseCustomMetadata
   ) where
@@ -24,6 +28,7 @@ import Control.Monad
 import Control.Monad.Except (MonadError(throwError))
 import Data.ByteString qualified as BS.Strict
 import Data.ByteString qualified as Strict (ByteString)
+import Data.CaseInsensitive (CI)
 import Data.CaseInsensitive qualified as CI
 import Data.List (intersperse)
 import Data.List qualified as List
@@ -218,6 +223,7 @@ safeHeaderName bs = do
           "user-agent"
         , "content-type"
         , "te"
+        , "trailer"
         ]
 
 instance IsString HeaderName where
@@ -240,6 +246,29 @@ instance Show HeaderName where
   Serialization
 -------------------------------------------------------------------------------}
 
+buildHeaderName :: HeaderName -> CI Strict.ByteString
+buildHeaderName name =
+    case name of
+      UnsafeBinaryHeader name' -> CI.mk name'
+      UnsafeAsciiHeader  name' -> CI.mk name'
+
+parseHeaderName :: MonadError String m => CI Strict.ByteString -> m HeaderName
+parseHeaderName name =
+    case safeHeaderName (CI.foldedCase name) of
+      Nothing    -> throwError $ "Invalid header name: " ++ show name
+      Just name' -> return name'
+
+buildAsciiValue :: Strict.ByteString -> Strict.ByteString
+buildAsciiValue = id
+
+parseAsciiValue ::
+     MonadError String m
+  => Strict.ByteString -> m Strict.ByteString
+parseAsciiValue bs = do
+    unless (isValidAsciiValue bs) $
+      throwError $ "Invalid ASCII header: " ++ show bs
+    return bs
+
 buildBinaryValue :: Strict.ByteString -> Strict.ByteString
 buildBinaryValue = encodeBase64
 
@@ -292,27 +321,17 @@ parseBinaryValue bs = do
 buildCustomMetadata :: CustomMetadata -> HTTP.Header
 buildCustomMetadata (CustomMetadata name value) =
     case name of
-      UnsafeBinaryHeader name' -> (CI.mk name', buildBinaryValue value)
-      UnsafeAsciiHeader  name' -> (CI.mk name', value)
+      UnsafeBinaryHeader _ -> (buildHeaderName name, buildBinaryValue value)
+      UnsafeAsciiHeader  _ -> (buildHeaderName name, buildAsciiValue  value)
 
 parseCustomMetadata :: MonadError String m => HTTP.Header -> m CustomMetadata
-parseCustomMetadata (name, value) =
-    case safeHeaderName (CI.foldedCase name) of
-      Nothing    -> throwError $ "Invalid header name: " ++ show (name, value)
-      Just name' -> do
-        mMetadata <-
-          case name' of
-            UnsafeAsciiHeader _ ->
-              return $ safeCustomMetadata name' value
-            UnsafeBinaryHeader _ -> do
-              case parseBinaryValue value of
-                Right value' ->
-                  return $ safeCustomMetadata name' value'
-                Left err ->
-                  throwError $ "Cannot decode binary header: " ++ err
-        case mMetadata of
-          Nothing -> throwError $ "Invalid header value: " ++ show (name, value)
-          Just md -> return md
+parseCustomMetadata (name, value) = do
+    name'     <- parseHeaderName name
+    value'    <- case name' of
+                   UnsafeAsciiHeader  _ -> parseAsciiValue  value
+                   UnsafeBinaryHeader _ -> parseBinaryValue value
+    -- If parsing succeeds, that justifies the use of 'UnsafeCustomMetadata'
+    return $ UnsafeCustomMetadata name' value'
 
 {-------------------------------------------------------------------------------
   Internal auxiliary

src/Network/GRPC/Spec/Request.hs

@@ -86,6 +86,12 @@ data RequestHeaders_ f = RequestHeaders {
 
       -- | Should we include the @te: trailers@ header?
       --
+      -- The @TE@ header is part of the HTTP specification;
+      -- see also <https://datatracker.ietf.org/doc/html/rfc7230#section-4.3>.
+      -- It indicates that we are willing to accept a chunked encoding for the
+      -- response body, and that we expect trailers to be present after the
+      -- response body.
+      --
       -- To be conform to the gRPC spec, the @te@ header should be included, but
       -- @grapesy@ does not insist that the header is present for incoming
       -- requests. However, /if/ it is present, we /do/ verify that it has the
@@ -161,7 +167,7 @@ buildRequestHeaders proxy callParams@RequestHeaders{requestMetadata} = concat [
 -- @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 ::
+callDefinition :: forall rpc.
      (IsRPC rpc, HasCallStack)
   => Proxy rpc -> RequestHeaders -> [HTTP.Header]
 callDefinition proxy = \hdrs -> catMaybes [

src/Network/GRPC/Spec/Response.hs

@@ -37,8 +37,10 @@ module Network.GRPC.Spec.Response (
 import Control.Exception
 import Control.Monad.Except
 import Control.Monad.State
-import Data.ByteString qualified as Strict
+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.CaseInsensitive qualified as CI
 import Data.List.NonEmpty (NonEmpty)
 import Data.Proxy
 import Data.Text (Text)
@@ -55,6 +57,7 @@ import Network.GRPC.Spec.RPC
 import Network.GRPC.Spec.Status
 import Network.GRPC.Util.HKD (HKD, Undecorated, DecoratedWith)
 import Network.GRPC.Util.HKD qualified as HKD
+import Network.GRPC.Spec.CustomMetadata.Typed
 
 {-------------------------------------------------------------------------------
   Outputs (messages received from the peer)
@@ -300,8 +303,8 @@ grpcExceptionToTrailers GrpcException{
 -------------------------------------------------------------------------------}
 
 -- | Build response headers
-buildResponseHeaders ::
-     IsRPC rpc
+buildResponseHeaders :: forall rpc.
+     SupportsServerRpc rpc
   => Proxy rpc -> ResponseHeaders -> [HTTP.Header]
 buildResponseHeaders proxy
              ResponseHeaders{ responseCompression
@@ -318,11 +321,41 @@ buildResponseHeaders proxy
     , [ buildMessageAcceptEncoding x
       | Just x <- [responseAcceptCompression]
       ]
+    , [ buildTrailer proxy ]
     , [ buildCustomMetadata x
       | x <- customMetadataMapToList responseMetadata
       ]
     ]
 
+-- | Construct the HTTP 'Trailer' header
+--
+-- This lists all headers that /might/ be present in the trailers.
+--
+-- See
+--
+-- * <https://datatracker.ietf.org/doc/html/rfc7230#section-4.4>
+-- * <https://www.rfc-editor.org/rfc/rfc9110#name-processing-trailer-fields>
+buildTrailer :: forall rpc. SupportsServerRpc rpc => Proxy rpc -> HTTP.Header
+buildTrailer _ = (
+      "Trailer"
+    , BS.Strict.intercalate ", " allPotentialTrailers
+    )
+  where
+    allPotentialTrailers :: [Strict.ByteString]
+    allPotentialTrailers = concat [
+          reservedTrailers
+        , map (CI.original . buildHeaderName) $
+            metadataHeaderNames (Proxy @(ResponseTrailingMetadata rpc))
+        ]
+
+    -- These cannot be 'HeaderName' (which disallow reserved names)
+    reservedTrailers :: [Strict.ByteString]
+    reservedTrailers = [
+          "grpc-status"
+        , "grpc-message"
+        , "grpc-retry-pushback-ms"
+        ]
+
 -- | Parse response headers
 parseResponseHeaders :: forall rpc m.
      (IsRPC rpc, MonadError String m)
@@ -351,6 +384,9 @@ parseResponseHeaders proxy =
             responseAcceptCompression = Just <$> parseMessageAcceptEncoding hdr
           }
 
+      | name == "trailer"
+      = return () -- ignore the HTTP trailer header
+
       | otherwise
       = modify $ \x -> x {
             responseMetadata = do
@@ -371,6 +407,9 @@ parseResponseHeaders proxy =
 -------------------------------------------------------------------------------}
 
 -- | Build trailers (see 'buildTrailersOnly' for the Trailers-Only case)
+--
+-- NOTE: If we add additional (reserved) headers here, we also need to add them
+-- to 'buildTrailer'.
 buildProperTrailers :: ProperTrailers -> [HTTP.Header]
 buildProperTrailers ProperTrailers{
                         properTrailersGrpcStatus