diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ # Revision history for grpc-spec +## 1.1.0 -- 2026-09-02 + +* Trivial `BuildMetadata` and `ParseMetadata` instances for `[CustomMetadata]` +* New field `responseTrailerNames` of `ResponseHeaders`, with the infrastructure + around parsing and building response headers changed accordingly +* `SupportsServerRpc` no longer depends on `StaticMetadata` + ## 1.0.0 -- 2025-01-22 * First released version. diff --git a/grpc-spec.cabal b/grpc-spec.cabal --- a/grpc-spec.cabal +++ b/grpc-spec.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: grpc-spec -version: 1.0.0 +version: 1.1.0 synopsis: Implementation of the pure part of the gRPC spec description: This is an implementation of the pure part of the core gRPC spec at . @@ -17,9 +17,11 @@ tested-with: GHC==8.10.7 , GHC==9.2.8 , GHC==9.4.8 - , GHC==9.6.6 - , GHC==9.8.2 - , GHC==9.10.1 + , GHC==9.6.7 + , GHC==9.8.4 + , GHC==9.10.3 + , GHC==9.12.4 + , GHC==9.14.1 source-repository head type: git @@ -34,7 +36,7 @@ -Widentities -Wmissing-export-lists build-depends: - base >= 4.14 && < 4.22 + base >= 4.14 && < 4.23 default-language: Haskell2010 default-extensions: @@ -126,13 +128,13 @@ Proto.OrcaLoadReport Proto.Status build-depends: - , aeson >= 1.5 && < 2.3 + , aeson >= 1.5 && < 2.4 , base16-bytestring >= 1.0 && < 1.1 , base64-bytestring >= 1.2 && < 1.3 , binary >= 0.8 && < 0.9 , bytestring >= 0.10.12 && < 0.13 , case-insensitive >= 1.2 && < 1.3 - , containers >= 0.6 && < 0.8 + , containers >= 0.6 && < 0.9 , data-default >= 0.7 && < 0.9 , deepseq >= 1.4 && < 1.6 , exceptions >= 0.10 && < 0.11 @@ -196,11 +198,11 @@ -- Additional dependencies , prettyprinter >= 1.7 && < 1.8 , prettyprinter-ansi-terminal >= 1.1 && < 1.2 - , QuickCheck >= 2.14 && < 2.16 - , quickcheck-instances >= 0.3 && < 0.4 + , QuickCheck >= 2.14 && < 2.19 + , quickcheck-instances >= 0.3 && < 0.5 , tasty >= 1.4 && < 1.6 , tasty-quickcheck >= 0.10 && < 0.12 - , tree-diff >= 0.3 && < 0.4 + , tree-diff >= 0.3 && < 0.5 Flag snappy description: Enable snappy compression capabilities diff --git a/src/Network/GRPC/Spec.hs b/src/Network/GRPC/Spec.hs --- a/src/Network/GRPC/Spec.hs +++ b/src/Network/GRPC/Spec.hs @@ -119,6 +119,7 @@ , customMetadataValue , safeCustomMetadata , HeaderName(BinaryHeader, AsciiHeader) + , getHeaderName , safeHeaderName , isValidAsciiValue , NoMetadata(..) diff --git a/src/Network/GRPC/Spec/CustomMetadata/Raw.hs b/src/Network/GRPC/Spec/CustomMetadata/Raw.hs --- a/src/Network/GRPC/Spec/CustomMetadata/Raw.hs +++ b/src/Network/GRPC/Spec/CustomMetadata/Raw.hs @@ -12,6 +12,7 @@ , customMetadataValue , safeCustomMetadata , HeaderName(BinaryHeader, AsciiHeader) + , getHeaderName , safeHeaderName , isValidAsciiValue ) where @@ -152,7 +153,8 @@ -- suffix to detect binary headers and properly apply base64 encoding & -- decoding as headers are sent and received). -- - -- Since this is binary data, padding considerations do not apply. + -- Since this kind of header contains binary data, padding considerations do + -- not apply. UnsafeBinaryHeader Strict.ByteString -- | ASCII header @@ -167,6 +169,12 @@ | UnsafeAsciiHeader Strict.ByteString deriving stock (Eq, Ord, Generic) deriving anyclass (NFData) + +-- | The flattened header name (including any @-bin@ suffix) +getHeaderName :: HeaderName -> Strict.ByteString +getHeaderName = \case + UnsafeBinaryHeader name -> name + UnsafeAsciiHeader name -> name pattern BinaryHeader :: HasCallStack => Strict.ByteString -> HeaderName pattern BinaryHeader name <- UnsafeBinaryHeader name diff --git a/src/Network/GRPC/Spec/CustomMetadata/Typed.hs b/src/Network/GRPC/Spec/CustomMetadata/Typed.hs --- a/src/Network/GRPC/Spec/CustomMetadata/Typed.hs +++ b/src/Network/GRPC/Spec/CustomMetadata/Typed.hs @@ -84,6 +84,9 @@ class BuildMetadata a where buildMetadata :: a -> [CustomMetadata] +instance BuildMetadata [CustomMetadata] where + buildMetadata = id + -- | Wrapper around 'buildMetadata' that catches any pure exceptions -- -- These pure exceptions can arise when invalid headers are generated (for @@ -122,6 +125,9 @@ -- throwing an error runs the risk of unnecessarily aborting an RPC. class ParseMetadata a where parseMetadata :: MonadThrow m => [CustomMetadata] -> m a + +instance ParseMetadata [CustomMetadata] where + parseMetadata = pure -- | Unexpected metadata -- diff --git a/src/Network/GRPC/Spec/Headers/PseudoHeaders.hs b/src/Network/GRPC/Spec/Headers/PseudoHeaders.hs --- a/src/Network/GRPC/Spec/Headers/PseudoHeaders.hs +++ b/src/Network/GRPC/Spec/Headers/PseudoHeaders.hs @@ -94,7 +94,7 @@ -- port number, and many servers can accept this, this will /not/ work -- with TLS, and it is therefore recommended not to include a port number. -- Note that the HTTP2 spec explicitly /disallows/ the authority to - -- include @userinfo@@. + -- include @userinfo@. , addressAuthority :: Maybe String } deriving stock (Show) diff --git a/src/Network/GRPC/Spec/Headers/Response.hs b/src/Network/GRPC/Spec/Headers/Response.hs --- a/src/Network/GRPC/Spec/Headers/Response.hs +++ b/src/Network/GRPC/Spec/Headers/Response.hs @@ -33,6 +33,7 @@ import Data.Proxy import Data.Text (Text) import GHC.Generics (Generic) +import Network.HTTP.Types qualified as HTTP import Network.GRPC.Spec.Compression (CompressionId) import Network.GRPC.Spec.CustomMetadata.Map @@ -61,6 +62,14 @@ -- Set to 'Nothing' to omit the content-type header altogether. , responseContentType :: HKD f (Maybe ContentType) + -- | Response trailers + -- + -- The initial response headers should announce which trailers can be + -- expected after the response body. + -- + -- See + , responseTrailerNames :: HKD f (Maybe [HTTP.HeaderName]) + -- | Initial response metadata -- -- The response can include additional metadata in the trailers; see @@ -96,6 +105,7 @@ <$> (f $ responseCompression x) <*> (f $ responseAcceptCompression x) <*> (f $ responseContentType x) + <*> (f $ responseTrailerNames x) <*> (pure $ responseMetadata x) <*> (f $ responseUnrecognized x) diff --git a/src/Network/GRPC/Spec/RPC.hs b/src/Network/GRPC/Spec/RPC.hs --- a/src/Network/GRPC/Spec/RPC.hs +++ b/src/Network/GRPC/Spec/RPC.hs @@ -132,9 +132,9 @@ class ( IsRPC rpc -- Serialization - , ParseMetadata (RequestMetadata rpc) - , BuildMetadata (ResponseInitialMetadata rpc) - , StaticMetadata (ResponseTrailingMetadata rpc) + , ParseMetadata (RequestMetadata rpc) + , BuildMetadata (ResponseInitialMetadata rpc) + , BuildMetadata (ResponseTrailingMetadata rpc) ) => SupportsServerRpc rpc where -- | Deserialize RPC input diff --git a/src/Network/GRPC/Spec/RPC/JSON.hs b/src/Network/GRPC/Spec/RPC/JSON.hs --- a/src/Network/GRPC/Spec/RPC/JSON.hs +++ b/src/Network/GRPC/Spec/RPC/JSON.hs @@ -99,9 +99,9 @@ , ToJSON (Output (JsonRpc serv meth)) -- Metadata constraints - , ParseMetadata (RequestMetadata (JsonRpc serv meth)) - , BuildMetadata (ResponseInitialMetadata (JsonRpc serv meth)) - , StaticMetadata (ResponseTrailingMetadata (JsonRpc serv meth)) + , ParseMetadata (RequestMetadata (JsonRpc serv meth)) + , BuildMetadata (ResponseInitialMetadata (JsonRpc serv meth)) + , BuildMetadata (ResponseTrailingMetadata (JsonRpc serv meth)) ) => SupportsServerRpc (JsonRpc serv meth) where rpcDeserializeInput _ = Aeson.eitherDecode rpcSerializeOutput _ = Aeson.encode diff --git a/src/Network/GRPC/Spec/RPC/Protobuf.hs b/src/Network/GRPC/Spec/RPC/Protobuf.hs --- a/src/Network/GRPC/Spec/RPC/Protobuf.hs +++ b/src/Network/GRPC/Spec/RPC/Protobuf.hs @@ -92,9 +92,9 @@ , HasMethodImpl serv meth -- Metadata constraints - , ParseMetadata (RequestMetadata (Protobuf serv meth)) - , BuildMetadata (ResponseInitialMetadata (Protobuf serv meth)) - , StaticMetadata (ResponseTrailingMetadata (Protobuf serv meth)) + , ParseMetadata (RequestMetadata (Protobuf serv meth)) + , BuildMetadata (ResponseInitialMetadata (Protobuf serv meth)) + , BuildMetadata (ResponseTrailingMetadata (Protobuf serv meth)) ) => SupportsServerRpc (Protobuf serv meth) where rpcDeserializeInput _ = Protobuf.parseLazy rpcSerializeOutput _ = Protobuf.buildLazy diff --git a/src/Network/GRPC/Spec/RPC/Raw.hs b/src/Network/GRPC/Spec/RPC/Raw.hs --- a/src/Network/GRPC/Spec/RPC/Raw.hs +++ b/src/Network/GRPC/Spec/RPC/Raw.hs @@ -52,9 +52,9 @@ instance ( IsRPC (RawRpc serv meth) -- Metadata constraints - , ParseMetadata (RequestMetadata (RawRpc serv meth)) - , BuildMetadata (ResponseInitialMetadata (RawRpc serv meth)) - , StaticMetadata (ResponseTrailingMetadata (RawRpc serv meth)) + , ParseMetadata (RequestMetadata (RawRpc serv meth)) + , BuildMetadata (ResponseInitialMetadata (RawRpc serv meth)) + , BuildMetadata (ResponseTrailingMetadata (RawRpc serv meth)) ) => SupportsServerRpc (RawRpc serv meth) where rpcDeserializeInput _ = return rpcSerializeOutput _ = id diff --git a/src/Network/GRPC/Spec/Serialization.hs b/src/Network/GRPC/Spec/Serialization.hs --- a/src/Network/GRPC/Spec/Serialization.hs +++ b/src/Network/GRPC/Spec/Serialization.hs @@ -33,6 +33,10 @@ , buildResponseHeaders , parseResponseHeaders , parseResponseHeaders' + -- * HTTP @Trailer@ header + , buildTrailer + , parseTrailer + , allPotentialTrailers -- *** Pushback , buildPushback , parsePushback @@ -49,6 +53,9 @@ -- ** Custom metadata , parseCustomMetadata , buildCustomMetadata + -- *** Header names + , buildHeaderName + , parseHeaderName -- *** Binary values , buildBinaryValue , parseBinaryValue diff --git a/src/Network/GRPC/Spec/Serialization/Headers/Response.hs b/src/Network/GRPC/Spec/Serialization/Headers/Response.hs --- a/src/Network/GRPC/Spec/Serialization/Headers/Response.hs +++ b/src/Network/GRPC/Spec/Serialization/Headers/Response.hs @@ -9,6 +9,10 @@ buildResponseHeaders , parseResponseHeaders , parseResponseHeaders' + -- * HTTP @Trailer@ header + , buildTrailer + , parseTrailer + , allPotentialTrailers -- * ProperTrailers , buildProperTrailers , parseProperTrailers @@ -193,12 +197,7 @@ buildResponseHeaders :: forall rpc. SupportsServerRpc rpc => Proxy rpc -> ResponseHeaders -> [HTTP.Header] -buildResponseHeaders proxy - ResponseHeaders{ responseCompression - , responseAcceptCompression - , responseMetadata - , responseContentType - } = concat [ +buildResponseHeaders proxy headers = concat [ [ buildContentType $ Just (chooseContentType proxy x) | Just x <- [responseContentType] ] @@ -208,11 +207,21 @@ , [ buildMessageAcceptEncoding x | Just x <- [responseAcceptCompression] ] - , [ buildTrailer proxy ] + , [ buildTrailer x + | Just x <- [responseTrailerNames] + ] , [ buildCustomMetadata x | x <- customMetadataMapToList responseMetadata ] ] + where + ResponseHeaders{ + responseCompression + , responseAcceptCompression + , responseTrailerNames + , responseMetadata + , responseContentType + } = headers -- | Parse response headers parseResponseHeaders :: forall rpc m. @@ -251,7 +260,9 @@ } | name == "trailer" - = return () -- ignore the HTTP trailer header + = modify $ \x -> x { + responseTrailerNames = pure $ Just $ parseTrailer hdr + } | otherwise = modify $ \x -> @@ -271,6 +282,7 @@ uninitResponseHeaders = ResponseHeaders { responseCompression = return Nothing , responseAcceptCompression = return Nothing + , responseTrailerNames = return Nothing , responseMetadata = mempty , responseUnrecognized = return () @@ -312,16 +324,18 @@ } {------------------------------------------------------------------------------- - > Trailers → Status [Status-Message] *Custom-Metadata Status → - > "grpc-status" 1*DIGIT ; 0-9 Status-Message → "grpc-message" Percent-Encoded - > Status-Details → "grpc-status-details-bin" {base64 encoded value} + HTTP @Trailer@ header + See + + > Trailer = #field-name + where - > Status-Details is allowed only if Status is not OK. If it is set, it - > contains additional information about the RPC error. If it contains a status - > code field, it MUST NOT contradict the Status header. The consumer MUST - > verify this requirement. + > A construct "#" is defined, similar to "*", for defining comma-delimited + > lists of elements. The full form is "#element" indicating at least + > and at most elements, each separated by a single comma (",") and + > optional whitespace -------------------------------------------------------------------------------} -- | Construct the HTTP @Trailer@ header @@ -332,30 +346,48 @@ -- -- * -- * -buildTrailer :: forall rpc. SupportsServerRpc rpc => Proxy rpc -> HTTP.Header -buildTrailer _ = ( +buildTrailer :: [HTTP.HeaderName] -> HTTP.Header +buildTrailer trailerNames = ( "Trailer" - , BS.Strict.intercalate ", " allPotentialTrailers + , BS.Strict.intercalate ", " $ map CI.original trailerNames ) - where - allPotentialTrailers :: [Strict.ByteString] - allPotentialTrailers = concat [ - reservedTrailers - , map (CI.original . buildHeaderName) $ - metadataHeaderNames (Proxy @(ResponseTrailingMetadata rpc)) - ] +parseTrailer :: HTTP.Header -> [HTTP.HeaderName] +parseTrailer (_name, val) = map (CI.mk . trim) $ BS.Strict.C8.split ',' val + +-- | All potential trailers +allPotentialTrailers :: + [HeaderName] -- ^ Additional user-defined trailers, if any + -> [HTTP.HeaderName] +allPotentialTrailers additional = concat [ + reservedTrailers + , map buildHeaderName additional + ] + where -- These cannot be 'HeaderName' (which disallow reserved names) -- -- This list must match the names used by 'buildProperTrailers' -- and recognized by 'parseProperTrailers'. - reservedTrailers :: [Strict.ByteString] + reservedTrailers :: [HTTP.HeaderName] reservedTrailers = [ "grpc-status" , "grpc-message" , "grpc-retry-pushback-ms" , "endpoint-load-metrics-bin" ] + +{------------------------------------------------------------------------------- + > Trailers → Status [Status-Message] *Custom-Metadata Status → + > "grpc-status" 1*DIGIT ; 0-9 Status-Message → "grpc-message" Percent-Encoded + > Status-Details → "grpc-status-details-bin" {base64 encoded value} + + where + + > Status-Details is allowed only if Status is not OK. If it is set, it + > contains additional information about the RPC error. If it contains a status + > code field, it MUST NOT contradict the Status header. The consumer MUST + > verify this requirement. +-------------------------------------------------------------------------------} -- | Build trailers (see 'buildTrailersOnly' for the Trailers-Only case) buildProperTrailers :: ProperTrailers -> [HTTP.Header] diff --git a/test-grpc-spec/Test/Prop/Serialization.hs b/test-grpc-spec/Test/Prop/Serialization.hs --- a/test-grpc-spec/Test/Prop/Serialization.hs +++ b/test-grpc-spec/Test/Prop/Serialization.hs @@ -438,11 +438,13 @@ responseCompression <- awkward responseAcceptCompression <- awkward responseContentType <- Just <$> awkward + responseTrailerNames <- awkward responseMetadata <- awkward return ResponseHeaders { responseCompression , responseAcceptCompression , responseContentType + , responseTrailerNames , responseMetadata , responseUnrecognized = () } diff --git a/test-grpc-spec/Test/Util/Awkward.hs b/test-grpc-spec/Test/Util/Awkward.hs --- a/test-grpc-spec/Test/Util/Awkward.hs +++ b/test-grpc-spec/Test/Util/Awkward.hs @@ -11,6 +11,7 @@ import Data.ByteString qualified as BS.Strict import Data.ByteString qualified as Strict (ByteString) import Data.ByteString.Char8 qualified as Strict.BS.Char8 +import Data.CaseInsensitive qualified as CI import Data.Char (ord, chr, isSpace) import Data.List.NonEmpty (NonEmpty) import Data.Map.Strict (Map) @@ -18,6 +19,7 @@ import Data.Text (Text) import Data.Text qualified as Text import Data.Word +import Network.HTTP.Types qualified as HTTP import Test.QuickCheck import Test.QuickCheck.Instances () @@ -133,6 +135,49 @@ arbitrary = Awkward <$> arbitrary shrink = map Awkward . shrink . getAwkward +-- | Header-names can't actually be all that awkward +instance Arbitrary (Awkward HTTP.HeaderName) where + arbitrary = + fmap (Awkward . CI.mk . BS.Strict.pack) $ do + n <- choose (1, 20) + replicateM n validChar + where + validChar :: Gen Word8 + validChar = oneof [ + choose (0x30, 0x39) + , choose (0x61, 0x7A) + , elements [ord8 '_', ord8 '-', ord8 '.'] + ] + shrink = + map (Awkward . CI.mk . BS.Strict.pack) + . aux + . (BS.Strict.unpack . CI.original . getAwkward) + where + aux :: [Word8] -> [[Word8]] + aux name = concat [ + -- Try to replace any character with 'a' + [ prev ++ [ord8 'a'] ++ after + | (prev, x, after) <- isolate name + , x /= ord8 'a' + ] + + -- Standard list shrinking + , filter isValid $ shrink name + ] + + isValid :: [Word8] -> Bool + isValid name = and [ + all isValidChar name + , length name > 0 + ] + + isValidChar :: Word8 -> Bool + isValidChar x = or [ + 0x30 <= x && x <= 0x39 + , 0x61 <= x && x <= 0x7A + , x `elem` [ord8 '_', ord8 '-', ord8 '.'] + ] + {------------------------------------------------------------------------------- Trimming @@ -152,3 +197,17 @@ trimByteString = Strict.BS.Char8.dropWhile isSpace . Strict.BS.Char8.dropWhileEnd isSpace + +{------------------------------------------------------------------------------- + Internal auxiliary +-------------------------------------------------------------------------------} + +isolate :: [a] -> [([a], a, [a])] +isolate = go [] + where + go :: [a] -> [a] -> [([a], a, [a])] + go _ [] = [] + go prev (x:xs) = (reverse prev, x, xs) : go (x:prev) xs + +ord8 :: Char -> Word8 +ord8 = fromIntegral . ord