From 1c9c2ce7fd04b4ce7cdd0143f61e644cb590ed58 Mon Sep 17 00:00:00 2001 From: Edsko de Vries Date: Wed, 29 Nov 2023 16:45:27 +0100 Subject: [PATCH] Fix timeouts/allow authority override * For timeouts, the gRPC spec does not allow spaces * For some deployments it is useful to be able to specify the HTTP2 :authority pseudo-header separate from the address. Co-authored-by: Justin Le --- .github/workflows/haskell-ci.yml | 5 ++ cabal.project | 6 ++ cabal.project.ci | 6 ++ demo-client/Demo/Client/Cmdline.hs | 13 ++- docs/demo-client.md | 9 +- src/Network/GRPC/Client.hs | 2 +- src/Network/GRPC/Client/Connection.hs | 45 ++++++---- src/Network/GRPC/Server/Connection.hs | 25 ++---- src/Network/GRPC/Spec.hs | 9 +- src/Network/GRPC/Spec/PseudoHeaders.hs | 115 +++++++++---------------- src/Network/GRPC/Spec/Request.hs | 1 - test-common/Test/Util/ClientServer.hs | 20 +++-- 12 files changed, 127 insertions(+), 129 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 428f556f..d69cb5a8 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -160,6 +160,11 @@ jobs: echo "package grapesy" >> cabal.project echo " ghc-options: -Werror=missing-methods" >> cabal.project cat >> cabal.project < parseServerValidation) + <*> (Opt.optional $ Opt.option Opt.str $ mconcat [ + Opt.long "authority" + , Opt.help "Override the HTTP2 :authority pseudo-header" + ]) where mkServer :: String -- Host -> Maybe Word -- Port -> Maybe Client.ServerValidation -- Secure? + -> Maybe String -> Client.Server - mkServer host mPort Nothing = + mkServer host mPort Nothing mAuth = Client.ServerInsecure $ - Client.Authority host (fromMaybe 50051 mPort) - mkServer host mPort (Just validation) = + Client.Address host (fromMaybe 50051 mPort) mAuth + mkServer host mPort (Just validation) mAuth = Client.ServerSecure validation def $ - Client.Authority host (fromMaybe 50052 mPort) + Client.Address host (fromMaybe 50052 mPort) mAuth parseServerValidation :: Opt.Parser Client.ServerValidation parseServerValidation = asum [ diff --git a/docs/demo-client.md b/docs/demo-client.md index 39e83d4d..d1047ee0 100644 --- a/docs/demo-client.md +++ b/docs/demo-client.md @@ -52,6 +52,12 @@ a self-signed certificate, the above will result in demo-client: HandshakeFailed (Error_Protocol ("certificate has unknown CA",True,UnknownCa)) ``` +You might see an error such as this on the Python side (if using): + +``` +Handshake failed with fatal error SSL_ERROR_SSL: error:10000070:SSL routines:OPENSSL_internal:BAD_PACKET_LENGTH +``` + There are two ways to address this. We can disable certificate validation altogether: @@ -63,7 +69,8 @@ cabal run demo-client -- sayHello \ ``` or we can define our own roots; for example, we can declare the demo server's -own certificate as a root: +own certificate as a root (this works with both the Python demo server as well +as our own): ``` cabal run demo-client -- sayHello \ diff --git a/src/Network/GRPC/Client.hs b/src/Network/GRPC/Client.hs index 0193cc16..f25e3177 100644 --- a/src/Network/GRPC/Client.hs +++ b/src/Network/GRPC/Client.hs @@ -13,7 +13,7 @@ module Network.GRPC.Client ( -- ** Connection parameters , Scheme(..) - , Authority(..) + , Address(..) -- ** Secure connection (TLS) , ServerValidation(..) diff --git a/src/Network/GRPC/Client/Connection.hs b/src/Network/GRPC/Client/Connection.hs index d5409a59..ea036cc2 100644 --- a/src/Network/GRPC/Client/Connection.hs +++ b/src/Network/GRPC/Client/Connection.hs @@ -49,6 +49,7 @@ import Network.GRPC.Util.Session qualified as Session import Network.GRPC.Util.TLS (ServerValidation(..), SslKeyLog(..)) import Network.GRPC.Util.TLS qualified as Util.TLS import Network.TLS (TLSException) +import Data.ByteString.UTF8 qualified as BS.Strict.UTF8 {------------------------------------------------------------------------------- Connection API @@ -241,10 +242,10 @@ isFinalException err data Server = -- | Make insecure connection (without TLS) to the given server - ServerInsecure Authority + ServerInsecure Address -- | Make secure connection (with TLS) to the given server - | ServerSecure ServerValidation SslKeyLog Authority + | ServerSecure ServerValidation SslKeyLog Address deriving stock (Show) {------------------------------------------------------------------------------- @@ -416,18 +417,18 @@ stayConnected connParams server connVar connCanClose = mRes <- try $ case server of - ServerInsecure auth -> runTCPClient auth $ \sock -> + ServerInsecure addr -> runTCPClient addr $ \sock -> bracket (HTTP2.Client.allocSimpleConfig sock writeBufferSize) HTTP2.Client.freeSimpleConfig $ \conf -> HTTP2.Client.run - (clientConfig auth Http) + (clientConfig addr Http) conf $ \sendRequest _aux -> do traceWith tracer $ ClientDebugConnectedInsecure let conn = Session.ConnectionToServer sendRequest atomically $ writeTVar connVar $ ConnectionReady connClosed conn takeMVar connCanClose - ServerSecure validation sslKeyLog auth -> do + ServerSecure validation sslKeyLog addr -> do keyLogger <- Util.TLS.keyLogger sslKeyLog caStore <- Util.TLS.validationCAStore validation let settings :: HTTP2.TLS.Client.Settings @@ -442,9 +443,10 @@ stayConnected connParams server connVar connCanClose = } HTTP2.TLS.Client.run + (clientConfig addr Https) settings - (authorityHost auth) - (fromIntegral $ authorityPort auth) + (addressHost addr) + (fromIntegral $ addressPort addr) $ \sendRequest _aux -> do traceWith tracer $ ClientDebugConnectedSecure let conn = Session.ConnectionToServer sendRequest @@ -482,9 +484,9 @@ stayConnected connParams server connVar connCanClose = threadDelay $ round $ delay * 1_000_000 loop reconnectPolicy' - runTCPClient :: Authority -> (Socket -> IO a) -> IO a + runTCPClient :: Address -> (Socket -> IO a) -> IO a runTCPClient auth = - Run.runTCPClient (authorityHost auth) (show $ authorityPort auth) + Run.runTCPClient (addressHost auth) (show $ addressPort auth) -- See docs of 'confBufferSize', but importantly: "this value is announced -- via SETTINGS_MAX_FRAME_SIZE to the peer." @@ -493,15 +495,24 @@ stayConnected connParams server connVar connCanClose = writeBufferSize :: HPACK.BufferSize writeBufferSize = 4096 - -- TODO: This is currently only used for the HTTP case, not HTTPS - clientConfig :: Authority -> Scheme -> HTTP2.Client.ClientConfig - clientConfig auth scheme = HTTP2.Client.defaultClientConfig { - HTTP2.Client.scheme = rawScheme serverPseudoHeaders - , HTTP2.Client.authority = rawAuthority serverPseudoHeaders + clientConfig :: Address -> Scheme -> HTTP2.Client.ClientConfig + clientConfig addr scheme = + ( case scheme of + Http -> HTTP2.Client.defaultClientConfig + Https -> HTTP2.TLS.Client.defaultClientConfig + HTTP2.TLS.Client.defaultSettings + ) { + HTTP2.Client.authority = + -- The spec mandates the use of UTF8 + -- + BS.Strict.UTF8.fromString $ + case addressAuthority addr of + -- We omit the port number in the authority, for compatibility + -- with TLS SNI as well as the gRPC spec (the HTTP2 spec says + -- the port number is optional in the authority). + Nothing -> addressHost addr + Just auth -> auth } - where - serverPseudoHeaders :: RawServerHeaders - serverPseudoHeaders = buildServerHeaders $ ServerHeaders scheme auth tracer :: Tracer IO ClientDebugMsg tracer = connDebugTracer connParams diff --git a/src/Network/GRPC/Server/Connection.hs b/src/Network/GRPC/Server/Connection.hs index 5d7f938c..3e90afa7 100644 --- a/src/Network/GRPC/Server/Connection.hs +++ b/src/Network/GRPC/Server/Connection.hs @@ -85,13 +85,10 @@ path = resourcePath . connectionResource getResourceHeaders :: HTTP2.Request -> Either OutOfSpecError ResourceHeaders getResourceHeaders req = - -- TODO: We should not parse the full pseudo headers - case parsePseudoHeaders (rawPseudoHeaders req) of - Left (InvalidScheme x) -> Left $ bad "invalid scheme" x - Left (InvalidAuthority x) -> Left $ bad "invalid authority" x - Left (InvalidPath x) -> Left $ bad "invalid path" x - Left (InvalidMethod x) -> Left $ httpMethodNotAllowed x - Right hdrs -> return hdrs + case parseResourceHeaders (rawResourceHeaders req) of + Left (InvalidPath x) -> Left $ bad "invalid path" x + Left (InvalidMethod x) -> Left $ httpMethodNotAllowed x + Right hdrs -> return hdrs where bad :: Builder -> Strict.ByteString -> OutOfSpecError bad msg arg = httpBadRequest $ mconcat [ @@ -100,16 +97,10 @@ getResourceHeaders req = , Builder.byteString arg ] -rawPseudoHeaders :: HTTP2.Request -> RawPseudoHeaders -rawPseudoHeaders req = RawPseudoHeaders { - rawServerHeaders = RawServerHeaders { - rawScheme = fromMaybe "" $ HTTP2.requestScheme req - , rawAuthority = fromMaybe "" $ HTTP2.requestAuthority req - } - , rawResourceHeaders = RawResourceHeaders { - rawPath = fromMaybe "" $ HTTP2.requestPath req - , rawMethod = fromMaybe "" $ HTTP2.requestMethod req - } +rawResourceHeaders :: HTTP2.Request -> RawResourceHeaders +rawResourceHeaders req = RawResourceHeaders { + rawPath = fromMaybe "" $ HTTP2.requestPath req + , rawMethod = fromMaybe "" $ HTTP2.requestMethod req } {------------------------------------------------------------------------------- diff --git a/src/Network/GRPC/Spec.hs b/src/Network/GRPC/Spec.hs index c689defb..ebf570c4 100644 --- a/src/Network/GRPC/Spec.hs +++ b/src/Network/GRPC/Spec.hs @@ -50,18 +50,15 @@ module Network.GRPC.Spec ( , ServerHeaders(..) , ResourceHeaders(..) , Path(..) - , Authority(..) + , Address(..) , Scheme(..) , Method(..) , rpcPath -- ** Serialization - , RawPseudoHeaders(..) - , RawServerHeaders(..) , RawResourceHeaders(..) - , InvalidPseudoHeaders(..) + , InvalidResourceHeaders(..) , buildResourceHeaders - , buildServerHeaders - , parsePseudoHeaders + , parseResourceHeaders -- ** Headers , buildRequestHeaders , parseRequestHeaders diff --git a/src/Network/GRPC/Spec/PseudoHeaders.hs b/src/Network/GRPC/Spec/PseudoHeaders.hs index fc240f47..64e59bfa 100644 --- a/src/Network/GRPC/Spec/PseudoHeaders.hs +++ b/src/Network/GRPC/Spec/PseudoHeaders.hs @@ -11,26 +11,21 @@ module Network.GRPC.Spec.PseudoHeaders ( -- ** Individual headers , Method(..) , Scheme(..) - , Authority(..) + , Address(..) , Path(..) - -- * Raw headers - , RawServerHeaders(..) + -- * Building and parsing resource headers , RawResourceHeaders(..) - , RawPseudoHeaders(..) - -- * Construction - , buildServerHeaders + -- ** Building , buildResourceHeaders , rpcPath - -- * Parsing - , InvalidPseudoHeaders(..) - , parsePseudoHeaders + -- ** Parsing + , InvalidResourceHeaders(..) + , parseResourceHeaders ) where import Control.Monad.Except 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.ByteString.UTF8 qualified as BS.Strict.UTF8 import Data.Hashable (Hashable) import Data.Proxy import Data.Text (Text) @@ -49,8 +44,8 @@ import Network.GRPC.Util.ByteString -- | Partial pseudo headers: identify the server, but not a specific resource data ServerHeaders = ServerHeaders { - serverScheme :: Scheme - , serverAuthority :: Authority + serverScheme :: Scheme + , serverAddress :: Address } deriving stock (Show) @@ -84,20 +79,37 @@ data Method = Post data Scheme = Http | Https deriving stock (Show) --- | HTTP authority +-- | Address -- --- As per the HTTP2 spec, this does not include @userinfo@: --- --- > The authority MUST NOT include the deprecated "userinfo" subcomponent for --- > "http" or "https" schemed URIs. --- --- See also . -data Authority = Authority { +-- The address of a server to connect to. This is not standard gRPC +-- nomenclature, but follows convention such as adopted by +-- [grpcurl](https://github.com/fullstorydev/grpcurl) and +-- [grpc-client-cli](https://github.com/vadimi/grpc-client-cli), which +-- distinguish between the /address/ of a server to connect to (hostname and +-- port), and the (optional) HTTP /authority/, which is an (optional) string to +-- be included as the HTTP2 +-- [:authority](https://datatracker.ietf.org/doc/html/rfc3986#section-3.2) +-- [pseudo-header](https://datatracker.ietf.org/doc/html/rfc7540#section-8.1.2.3). +data Address = Address { -- | Hostname - authorityHost :: String + addressHost :: String -- | TCP port - , authorityPort :: Word + , addressPort :: Word + + -- | Authority + -- + -- When the authority is not specified, it defaults to @addressHost@. + -- + -- This is used both for the HTTP2 @:authority@ pseudo-header as well + -- as for TLS SNI (if using a secure connection). + -- + -- Although the HTTP(2) specification allows the authority to include a + -- 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@@. + , addressAuthority :: Maybe String } deriving stock (Show) @@ -126,45 +138,14 @@ data Path = Path { deriving anyclass (Hashable) {------------------------------------------------------------------------------- - Raw headers + Building and parsing resource headers -------------------------------------------------------------------------------} -data RawServerHeaders = RawServerHeaders { - rawScheme :: Strict.ByteString - , rawAuthority :: Strict.ByteString - } - data RawResourceHeaders = RawResourceHeaders { rawPath :: Strict.ByteString , rawMethod :: Strict.ByteString } -data RawPseudoHeaders = RawPseudoHeaders { - rawServerHeaders :: RawServerHeaders - , rawResourceHeaders :: RawResourceHeaders - } - -{------------------------------------------------------------------------------- - Construction --------------------------------------------------------------------------------} - -buildServerHeaders :: ServerHeaders -> RawServerHeaders -buildServerHeaders ServerHeaders{serverScheme, serverAuthority} = - RawServerHeaders { - rawAuthority = - -- The spec mandates the use of UTF8 - -- - mconcat [ - BS.Strict.UTF8.fromString $ authorityHost serverAuthority - , ":" - , BS.Strict.C8.pack $ show $ authorityPort serverAuthority - ] - , rawScheme = - case serverScheme of - Http -> "http" - Https -> "https" - } - buildResourceHeaders :: ResourceHeaders -> RawResourceHeaders buildResourceHeaders ResourceHeaders{resourcePath, resourceMethod} = RawResourceHeaders { @@ -180,27 +161,15 @@ buildResourceHeaders ResourceHeaders{resourcePath, resourceMethod} = rpcPath :: IsRPC rpc => Proxy rpc -> Path rpcPath proxy = Path (serviceName proxy) (methodName proxy) -{------------------------------------------------------------------------------- - Parsing --------------------------------------------------------------------------------} - -data InvalidPseudoHeaders = - InvalidScheme Strict.ByteString - | InvalidAuthority Strict.ByteString - | InvalidMethod Strict.ByteString +data InvalidResourceHeaders = + InvalidMethod Strict.ByteString | InvalidPath Strict.ByteString -- | Parse pseudo headers --- --- We only parse the 'ResourceHeaders', ignoring the 'ServerHeaders' --- (we don't need it, and there are different formats in use; by simply not --- parsiing it altogether we avoid parse errors that don't affect us anyway.) -parsePseudoHeaders :: - RawPseudoHeaders - -> Either InvalidPseudoHeaders ResourceHeaders -parsePseudoHeaders RawPseudoHeaders{ - rawResourceHeaders = RawResourceHeaders{rawMethod, rawPath} - } = do +parseResourceHeaders :: + RawResourceHeaders + -> Either InvalidResourceHeaders ResourceHeaders +parseResourceHeaders RawResourceHeaders{rawMethod, rawPath} = do resourceMethod <- case rawMethod of "POST" -> return Post diff --git a/src/Network/GRPC/Spec/Request.hs b/src/Network/GRPC/Spec/Request.hs index fdf64cff..f72635d8 100644 --- a/src/Network/GRPC/Spec/Request.hs +++ b/src/Network/GRPC/Spec/Request.hs @@ -140,7 +140,6 @@ callDefinition proxy = \hdrs -> catMaybes [ "grpc-timeout" , mconcat [ BS.Strict.C8.pack $ show $ getTimeoutValue val - , " " , case unit of Hour -> "H" Minute -> "M" diff --git a/test-common/Test/Util/ClientServer.hs b/test-common/Test/Util/ClientServer.hs index 36fab0ce..e7261c32 100644 --- a/test-common/Test/Util/ClientServer.hs +++ b/test-common/Test/Util/ClientServer.hs @@ -412,19 +412,21 @@ runTestClient cfg clientTracer clientRun = do Client.ValidateServer $ Client.certStoreFromPath pubCert - clientAuthority :: Client.Authority + clientAuthority :: Client.Address clientAuthority = case useTLS cfg of - Just tlsSetup -> Client.Authority { - authorityHost = case tlsSetup of - TlsFail TlsFailHostname -> "127.0.0.1" - _otherwise -> "localhost" - , authorityPort = 50052 + Just tlsSetup -> Client.Address { + addressHost = case tlsSetup of + TlsFail TlsFailHostname -> "127.0.0.1" + _otherwise -> "localhost" + , addressPort = 50052 + , addressAuthority = Nothing } - Nothing -> Client.Authority { - authorityHost = "localhost" - , authorityPort = 50051 + Nothing -> Client.Address { + addressHost = "localhost" + , addressPort = 50051 + , addressAuthority = Nothing } clientRun $ Client.withConnection clientParams clientServer