From 721a6400ec1feaea005670e6f8fbdd3ff51c7a3b Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Thu, 28 Mar 2024 14:41:08 +0100 Subject: [PATCH] Support the `endpoint-load-metrics-bin` header We are still a long way from supporting ORCA (#72) but at least clients will be able to read the ORCA load report sent by the server. This restores compatibility with the interop test suite. --- grapesy.cabal | 3 ++ src/Network/GRPC/Server/Call.hs | 29 +++++++------ src/Network/GRPC/Spec.hs | 3 ++ src/Network/GRPC/Spec/OrcaLoadReport.hs | 5 +++ src/Network/GRPC/Spec/RPC/Protobuf.hs | 30 ++++---------- src/Network/GRPC/Spec/Response.hs | 51 +++++++++++++++++------ src/Network/GRPC/Util/Protobuf.hs | 55 +++++++++++++++++++++++++ test-grapesy/Test/Prop/Serialization.hs | 35 ++++++++++++++-- test-grapesy/Test/Util/Awkward.hs | 4 ++ 9 files changed, 163 insertions(+), 52 deletions(-) create mode 100644 src/Network/GRPC/Spec/OrcaLoadReport.hs create mode 100644 src/Network/GRPC/Util/Protobuf.hs diff --git a/grapesy.cabal b/grapesy.cabal index d6483485..b8975cad 100644 --- a/grapesy.cabal +++ b/grapesy.cabal @@ -121,6 +121,7 @@ library Network.GRPC.Spec.CustomMetadata.Raw Network.GRPC.Spec.CustomMetadata.Typed Network.GRPC.Spec.LengthPrefixed + Network.GRPC.Spec.OrcaLoadReport Network.GRPC.Spec.PercentEncoding Network.GRPC.Spec.PseudoHeaders Network.GRPC.Spec.Request @@ -139,6 +140,7 @@ library Network.GRPC.Util.HTTP2 Network.GRPC.Util.HTTP2.Stream Network.GRPC.Util.Parser + Network.GRPC.Util.Protobuf Network.GRPC.Util.RedundantConstraint Network.GRPC.Util.Session Network.GRPC.Util.Session.API @@ -255,6 +257,7 @@ test-suite test-grapesy Proto.Empty Proto.Messages + Proto.OrcaLoadReport Proto.Test build-depends: -- Internal dependencies diff --git a/src/Network/GRPC/Server/Call.hs b/src/Network/GRPC/Server/Call.hs index f94c297d..754007e2 100644 --- a/src/Network/GRPC/Server/Call.hs +++ b/src/Network/GRPC/Server/Call.hs @@ -362,10 +362,11 @@ serverExceptionToClientError err | otherwise = ProperTrailers { - properTrailersGrpcStatus = GrpcError GrpcUnknown - , properTrailersGrpcMessage = Just $ Text.pack (show err) - , properTrailersMetadata = mempty - , properTrailersPushback = Nothing + properTrailersGrpcStatus = GrpcError GrpcUnknown + , properTrailersGrpcMessage = Just $ Text.pack (show err) + , properTrailersMetadata = mempty + , properTrailersPushback = Nothing + , properTrailersOrcaLoadReport = Nothing } {------------------------------------------------------------------------------- @@ -433,11 +434,12 @@ sendOutputWithEnvelope call@Call{callChannel} msg = do where mkTrailers :: ResponseTrailingMetadata rpc -> ProperTrailers mkTrailers metadata = ProperTrailers { - properTrailersGrpcStatus = GrpcOk - , properTrailersGrpcMessage = Nothing - , properTrailersMetadata = customMetadataMapFromList $ - buildMetadata metadata - , properTrailersPushback = Nothing + properTrailersGrpcStatus = GrpcOk + , properTrailersGrpcMessage = Nothing + , properTrailersMetadata = customMetadataMapFromList $ + buildMetadata metadata + , properTrailersPushback = Nothing + , properTrailersOrcaLoadReport = Nothing } -- | Send 'GrpcException' to the client @@ -548,10 +550,11 @@ sendTrailersOnly Call{ callContext trailers = TrailersOnly { trailersOnlyContentType = Context.serverContentType params , trailersOnlyProper = ProperTrailers { - properTrailersGrpcStatus = GrpcOk - , properTrailersGrpcMessage = Nothing - , properTrailersMetadata = customMetadataMapFromList metadata - , properTrailersPushback = Nothing + properTrailersGrpcStatus = GrpcOk + , properTrailersGrpcMessage = Nothing + , properTrailersMetadata = customMetadataMapFromList metadata + , properTrailersPushback = Nothing + , properTrailersOrcaLoadReport = Nothing } } diff --git a/src/Network/GRPC/Spec.hs b/src/Network/GRPC/Spec.hs index fdeb5d7a..111d6572 100644 --- a/src/Network/GRPC/Spec.hs +++ b/src/Network/GRPC/Spec.hs @@ -157,6 +157,8 @@ module Network.GRPC.Spec ( , TraceOptions(..) , buildTraceContext , parseTraceContext + -- * ORCA + , OrcaLoadReport ) where import Network.GRPC.Spec.Call @@ -167,6 +169,7 @@ import Network.GRPC.Spec.CustomMetadata.NoMetadata import Network.GRPC.Spec.CustomMetadata.Raw import Network.GRPC.Spec.CustomMetadata.Typed import Network.GRPC.Spec.LengthPrefixed +import Network.GRPC.Spec.OrcaLoadReport import Network.GRPC.Spec.PseudoHeaders import Network.GRPC.Spec.Request import Network.GRPC.Spec.Response diff --git a/src/Network/GRPC/Spec/OrcaLoadReport.hs b/src/Network/GRPC/Spec/OrcaLoadReport.hs new file mode 100644 index 00000000..1354862d --- /dev/null +++ b/src/Network/GRPC/Spec/OrcaLoadReport.hs @@ -0,0 +1,5 @@ +module Network.GRPC.Spec.OrcaLoadReport ( + OrcaLoadReport + ) where + +import Proto.OrcaLoadReport diff --git a/src/Network/GRPC/Spec/RPC/Protobuf.hs b/src/Network/GRPC/Spec/RPC/Protobuf.hs index f04260c2..934da67b 100644 --- a/src/Network/GRPC/Spec/RPC/Protobuf.hs +++ b/src/Network/GRPC/Spec/RPC/Protobuf.hs @@ -3,13 +3,9 @@ -- | gRPC with Protobuf module Network.GRPC.Spec.RPC.Protobuf (Protobuf) where -import Data.ByteString.Builder qualified as Builder -import Data.ByteString.Lazy qualified as BS.Lazy import Data.Kind -import Data.ProtoLens qualified as Protobuf -import Data.ProtoLens.Encoding.Parser (Parser) -import Data.ProtoLens.Encoding.Parser qualified as Protobuf -import Data.ProtoLens.Service.Types as Protobuf +import Data.ProtoLens +import Data.ProtoLens.Service.Types import Data.Proxy import Data.Text qualified as Text import GHC.TypeLits @@ -18,6 +14,7 @@ import Network.GRPC.Spec.CustomMetadata.NoMetadata import Network.GRPC.Spec.CustomMetadata.Typed import Network.GRPC.Spec.RPC import Network.GRPC.Spec.RPC.StreamType +import Network.GRPC.Util.Protobuf qualified as Protobuf {------------------------------------------------------------------------------- The spec defines the following in Appendix A, "GRPC for Protobuf": @@ -51,21 +48,21 @@ instance ( HasMethodImpl serv meth , symbolVal $ Proxy @(ServiceName serv) ] rpcMethodName _ = Text.pack . symbolVal $ Proxy @(MethodName serv meth) - rpcMessageType _ = Protobuf.messageName $ Proxy @(MethodInput serv meth) + rpcMessageType _ = messageName $ Proxy @(MethodInput serv meth) instance ( HasMethodImpl serv meth , Show (MethodInput serv meth) , Show (MethodOutput serv meth) ) => SupportsClientRpc (Protobuf serv meth) where - rpcSerializeInput _ = Builder.toLazyByteString . Protobuf.buildMessage - rpcDeserializeOutput _ = Protobuf.runParser parseMessage . BS.Lazy.toStrict + rpcSerializeInput _ = Protobuf.buildLazy + rpcDeserializeOutput _ = Protobuf.parseLazy instance ( HasMethodImpl serv meth , Show (MethodInput serv meth) , Show (MethodOutput serv meth) ) => SupportsServerRpc (Protobuf serv meth) where - rpcDeserializeInput _ = Protobuf.runParser parseMessage . BS.Lazy.toStrict - rpcSerializeOutput _ = Builder.toLazyByteString . Protobuf.buildMessage + rpcDeserializeInput _ = Protobuf.parseLazy + rpcSerializeOutput _ = Protobuf.buildLazy instance styp ~ MethodStreamingType serv meth => SupportsStreamingType (Protobuf serv meth) styp @@ -73,14 +70,3 @@ instance styp ~ MethodStreamingType serv meth instance HasStreamingType (Protobuf serv meth) where type RpcStreamingType (Protobuf serv meth) = MethodStreamingType serv meth -parseMessage :: forall msg. Protobuf.Message msg => Parser msg -parseMessage = do - msg <- Protobuf.parseMessage - atEnd <- Protobuf.atEnd - if atEnd then - return msg - else - fail $ concat [ - Text.unpack $ Protobuf.messageName $ Proxy @msg - , ": unconsumed bytes" - ] diff --git a/src/Network/GRPC/Spec/Response.hs b/src/Network/GRPC/Spec/Response.hs index 1d4c717f..04637e96 100644 --- a/src/Network/GRPC/Spec/Response.hs +++ b/src/Network/GRPC/Spec/Response.hs @@ -52,12 +52,14 @@ import Network.GRPC.Spec.Common import Network.GRPC.Spec.Compression (CompressionId) import Network.GRPC.Spec.CustomMetadata.Map import Network.GRPC.Spec.CustomMetadata.Raw +import Network.GRPC.Spec.CustomMetadata.Typed +import Network.GRPC.Spec.OrcaLoadReport import Network.GRPC.Spec.PercentEncoding qualified as PercentEncoding 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 +import Network.GRPC.Util.Protobuf qualified as Protobuf {------------------------------------------------------------------------------- Outputs (messages received from the peer) @@ -119,6 +121,11 @@ data ProperTrailers_ f = ProperTrailers { -- | Server pushback , properTrailersPushback :: HKD f (Maybe Pushback) + + -- | ORCA load report + -- + -- See + , properTrailersOrcaLoadReport :: HKD f (Maybe OrcaLoadReport) } type ProperTrailers = ProperTrailers_ Undecorated @@ -129,10 +136,11 @@ deriving stock instance Eq ProperTrailers instance HKD.Traversable ProperTrailers_ where sequence x = ProperTrailers - <$> properTrailersGrpcStatus x - <*> properTrailersGrpcMessage x - <*> properTrailersMetadata x - <*> properTrailersPushback x + <$> properTrailersGrpcStatus x + <*> properTrailersGrpcMessage x + <*> properTrailersMetadata x + <*> properTrailersPushback x + <*> properTrailersOrcaLoadReport x -- | Trailers sent in the gRPC Trailers-Only case -- @@ -276,10 +284,11 @@ grpcExceptionToTrailers GrpcException{ , grpcErrorMessage , grpcErrorMetadata } = ProperTrailers{ - properTrailersGrpcStatus = GrpcError grpcError - , properTrailersGrpcMessage = grpcErrorMessage - , properTrailersMetadata = customMetadataMapFromList grpcErrorMetadata - , properTrailersPushback = Nothing + properTrailersGrpcStatus = GrpcError grpcError + , properTrailersGrpcMessage = grpcErrorMessage + , properTrailersMetadata = customMetadataMapFromList grpcErrorMetadata + , properTrailersPushback = Nothing + , properTrailersOrcaLoadReport = Nothing } {------------------------------------------------------------------------------- @@ -416,6 +425,7 @@ buildProperTrailers ProperTrailers{ , properTrailersGrpcMessage , properTrailersMetadata , properTrailersPushback + , properTrailersOrcaLoadReport } = concat [ [ ( "grpc-status" , BS.Strict.C8.pack $ show $ fromGrpcStatus properTrailersGrpcStatus @@ -432,6 +442,11 @@ buildProperTrailers ProperTrailers{ ) | Just x <- [properTrailersPushback] ] + , [ ( "endpoint-load-metrics-bin" + , buildBinaryValue $ Protobuf.buildStrict x + ) + | Just x <- [properTrailersOrcaLoadReport] + ] ] -- | Build trailers for the Trailers-Only case @@ -509,6 +524,15 @@ parseTrailersOnly proxy = Just <$> parsePushback value } + | name == "endpoint-load-metrics-bin" + = modify $ liftProperTrailers $ \x -> x{ + properTrailersOrcaLoadReport = do + value' <- parseBinaryValue value + case Protobuf.parseStrict value' of + Left err -> throwError err + Right report -> return $ Just report + } + | otherwise = modify $ liftProperTrailers $ \x -> x{ properTrailersMetadata = do @@ -520,10 +544,11 @@ parseTrailersOnly proxy = uninitTrailersOnly = TrailersOnly { trailersOnlyContentType = return Nothing , trailersOnlyProper = ProperTrailers { - properTrailersGrpcStatus = throwError "missing: grpc-status" - , properTrailersGrpcMessage = return Nothing - , properTrailersMetadata = return mempty - , properTrailersPushback = return Nothing + properTrailersGrpcStatus = throwError "missing: grpc-status" + , properTrailersGrpcMessage = return Nothing + , properTrailersMetadata = return mempty + , properTrailersPushback = return Nothing + , properTrailersOrcaLoadReport = return Nothing } } diff --git a/src/Network/GRPC/Util/Protobuf.hs b/src/Network/GRPC/Util/Protobuf.hs new file mode 100644 index 00000000..77591cd9 --- /dev/null +++ b/src/Network/GRPC/Util/Protobuf.hs @@ -0,0 +1,55 @@ +-- | Protobuf utilities +-- +-- Intended for qualified import. +-- +-- > import Network.GRPC.Util.Protobuf qualified as Protobuf +module Network.GRPC.Util.Protobuf ( + -- * Serialization + parseStrict + , parseLazy + , buildStrict + , buildLazy + ) where + +import Data.Binary.Builder qualified as Builder +import Data.ByteString qualified as Strict (ByteString) +import Data.ByteString.Lazy qualified as BS.Lazy +import Data.ByteString.Lazy qualified as Lazy (ByteString) +import Data.ProtoLens (Message) +import Data.ProtoLens qualified as Protobuf +import Data.ProtoLens.Encoding.Parser (Parser) +import Data.ProtoLens.Encoding.Parser qualified as Protobuf +import Data.Proxy +import Data.Text qualified as Text + +{------------------------------------------------------------------------------- + Serialization +-------------------------------------------------------------------------------} + +parseStrict :: Message msg => Strict.ByteString -> Either String msg +parseStrict = Protobuf.runParser parseMessage + +parseLazy :: Message msg => Lazy.ByteString -> Either String msg +parseLazy = parseStrict . BS.Lazy.toStrict + +buildStrict :: Message msg => msg -> Strict.ByteString +buildStrict = BS.Lazy.toStrict . buildLazy + +buildLazy :: Message msg => msg -> Lazy.ByteString +buildLazy = Builder.toLazyByteString . Protobuf.buildMessage + +{------------------------------------------------------------------------------- + Internal auxilairy +-------------------------------------------------------------------------------} + +parseMessage :: forall msg. Protobuf.Message msg => Parser msg +parseMessage = do + msg <- Protobuf.parseMessage + atEnd <- Protobuf.atEnd + if atEnd then + return msg + else + fail $ concat [ + Text.unpack $ Protobuf.messageName $ Proxy @msg + , ": unconsumed bytes" + ] diff --git a/test-grapesy/Test/Prop/Serialization.hs b/test-grapesy/Test/Prop/Serialization.hs index 55c5f132..bda26b41 100644 --- a/test-grapesy/Test/Prop/Serialization.hs +++ b/test-grapesy/Test/Prop/Serialization.hs @@ -1,4 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLabels #-} + {-# OPTIONS_GHC -Wno-orphans #-} module Test.Prop.Serialization (tests) where @@ -23,6 +25,7 @@ import Test.Tasty.QuickCheck import Network.GRPC.Common import Network.GRPC.Common.Compression qualified as Compr +import Network.GRPC.Common.Protobuf import Network.GRPC.Spec import Test.Util.Awkward @@ -340,15 +343,17 @@ instance Arbitrary (Awkward ResponseHeaders) where instance Arbitrary (Awkward ProperTrailers) where arbitrary = Awkward <$> do - properTrailersGrpcStatus <- awkward - properTrailersGrpcMessage <- awkward - properTrailersMetadata <- awkward - properTrailersPushback <- awkward + properTrailersGrpcStatus <- awkward + properTrailersGrpcMessage <- awkward + properTrailersMetadata <- awkward + properTrailersPushback <- awkward + properTrailersOrcaLoadReport <- awkward return $ ProperTrailers{ properTrailersGrpcStatus , properTrailersGrpcMessage , properTrailersMetadata , properTrailersPushback + , properTrailersOrcaLoadReport } shrink h@(Awkward h') = concat [ @@ -491,6 +496,28 @@ instance Arbitrary (Awkward Pushback) where , pure DoNotRetry ] +instance Arbitrary (Awkward OrcaLoadReport) where + arbitrary = Awkward <$> do + -- @rps@ is a deprecated field, we omit it from the test + cpuUtilization <- awkward + memUtilization <- awkward + requestCost <- awkward + utilization <- awkward + rpsFractional <- awkward + eps <- awkward + namedMetrics <- awkward + applicationUtilization <- awkward + return $ + defMessage + & #cpuUtilization .~ cpuUtilization + & #memUtilization .~ memUtilization + & #requestCost .~ requestCost + & #utilization .~ utilization + & #rpsFractional .~ rpsFractional + & #eps .~ eps + & #namedMetrics .~ namedMetrics + & #applicationUtilization .~ applicationUtilization + {------------------------------------------------------------------------------- Auxiliary -------------------------------------------------------------------------------} diff --git a/test-grapesy/Test/Util/Awkward.hs b/test-grapesy/Test/Util/Awkward.hs index 205d57e4..78bf65af 100644 --- a/test-grapesy/Test/Util/Awkward.hs +++ b/test-grapesy/Test/Util/Awkward.hs @@ -123,3 +123,7 @@ instance {-# OVERLAPPING #-} Arbitrary (Awkward String) where instance Arbitrary (Awkward Text) where arbitrary = Awkward . Text.pack . getAwkward <$> arbitrary shrink = map (Awkward . Text.pack) . shrink . (Text.unpack . getAwkward) + +instance Arbitrary (Awkward Double) where + arbitrary = Awkward <$> arbitrary + shrink = map Awkward . shrink . getAwkward \ No newline at end of file