grpc-spec 1.0.0 → 1.1.0
raw patch · 15 files changed
+184/−50 lines, 15 filesdep ~QuickCheckdep ~aesondep ~base
Dependency ranges changed: QuickCheck, aeson, base, containers, quickcheck-instances, tree-diff
Files
- CHANGELOG.md +7/−0
- grpc-spec.cabal +12/−10
- src/Network/GRPC/Spec.hs +1/−0
- src/Network/GRPC/Spec/CustomMetadata/Raw.hs +9/−1
- src/Network/GRPC/Spec/CustomMetadata/Typed.hs +6/−0
- src/Network/GRPC/Spec/Headers/PseudoHeaders.hs +1/−1
- src/Network/GRPC/Spec/Headers/Response.hs +10/−0
- src/Network/GRPC/Spec/RPC.hs +3/−3
- src/Network/GRPC/Spec/RPC/JSON.hs +3/−3
- src/Network/GRPC/Spec/RPC/Protobuf.hs +3/−3
- src/Network/GRPC/Spec/RPC/Raw.hs +3/−3
- src/Network/GRPC/Spec/Serialization.hs +7/−0
- src/Network/GRPC/Spec/Serialization/Headers/Response.hs +58/−26
- test-grpc-spec/Test/Prop/Serialization.hs +2/−0
- test-grpc-spec/Test/Util/Awkward.hs +59/−0
CHANGELOG.md view
@@ -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.
grpc-spec.cabal view
@@ -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 <https://github.com/grpc/grpc/blob/master/doc/PROTOCOL-HTTP2.md>.@@ -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
src/Network/GRPC/Spec.hs view
@@ -119,6 +119,7 @@ , customMetadataValue , safeCustomMetadata , HeaderName(BinaryHeader, AsciiHeader)+ , getHeaderName , safeHeaderName , isValidAsciiValue , NoMetadata(..)
src/Network/GRPC/Spec/CustomMetadata/Raw.hs view
@@ -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
src/Network/GRPC/Spec/CustomMetadata/Typed.hs view
@@ -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 --
src/Network/GRPC/Spec/Headers/PseudoHeaders.hs view
@@ -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)
src/Network/GRPC/Spec/Headers/Response.hs view
@@ -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 <https://datatracker.ietf.org/doc/html/rfc9110#name-trailer>+ , 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)
src/Network/GRPC/Spec/RPC.hs view
@@ -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
src/Network/GRPC/Spec/RPC/JSON.hs view
@@ -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
src/Network/GRPC/Spec/RPC/Protobuf.hs view
@@ -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
src/Network/GRPC/Spec/RPC/Raw.hs view
@@ -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
src/Network/GRPC/Spec/Serialization.hs view
@@ -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
src/Network/GRPC/Spec/Serialization/Headers/Response.hs view
@@ -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 <https://datatracker.ietf.org/doc/html/rfc9110#name-trailer>++ > 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 "<n>#<m>element" indicating at least <n>+ > and at most <m> elements, each separated by a single comma (",") and+ > optional whitespace -------------------------------------------------------------------------------} -- | Construct the HTTP @Trailer@ header@@ -332,30 +346,48 @@ -- -- * <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 _ = (+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]
test-grpc-spec/Test/Prop/Serialization.hs view
@@ -438,11 +438,13 @@ responseCompression <- awkward responseAcceptCompression <- awkward responseContentType <- Just <$> awkward+ responseTrailerNames <- awkward responseMetadata <- awkward return ResponseHeaders { responseCompression , responseAcceptCompression , responseContentType+ , responseTrailerNames , responseMetadata , responseUnrecognized = () }
test-grpc-spec/Test/Util/Awkward.hs view
@@ -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