From 728fcd011e3ec3785231e15f8fbc90565b06bb9e Mon Sep 17 00:00:00 2001 From: Daniel Chambers Date: Mon, 11 Jul 2022 18:04:30 +1000 Subject: [PATCH] Add Data Connector agent request logging, improve error messages, and add tracing support [GDW-83] PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4987 GitOrigin-RevId: 71570d1656e0cd5be49c179740be81804a3ad05a --- server/graphql-engine.cabal | 1 + .../Hasura/Backends/BigQuery/DDL/Source.hs | 4 +- .../Backends/DataConnector/Adapter/Execute.hs | 8 +- .../DataConnector/Adapter/Metadata.hs | 39 +++-- .../DataConnector/Adapter/Transport.hs | 22 +-- .../Backends/DataConnector/Agent/Client.hs | 138 ++++++++---------- .../Hasura/Backends/DataConnector/Logging.hs | 112 ++++++++++++++ .../Hasura/Backends/MSSQL/DDL/Source.hs | 4 +- .../Hasura/Backends/MySQL/Connection.hs | 5 +- .../Hasura/Backends/Postgres/DDL/Source.hs | 3 +- server/src-lib/Hasura/HTTP.hs | 55 ++++++- server/src-lib/Hasura/Logging.hs | 54 ++++--- server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs | 2 +- .../Hasura/RQL/Types/Metadata/Backend.hs | 2 + server/src-lib/Hasura/Server/Init.hs | 13 +- server/src-lib/Hasura/Tracing.hs | 1 + .../Network/HTTP/Client/Transformable.hs | 17 +++ 17 files changed, 346 insertions(+), 134 deletions(-) create mode 100644 server/src-lib/Hasura/Backends/DataConnector/Logging.hs diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index 724d772dfd3..4c247b0d50f 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -580,6 +580,7 @@ library , Hasura.Backends.DataConnector.IR.Scalar.Type , Hasura.Backends.DataConnector.IR.Scalar.Value , Hasura.Backends.DataConnector.IR.Table + , Hasura.Backends.DataConnector.Logging , Hasura.Backends.DataConnector.Plan , Hasura.Backends.DataConnector.Schema.Column , Hasura.Backends.DataConnector.Schema.Table diff --git a/server/src-lib/Hasura/Backends/BigQuery/DDL/Source.hs b/server/src-lib/Hasura/Backends/BigQuery/DDL/Source.hs index df97e76fc1f..967911a13b8 100644 --- a/server/src-lib/Hasura/Backends/BigQuery/DDL/Source.hs +++ b/server/src-lib/Hasura/Backends/BigQuery/DDL/Source.hs @@ -21,6 +21,7 @@ import Hasura.Backends.BigQuery.Meta import Hasura.Backends.BigQuery.Source import Hasura.Backends.BigQuery.Types import Hasura.Base.Error +import Hasura.Logging (Hasura, Logger) import Hasura.Prelude import Hasura.RQL.Types.Backend (BackendConfig) import Hasura.RQL.Types.Column @@ -41,13 +42,14 @@ defaultRetryBaseDelay = 500000 resolveSourceConfig :: MonadIO m => + Logger Hasura -> SourceName -> BigQueryConnSourceConfig -> BackendSourceKind 'BigQuery -> BackendConfig 'BigQuery -> Env.Environment -> m (Either QErr BigQuerySourceConfig) -resolveSourceConfig _name BigQueryConnSourceConfig {..} _backendKind _backendConfig env = runExceptT $ do +resolveSourceConfig _logger _name BigQueryConnSourceConfig {..} _backendKind _backendConfig env = runExceptT $ do eSA <- resolveConfigurationJson env _cscServiceAccount case eSA of Left e -> throw400 Unexpected $ T.pack e diff --git a/server/src-lib/Hasura/Backends/DataConnector/Adapter/Execute.hs b/server/src-lib/Hasura/Backends/DataConnector/Adapter/Execute.hs index ca7b97ff1a6..3fdd7d8085e 100644 --- a/server/src-lib/Hasura/Backends/DataConnector/Adapter/Execute.hs +++ b/server/src-lib/Hasura/Backends/DataConnector/Adapter/Execute.hs @@ -26,14 +26,16 @@ import Hasura.RQL.Types.Common qualified as RQL import Hasura.SQL.AnyBackend (mkAnyBackend) import Hasura.SQL.Backend (BackendType (DataConnector)) import Hasura.Session +import Hasura.Tracing (MonadTrace) import Hasura.Tracing qualified as Tracing +import Servant.Client.Generic (genericClient) -------------------------------------------------------------------------------- instance BackendExecute 'DataConnector where type PreparedQuery 'DataConnector = IR.Q.QueryRequest type MultiplexedQuery 'DataConnector = Void - type ExecutionMonad 'DataConnector = Tracing.TraceT (ExceptT QErr IO) + type ExecutionMonad 'DataConnector = AgentClientT (Tracing.TraceT (ExceptT QErr IO)) mkDBQueryPlan UserInfo {..} sourceName sourceConfig ir = do queryRequest <- DC.mkPlan _uiSession sourceConfig ir @@ -70,12 +72,12 @@ toExplainPlan :: GQL.RootFieldAlias -> IR.Q.QueryRequest -> ExplainPlan toExplainPlan fieldName queryRequest = ExplainPlan fieldName (Just "") (Just [TE.decodeUtf8 $ BL.toStrict $ J.encode $ queryRequest]) -buildAction :: RQL.SourceName -> DC.SourceConfig -> IR.Q.QueryRequest -> Tracing.TraceT (ExceptT QErr IO) EncJSON +buildAction :: (MonadIO m, MonadTrace m, MonadError QErr m) => RQL.SourceName -> DC.SourceConfig -> IR.Q.QueryRequest -> AgentClientT m EncJSON buildAction sourceName DC.SourceConfig {..} queryRequest = do -- NOTE: Should this check occur during query construction in 'mkPlan'? when (DC.queryHasRelations queryRequest && isNothing (API.cRelationships _scCapabilities)) $ throw400 NotSupported "Agents must provide their own dataloader." - API.Routes {..} <- liftIO $ client @(Tracing.TraceT (ExceptT QErr IO)) _scManager _scEndpoint + let API.Routes {..} = genericClient case IR.queryRequestToAPI queryRequest of Right queryRequest' -> do queryResponse <- _query (toTxt sourceName) _scConfig queryRequest' diff --git a/server/src-lib/Hasura/Backends/DataConnector/Adapter/Metadata.hs b/server/src-lib/Hasura/Backends/DataConnector/Adapter/Metadata.hs index 9965d2370e7..ac41a54df95 100644 --- a/server/src-lib/Hasura/Backends/DataConnector/Adapter/Metadata.hs +++ b/server/src-lib/Hasura/Backends/DataConnector/Adapter/Metadata.hs @@ -12,10 +12,9 @@ import Data.Sequence qualified as Seq import Data.Sequence.NonEmpty qualified as NESeq import Data.Text qualified as Text import Data.Text.Extended (toTxt, (<<>), (<>>)) -import Hasura.Backends.DataConnector.API (Routes (_capabilities)) import Hasura.Backends.DataConnector.API qualified as API import Hasura.Backends.DataConnector.Adapter.Types qualified as DC -import Hasura.Backends.DataConnector.Agent.Client qualified as Agent.Client +import Hasura.Backends.DataConnector.Agent.Client (AgentClientContext (..), runAgentClientT) import Hasura.Backends.DataConnector.IR.Column qualified as IR.C import Hasura.Backends.DataConnector.IR.Name qualified as IR.N import Hasura.Backends.DataConnector.IR.Scalar.Type qualified as IR.S.T @@ -23,6 +22,7 @@ import Hasura.Backends.DataConnector.IR.Scalar.Value qualified as IR.S.V import Hasura.Backends.DataConnector.IR.Table qualified as IR.T import Hasura.Backends.Postgres.SQL.Types (PGDescription (..)) import Hasura.Base.Error (Code (..), QErr, decodeValue, throw400, throw500, withPathK) +import Hasura.Logging (Hasura, Logger) import Hasura.Prelude import Hasura.RQL.IR.BoolExp (OpExpG (..), PartialSQLExp (..), RootOrCurrent (..), RootOrCurrentColumn (..)) import Hasura.RQL.Types.Column qualified as RQL.T.C @@ -38,10 +38,11 @@ import Hasura.SQL.Backend (BackendSourceKind (..), BackendType (..)) import Hasura.SQL.Types (CollectableType (..)) import Hasura.Server.Utils qualified as HSU import Hasura.Session (SessionVariable, mkSessionVariable) -import Hasura.Tracing (TraceT, noReporter, runTraceTWithReporter) +import Hasura.Tracing (noReporter, runTraceTWithReporter) import Language.GraphQL.Draft.Syntax qualified as GQL import Network.HTTP.Client qualified as HTTP -import Servant.Client (AsClientT) +import Servant.Client.Core.HasClient ((//)) +import Servant.Client.Generic (genericClient) import Witch qualified instance BackendMetadata 'DataConnector where @@ -60,26 +61,33 @@ instance BackendMetadata 'DataConnector where resolveSourceConfig' :: MonadIO m => + Logger Hasura -> SourceName -> DC.ConnSourceConfig -> BackendSourceKind 'DataConnector -> DC.DataConnectorBackendConfig -> Environment -> m (Either QErr DC.SourceConfig) -resolveSourceConfig' sourceName (DC.ConnSourceConfig config) (DataConnectorKind dataConnectorName) backendConfig _ = runExceptT do +resolveSourceConfig' logger sourceName (DC.ConnSourceConfig config) (DataConnectorKind dataConnectorName) backendConfig _ = runExceptT do DC.DataConnectorOptions {..} <- OMap.lookup dataConnectorName backendConfig `onNothing` throw400 DataConnectorError ("Data connector named " <> toTxt dataConnectorName <> " was not found in the data connector backend config") manager <- liftIO $ HTTP.newManager HTTP.defaultManagerSettings - routes@API.Routes {..} <- liftIO $ Agent.Client.client manager _dcoUri -- TODO: capabilities applies to all sources for an agent. -- We should be able to call it once per agent and store it in the SchemaCache - API.CapabilitiesResponse {crCapabilities} <- runTraceTWithReporter noReporter "capabilities" _capabilities + API.CapabilitiesResponse {..} <- + runTraceTWithReporter noReporter "capabilities" + . flip runAgentClientT (AgentClientContext logger _dcoUri manager) + $ genericClient // API._capabilities + + validateConfiguration sourceName dataConnectorName crConfigSchemaResponse config + + schemaResponse <- + runTraceTWithReporter noReporter "resolve source" + . flip runAgentClientT (AgentClientContext logger _dcoUri manager) + $ (genericClient // API._schema) (toTxt sourceName) config - schemaResponse <- runTraceTWithReporter noReporter "resolve source" $ do - validateConfiguration routes sourceName dataConnectorName config - _schema (toTxt sourceName) config pure DC.SourceConfig { _scEndpoint = _dcoUri, @@ -91,15 +99,14 @@ resolveSourceConfig' sourceName (DC.ConnSourceConfig config) (DataConnectorKind } validateConfiguration :: - MonadIO m => - API.Routes (AsClientT (TraceT (ExceptT QErr m))) -> + MonadError QErr m => SourceName -> DC.DataConnectorName -> + API.ConfigSchemaResponse -> API.Config -> - TraceT (ExceptT QErr m) () -validateConfiguration API.Routes {..} sourceName dataConnectorName config = do - API.CapabilitiesResponse {crConfigSchemaResponse} <- _capabilities - let errors = API.validateConfigAgainstConfigSchema crConfigSchemaResponse config + m () +validateConfiguration sourceName dataConnectorName configSchema config = do + let errors = API.validateConfigAgainstConfigSchema configSchema config unless (null errors) $ let errorsText = Text.unlines (("- " <>) . Text.pack <$> errors) in throw400 diff --git a/server/src-lib/Hasura/Backends/DataConnector/Adapter/Transport.hs b/server/src-lib/Hasura/Backends/DataConnector/Adapter/Transport.hs index 7c18978addb..99741d87d4f 100644 --- a/server/src-lib/Hasura/Backends/DataConnector/Adapter/Transport.hs +++ b/server/src-lib/Hasura/Backends/DataConnector/Adapter/Transport.hs @@ -8,7 +8,8 @@ import Control.Exception.Safe (throwIO) import Data.Aeson qualified as J import Data.Text.Extended ((<>>)) import Hasura.Backends.DataConnector.Adapter.Execute () -import Hasura.Backends.DataConnector.Adapter.Types (SourceConfig) +import Hasura.Backends.DataConnector.Adapter.Types (SourceConfig (..)) +import Hasura.Backends.DataConnector.Agent.Client (AgentClientContext (..), AgentClientT, runAgentClientT) import Hasura.Backends.DataConnector.IR.Query qualified as IR.Q import Hasura.Backends.DataConnector.Plan qualified as DC import Hasura.Base.Error (Code (NotSupported), QErr, throw400) @@ -18,7 +19,7 @@ import Hasura.GraphQL.Logging qualified as HGL import Hasura.GraphQL.Namespace (RootFieldAlias) import Hasura.GraphQL.Transport.Backend (BackendTransport (..)) import Hasura.GraphQL.Transport.HTTP.Protocol (GQLReqUnparsed) -import Hasura.Logging (Hasura, Logger) +import Hasura.Logging (Hasura, Logger, nullLogger) import Hasura.Prelude import Hasura.SQL.Backend (BackendType (DataConnector)) import Hasura.Server.Types (RequestId) @@ -49,14 +50,15 @@ runDBQuery' :: UserInfo -> Logger Hasura -> SourceConfig -> - Tracing.TraceT (ExceptT QErr IO) a -> + AgentClientT (Tracing.TraceT (ExceptT QErr IO)) a -> Maybe IR.Q.QueryRequest -> m (DiffTime, a) -runDBQuery' requestId query fieldName _userInfo logger _sourceConfig action queryRequest = do +runDBQuery' requestId query fieldName _userInfo logger SourceConfig {..} action queryRequest = do void $ HGL.logQueryLog logger $ mkQueryLog query fieldName queryRequest requestId withElapsedTime . Tracing.trace ("Data Connector backend query for root field " <>> fieldName) . Tracing.interpTraceT (liftEitherM . liftIO . runExceptT) + . flip runAgentClientT (AgentClientContext logger _scEndpoint _scManager) $ action mkQueryLog :: @@ -76,9 +78,9 @@ runDBQueryExplain' :: (MonadIO m, MonadError QErr m) => DBStepInfo 'DataConnector -> m EncJSON -runDBQueryExplain' (DBStepInfo _ _ _ action) = - liftEitherM $ - liftIO $ - runExceptT $ - Tracing.runTraceTWithReporter Tracing.noReporter "explain" $ - action +runDBQueryExplain' (DBStepInfo _ SourceConfig {..} _ action) = + liftEitherM . liftIO + . runExceptT + . Tracing.runTraceTWithReporter Tracing.noReporter "explain" + . flip runAgentClientT (AgentClientContext nullLogger _scEndpoint _scManager) + $ action diff --git a/server/src-lib/Hasura/Backends/DataConnector/Agent/Client.hs b/server/src-lib/Hasura/Backends/DataConnector/Agent/Client.hs index 2c34f41be61..6b9aefca8e5 100644 --- a/server/src-lib/Hasura/Backends/DataConnector/Agent/Client.hs +++ b/server/src-lib/Hasura/Backends/DataConnector/Agent/Client.hs @@ -1,90 +1,72 @@ +{-# LANGUAGE UndecidableInstances #-} + module Hasura.Backends.DataConnector.Agent.Client - ( Hasura.Backends.DataConnector.Agent.Client.client, + ( AgentClientContext (..), + AgentClientT, + runAgentClientT, ) where import Control.Exception (try) -import Control.Monad.Free --- import Hasura.Tracing (MonadTrace, tracedHttpRequest) - --- import qualified Network.HTTP.Client.Transformable as Transformable - -import Hasura.Backends.DataConnector.API qualified as API +import Hasura.Backends.DataConnector.Logging (logAgentRequest, logClientError) import Hasura.Base.Error +import Hasura.HTTP qualified +import Hasura.Logging (Hasura, Logger) import Hasura.Prelude +import Hasura.Tracing (MonadTrace, tracedHttpRequest) import Network.HTTP.Client (Manager) import Network.HTTP.Client qualified as HTTP -import Network.HTTP.Types.Status (statusCode, statusMessage) +import Network.HTTP.Client.Transformable qualified as TransformableHTTP +import Network.HTTP.Types.Status (Status) import Servant.Client -import Servant.Client.Core.RunClient (ClientF (..)) -import Servant.Client.Generic -import Servant.Client.Internal.HttpClient (clientResponseToResponse) +import Servant.Client.Core (Request, RunClient (..)) +import Servant.Client.Internal.HttpClient (clientResponseToResponse, mkFailureResponse) --------------------------------------------------------------------------------- --- Client +data AgentClientContext = AgentClientContext + { _accLogger :: Logger Hasura, + _accBaseUrl :: BaseUrl, + _accHttpManager :: Manager + } --- | Create a record of client functions (see 'Routes') from a 'BaseUrl'. --- This function takes care to add trace headers, and to propagate useful --- errors back to the client for debugging purposes. -client :: - forall m. - (MonadIO m {- MonadTrace m, -}, MonadError QErr m) => - Manager -> - BaseUrl -> - IO (API.Routes (AsClientT m)) -client mgr baseUrl = do - let interpret :: ClientF a -> m a - interpret (RunRequest req k) = do - let req' = defaultMakeClientRequest baseUrl req - -- TODO: Had to remove tracing here because the API changed when - -- request transformations were added: - -- tracedHttpRequest (Transformable.fromRequest req) \req' -> do - do - responseOrException <- liftIO . try @HTTP.HttpException $ HTTP.httpLbs req' mgr - case responseOrException of - Left ex -> - -- TODO: log the error details - throw500 $ - "Error in Data Connector backend: " - <> case ex of - HTTP.InvalidUrlException {} -> "invalid URL" - HTTP.HttpExceptionRequest _ detail -> - case detail of - HTTP.StatusCodeException {} -> "status code" - HTTP.TooManyRedirects {} -> "too many redirects" - HTTP.OverlongHeaders {} -> "overlong headers" - HTTP.ResponseTimeout {} -> "response timeout" - HTTP.ConnectionTimeout {} -> "connection timeout" - HTTP.ConnectionFailure {} -> "connection failure" - HTTP.InvalidStatusLine {} -> "invalid status line" - HTTP.InvalidHeader {} -> "invalid header" - HTTP.InvalidRequestHeader {} -> "invalid request header" - HTTP.InternalException {} -> "internal error" - HTTP.ProxyConnectException {} -> "proxy connection error" - HTTP.NoResponseDataReceived {} -> "no response data received" - HTTP.TlsNotSupported {} -> "TLS not supported" - HTTP.WrongRequestBodyStreamSize {} -> "wrong request body stream size" - HTTP.ResponseBodyTooShort {} -> "response body too short" - HTTP.InvalidChunkHeaders {} -> "invalid chunk headers" - HTTP.IncompleteHeaders {} -> "incomplete headers" - HTTP.InvalidDestinationHost {} -> "invalid destination host" - HTTP.HttpZlibException {} -> "HTTP zlib error" - HTTP.InvalidProxyEnvironmentVariable {} -> "invalid proxy environment variable" - HTTP.ConnectionClosed {} -> "connection closed" - HTTP.InvalidProxySettings {} -> "invalid proxy settings" - Right response -> - pure $ k (clientResponseToResponse id response) - interpret (Throw err) = do - -- TODO: log the error details - let status res = - let s = (responseStatusCode res) - in tshow (statusCode s) <> " " <> bsToTxt (statusMessage s) - throw500 $ - "Error in Data Connector backend: " - <> case err of - FailureResponse _ res -> "the server returned status " <> status res - DecodeFailure _ res -> "unable to decode the response; status " <> status res - UnsupportedContentType _ res -> "unsupported content type in response; status " <> status res - InvalidContentTypeHeader res -> "invalid content type in response; status " <> status res - ConnectionError {} -> "connection error" - pure $ genericClientHoist (foldFree interpret) +newtype AgentClientT m a = AgentClientT (ReaderT AgentClientContext m a) + deriving newtype (Functor, Applicative, Monad, MonadError e, MonadTrace, MonadIO) + +runAgentClientT :: AgentClientT m a -> AgentClientContext -> m a +runAgentClientT (AgentClientT action) ctx = runReaderT action ctx + +askClientContext :: Monad m => AgentClientT m AgentClientContext +askClientContext = AgentClientT ask + +instance (MonadIO m, MonadTrace m, MonadError QErr m) => RunClient (AgentClientT m) where + runRequestAcceptStatus = runRequestAcceptStatus' + throwClientError = throwClientError' + +runRequestAcceptStatus' :: (MonadIO m, MonadTrace m, MonadError QErr m) => Maybe [Status] -> Request -> (AgentClientT m) Response +runRequestAcceptStatus' acceptStatus req = do + AgentClientContext {..} <- askClientContext + let req' = defaultMakeClientRequest _accBaseUrl req + + transformableReq <- + TransformableHTTP.tryFromClientRequest req' + `onLeft` (\err -> throw500 $ "Error in Data Connector backend: Could not create request. " <> err) + + (tracedReq, responseOrException) <- tracedHttpRequest transformableReq (\tracedReq -> fmap (tracedReq,) . liftIO . try @HTTP.HttpException $ TransformableHTTP.performRequest tracedReq _accHttpManager) + logAgentRequest _accLogger tracedReq responseOrException + case responseOrException of + Left ex -> + throw500 $ "Error in Data Connector backend: " <> Hasura.HTTP.serializeHTTPExceptionMessage (Hasura.HTTP.HttpException ex) + Right response -> do + let status = TransformableHTTP.responseStatus response + servantResponse = clientResponseToResponse id response + goodStatus = case acceptStatus of + Nothing -> TransformableHTTP.statusIsSuccessful status + Just good -> status `elem` good + if goodStatus + then pure $ servantResponse + else throwClientError $ mkFailureResponse _accBaseUrl req servantResponse + +throwClientError' :: (MonadIO m, MonadTrace m, MonadError QErr m) => ClientError -> (AgentClientT m) a +throwClientError' err = do + AgentClientContext {..} <- askClientContext + logClientError _accLogger err + throw500 $ "Error in Data Connector backend: " <> Hasura.HTTP.serializeServantClientErrorMessage err diff --git a/server/src-lib/Hasura/Backends/DataConnector/Logging.hs b/server/src-lib/Hasura/Backends/DataConnector/Logging.hs new file mode 100644 index 00000000000..cb641ce688c --- /dev/null +++ b/server/src-lib/Hasura/Backends/DataConnector/Logging.hs @@ -0,0 +1,112 @@ +module Hasura.Backends.DataConnector.Logging + ( logAgentRequest, + logClientError, + ) +where + +import Control.Lens ((^.)) +import Data.Aeson (object, (.=)) +import Data.Aeson.Key qualified as K +import Data.Aeson.KeyMap (KeyMap) +import Data.Aeson.KeyMap qualified as KM +import Data.ByteString qualified as BS +import Data.ByteString.Lazy qualified as BSL +import Data.CaseInsensitive qualified as CI +import Data.Text qualified as Text +import Data.Text.Encoding qualified as Text +import Data.Text.Encoding.Error (lenientDecode) +import Hasura.HTTP qualified +import Hasura.Logging (EngineLogType (..), Hasura, LogLevel (..), Logger (..), ToEngineLog (..)) +import Hasura.Prelude +import Hasura.Tracing (MonadTrace) +import Hasura.Tracing qualified as Tracing +import Network.HTTP.Client.Transformable (Header, HttpException (..), Request, Response (..), body, headers, method, path, statusCode, url) +import Servant.Client (ClientError (..), responseStatusCode, showBaseUrl) +import Servant.Client.Core (RequestF (..)) + +data RequestLogInfo = RequestLogInfo + { _rliRequestMethod :: Text, + _rliRequestUri :: Text, + _rliRequestHeaders :: KeyMap Text, + _rliRequestBody :: Maybe Text + } + deriving stock (Show, Eq) + +data AgentCommunicationLog = AgentCommunicationLog + { _aclRequest :: Maybe RequestLogInfo, + _aclResponseStatusCode :: Maybe Int, + _aclError :: Maybe Text, + _aclTraceId :: Text, + _aclSpanId :: Text + } + deriving stock (Show, Eq) + +instance ToEngineLog AgentCommunicationLog Hasura where + toEngineLog AgentCommunicationLog {..} = + (LevelDebug, ELTDataConnectorLog, logJson) + where + logJson = + object $ + catMaybes + [ ("requestMethod" .=) . _rliRequestMethod <$> _aclRequest, + ("requestUri" .=) . _rliRequestUri <$> _aclRequest, + ("requestHeaders" .=) . _rliRequestHeaders <$> _aclRequest, + ("requestBody" .=) <$> (_rliRequestBody =<< _aclRequest), + ("responseStatusCode" .=) <$> _aclResponseStatusCode, + ("error" .=) <$> _aclError, + Just $ "traceId" .= _aclTraceId, + Just $ "spanId" .= _aclSpanId + ] + +logAgentRequest :: (MonadIO m, MonadTrace m) => Logger Hasura -> Request -> Either HttpException (Response BSL.ByteString) -> m () +logAgentRequest (Logger writeLog) req responseOrError = do + traceCtx <- Tracing.currentContext + let _aclRequest = Just $ extractRequestLogInfoFromClientRequest req + _aclResponseStatusCode = case responseOrError of + Right response -> Just . statusCode $ responseStatus response + Left httpExn -> Hasura.HTTP.getHTTPExceptionStatus $ Hasura.HTTP.HttpException httpExn + _aclError = either (Just . Hasura.HTTP.serializeHTTPExceptionMessageForDebugging) (const Nothing) responseOrError + _aclTraceId = Tracing.word64ToHex $ Tracing.tcCurrentTrace traceCtx + _aclSpanId = Tracing.word64ToHex $ Tracing.tcCurrentSpan traceCtx + writeLog AgentCommunicationLog {..} + +extractRequestLogInfoFromClientRequest :: Request -> RequestLogInfo +extractRequestLogInfoFromClientRequest req = + let _rliRequestMethod = req ^. method & fromUtf8 + _rliRequestUri = req ^. url + _rliRequestPath = req ^. path & fromUtf8 + _rliRequestHeaders = req ^. headers & headersToKeyMap + _rliRequestBody = req ^. body <&> (BSL.toStrict >>> fromUtf8) + in RequestLogInfo {..} + +logClientError :: (MonadIO m, MonadTrace m) => Logger Hasura -> ClientError -> m () +logClientError (Logger writeLog) clientError = do + traceCtx <- Tracing.currentContext + let _aclResponseStatusCode = case clientError of + FailureResponse _ response -> Just . statusCode $ responseStatusCode response + _ -> Nothing + _aclRequest = extractRequestLogInfoFromClientInfo clientError + _aclError = Just $ Hasura.HTTP.serializeServantClientErrorMessageForDebugging clientError + _aclTraceId = Tracing.word64ToHex $ Tracing.tcCurrentTrace traceCtx + _aclSpanId = Tracing.word64ToHex $ Tracing.tcCurrentSpan traceCtx + writeLog AgentCommunicationLog {..} + +extractRequestLogInfoFromClientInfo :: ClientError -> Maybe RequestLogInfo +extractRequestLogInfoFromClientInfo = \case + FailureResponse request _ -> + let _rliRequestMethod = requestMethod request & fromUtf8 + (baseUrl, path') = requestPath request + _rliRequestUri = Text.pack (showBaseUrl baseUrl) <> fromUtf8 path' + _rliRequestHeaders = headersToKeyMap . toList $ requestHeaders request + _rliRequestBody = Nothing + in Just RequestLogInfo {..} + _ -> Nothing + +headersToKeyMap :: [Header] -> KeyMap Text +headersToKeyMap headers' = + headers' + <&> (\(name, value) -> (K.fromText . fromUtf8 $ CI.original name, fromUtf8 value)) + & KM.fromList + +fromUtf8 :: BS.ByteString -> Text +fromUtf8 = Text.decodeUtf8With lenientDecode diff --git a/server/src-lib/Hasura/Backends/MSSQL/DDL/Source.hs b/server/src-lib/Hasura/Backends/MSSQL/DDL/Source.hs index 38c84708a18..7f66bd62c77 100644 --- a/server/src-lib/Hasura/Backends/MSSQL/DDL/Source.hs +++ b/server/src-lib/Hasura/Backends/MSSQL/DDL/Source.hs @@ -32,6 +32,7 @@ import Hasura.Backends.MSSQL.Meta import Hasura.Backends.MSSQL.SQL.Error qualified as HGE import Hasura.Backends.MSSQL.Types import Hasura.Base.Error +import Hasura.Logging (Hasura, Logger) import Hasura.Prelude import Hasura.RQL.Types.Backend (BackendConfig) import Hasura.RQL.Types.Common @@ -45,13 +46,14 @@ import Text.Shakespeare.Text qualified as ST resolveSourceConfig :: (MonadIO m, MonadResolveSource m) => + Logger Hasura -> SourceName -> MSSQLConnConfiguration -> BackendSourceKind 'MSSQL -> BackendConfig 'MSSQL -> Env.Environment -> m (Either QErr MSSQLSourceConfig) -resolveSourceConfig name config _backendKind _backendConfig _env = runExceptT do +resolveSourceConfig _logger name config _backendKind _backendConfig _env = runExceptT do sourceResolver <- getMSSQLSourceResolver liftEitherM $ liftIO $ sourceResolver name config diff --git a/server/src-lib/Hasura/Backends/MySQL/Connection.hs b/server/src-lib/Hasura/Backends/MySQL/Connection.hs index b5b84657a30..34227a64013 100644 --- a/server/src-lib/Hasura/Backends/MySQL/Connection.hs +++ b/server/src-lib/Hasura/Backends/MySQL/Connection.hs @@ -34,6 +34,7 @@ import Hasura.Backends.MySQL.Meta (getMetadata) import Hasura.Backends.MySQL.ToQuery (Query (..)) import Hasura.Backends.MySQL.Types import Hasura.Base.Error +import Hasura.Logging (Hasura, Logger) import Hasura.Prelude import Hasura.RQL.Types.Backend (BackendConfig) import Hasura.RQL.Types.Common @@ -41,8 +42,8 @@ import Hasura.RQL.Types.Source import Hasura.RQL.Types.SourceCustomization import Hasura.SQL.Backend -resolveSourceConfig :: (MonadIO m) => SourceName -> ConnSourceConfig -> BackendSourceKind 'MySQL -> BackendConfig 'MySQL -> Env.Environment -> m (Either QErr SourceConfig) -resolveSourceConfig _name csc@ConnSourceConfig {_cscPoolSettings = ConnPoolSettings {..}, ..} _backendKind _backendConfig _env = do +resolveSourceConfig :: (MonadIO m) => Logger Hasura -> SourceName -> ConnSourceConfig -> BackendSourceKind 'MySQL -> BackendConfig 'MySQL -> Env.Environment -> m (Either QErr SourceConfig) +resolveSourceConfig _logger _name csc@ConnSourceConfig {_cscPoolSettings = ConnPoolSettings {..}, ..} _backendKind _backendConfig _env = do let connectInfo = defaultConnectInfo { connectHost = T.unpack _cscHost, diff --git a/server/src-lib/Hasura/Backends/Postgres/DDL/Source.hs b/server/src-lib/Hasura/Backends/Postgres/DDL/Source.hs index 79a2d8ba214..0a92f1f2082 100644 --- a/server/src-lib/Hasura/Backends/Postgres/DDL/Source.hs +++ b/server/src-lib/Hasura/Backends/Postgres/DDL/Source.hs @@ -71,13 +71,14 @@ instance ToMetadataFetchQuery 'Citus where resolveSourceConfig :: (MonadIO m, MonadResolveSource m) => + Logger Hasura -> SourceName -> PostgresConnConfiguration -> BackendSourceKind ('Postgres pgKind) -> BackendConfig ('Postgres pgKind) -> Env.Environment -> m (Either QErr (SourceConfig ('Postgres pgKind))) -resolveSourceConfig name config _backendKind _backendConfig _env = runExceptT do +resolveSourceConfig _logger name config _backendKind _backendConfig _env = runExceptT do sourceResolver <- getPGSourceResolver liftEitherM $ liftIO $ sourceResolver name config diff --git a/server/src-lib/Hasura/HTTP.hs b/server/src-lib/Hasura/HTTP.hs index bab2d7a9a73..2b4e9b3cd93 100644 --- a/server/src-lib/Hasura/HTTP.hs +++ b/server/src-lib/Hasura/HTTP.hs @@ -8,10 +8,13 @@ module Hasura.HTTP addHttpResponseHeaders, getHTTPExceptionStatus, serializeHTTPExceptionMessage, + serializeHTTPExceptionMessageForDebugging, + serializeServantClientErrorMessage, + serializeServantClientErrorMessageForDebugging, ) where -import Control.Exception (fromException) +import Control.Exception (Exception (..), fromException) import Control.Lens hiding ((.=)) import Data.Aeson qualified as J import Data.Aeson.KeyMap qualified as KM @@ -20,13 +23,16 @@ import Data.HashMap.Strict qualified as M import Data.Text qualified as T import Data.Text.Conversions (UTF8 (..), convertText) import Data.Text.Encoding qualified as TE +import Data.Text.Encoding.Error qualified as TE import Hasura.Prelude import Hasura.Server.Utils (redactSensitiveHeader) import Hasura.Server.Version (currentVersion) import Network.HTTP.Client qualified as HTTP import Network.HTTP.Client.Restricted qualified as Restricted +import Network.HTTP.Media qualified as HTTP import Network.HTTP.Types qualified as HTTP import Network.Wreq qualified as Wreq +import Servant.Client qualified as Servant hdrsToText :: [HTTP.Header] -> [(Text, Text)] hdrsToText hdrs = @@ -98,6 +104,35 @@ serializeHTTPExceptionMessage (HttpException (HTTP.HttpExceptionRequest _ httpEx _ -> "unexpected" serializeHTTPExceptionMessage (HttpException (HTTP.InvalidUrlException url reason)) = T.pack $ "URL: " <> url <> " is invalid because " <> reason +serializeHTTPExceptionMessageForDebugging :: HTTP.HttpException -> Text +serializeHTTPExceptionMessageForDebugging = \case + HTTP.HttpExceptionRequest _ err -> case err of + HTTP.StatusCodeException response _ -> "response status code indicated failure" <> (tshow . HTTP.statusCode $ HTTP.responseStatus response) + HTTP.TooManyRedirects redirects -> "too many redirects: " <> tshow (length redirects) <> " redirects" + HTTP.OverlongHeaders -> "overlong headers" + HTTP.ResponseTimeout -> "response timeout" + HTTP.ConnectionTimeout -> "connection timeout" + HTTP.ConnectionFailure exn -> "connection failure: " <> serializeExceptionForDebugging exn + HTTP.InvalidStatusLine statusLine -> "invalid status line: " <> fromUtf8 statusLine + HTTP.InvalidHeader header -> "invalid header: " <> fromUtf8 header + HTTP.InvalidRequestHeader requestHeader -> "invalid request header: " <> fromUtf8 requestHeader + HTTP.InternalException exn -> "internal error: " <> serializeExceptionForDebugging exn + HTTP.ProxyConnectException proxyHost port status -> "proxy connection to " <> fromUtf8 proxyHost <> ":" <> tshow port <> " returned response with status code that indicated failure: " <> tshow (HTTP.statusCode status) + HTTP.NoResponseDataReceived -> "no response data received" + HTTP.TlsNotSupported -> "TLS not supported" + HTTP.WrongRequestBodyStreamSize expected actual -> "wrong request body stream size. expected: " <> tshow expected <> ", actual: " <> tshow actual + HTTP.ResponseBodyTooShort expected actual -> "response body too short. expected: " <> tshow expected <> ", actual: " <> tshow actual + HTTP.InvalidChunkHeaders -> "invalid chunk headers" + HTTP.IncompleteHeaders -> "incomplete headers" + HTTP.InvalidDestinationHost host -> "invalid destination host: " <> fromUtf8 host + HTTP.HttpZlibException exn -> "HTTP zlib error: " <> serializeExceptionForDebugging exn + HTTP.InvalidProxyEnvironmentVariable name value -> "invalid proxy environment variable: " <> name <> "=" <> value + HTTP.ConnectionClosed -> "connection closed" + HTTP.InvalidProxySettings err' -> "invalid proxy settings: " <> err' + HTTP.InvalidUrlException url' reason -> "invalid url: " <> T.pack url' <> "; reason: " <> T.pack reason + where + fromUtf8 = TE.decodeUtf8With TE.lenientDecode + encodeHTTPRequestJSON :: HTTP.Request -> J.Value encodeHTTPRequestJSON request = J.Object $ @@ -139,3 +174,21 @@ data HttpResponse a = HttpResponse addHttpResponseHeaders :: HTTP.ResponseHeaders -> HttpResponse a -> HttpResponse a addHttpResponseHeaders newHeaders (HttpResponse b h) = HttpResponse b (newHeaders <> h) + +serializeServantClientErrorMessage :: Servant.ClientError -> Text +serializeServantClientErrorMessage = \case + Servant.FailureResponse _ response -> "response status code indicated failure: " <> (tshow . HTTP.statusCode $ Servant.responseStatusCode response) + Servant.DecodeFailure decodeErrorText _ -> "unable to decode the response, " <> decodeErrorText + Servant.UnsupportedContentType mediaType _ -> "unsupported content type in response: " <> TE.decodeUtf8With TE.lenientDecode (HTTP.renderHeader mediaType) + Servant.InvalidContentTypeHeader _ -> "invalid content type in response" + Servant.ConnectionError _ -> "connection error" + +serializeServantClientErrorMessageForDebugging :: Servant.ClientError -> Text +serializeServantClientErrorMessageForDebugging = \case + Servant.ConnectionError exn -> case fromException exn of + Just httpException -> serializeHTTPExceptionMessageForDebugging httpException + Nothing -> "error in the connection: " <> serializeExceptionForDebugging exn + other -> serializeServantClientErrorMessage other + +serializeExceptionForDebugging :: Exception e => e -> Text +serializeExceptionForDebugging = T.pack . displayException diff --git a/server/src-lib/Hasura/Logging.hs b/server/src-lib/Hasura/Logging.hs index 84f8cdc3534..3c80b48dc4a 100644 --- a/server/src-lib/Hasura/Logging.hs +++ b/server/src-lib/Hasura/Logging.hs @@ -17,6 +17,7 @@ module Hasura.Logging Logger (..), LogLevel (..), mkLogger, + nullLogger, LoggerCtx (..), mkLoggerCtx, cleanLoggerCtx, @@ -36,10 +37,13 @@ import Control.Monad.Trans.Control import Control.Monad.Trans.Managed (ManagedT (..), allocate) import Data.Aeson qualified as J import Data.Aeson.TH qualified as J +import Data.Aeson.Types qualified as J import Data.ByteString qualified as B import Data.ByteString.Lazy qualified as BL import Data.ByteString.Lazy.Char8 qualified as BLC import Data.HashSet qualified as Set +import Data.Map.Strict (Map) +import Data.Map.Strict qualified as Map import Data.SerializableBlob qualified as SB import Data.Text qualified as T import Data.Time.Clock qualified as Time @@ -47,6 +51,7 @@ import Data.Time.Format qualified as Format import Data.Time.LocalTime qualified as Time import Hasura.Prelude import System.Log.FastLogger qualified as FL +import Witch qualified newtype FormattedTime = FormattedTime {_unFormattedTime :: Text} deriving (Show, Eq, J.ToJSON) @@ -71,14 +76,15 @@ data instance EngineLogType Hasura | ELTStartup | ELTLivequeryPollerLog | ELTActionHandler + | ELTDataConnectorLog | -- internal log types ELTInternal !InternalLogTypes deriving (Show, Eq, Generic) instance Hashable (EngineLogType Hasura) -instance J.ToJSON (EngineLogType Hasura) where - toJSON = \case +instance Witch.From (EngineLogType Hasura) Text where + from = \case ELTHttpLog -> "http-log" ELTWebsocketLog -> "websocket-log" ELTWebhookLog -> "webhook-log" @@ -86,21 +92,25 @@ instance J.ToJSON (EngineLogType Hasura) where ELTStartup -> "startup" ELTLivequeryPollerLog -> "livequery-poller-log" ELTActionHandler -> "action-handler-log" - ELTInternal t -> J.toJSON t + ELTDataConnectorLog -> "data-connector-log" + ELTInternal t -> Witch.from t + +instance J.ToJSON (EngineLogType Hasura) where + toJSON = J.String . Witch.into @Text instance J.FromJSON (EngineLogType Hasura) where - parseJSON = J.withText "log-type" $ \s -> case T.toLower $ T.strip s of - "startup" -> return ELTStartup - "http-log" -> return ELTHttpLog - "webhook-log" -> return ELTWebhookLog - "websocket-log" -> return ELTWebsocketLog - "query-log" -> return ELTQueryLog - "livequery-poller-log" -> return ELTLivequeryPollerLog - "action-handler-log" -> return ELTActionHandler - _ -> - fail $ - "Valid list of comma-separated log types: " - <> BLC.unpack (J.encode userAllowedLogTypes) + parseJSON = J.withText "log-type" $ \s -> + let logTypeText = T.toLower $ T.strip s + logTypeMaybe = Map.lookup logTypeText allowedLogTypeMapping + in logTypeMaybe `onNothing` failure + where + allowedLogTypeMapping :: Map Text (EngineLogType Hasura) + allowedLogTypeMapping = + Map.fromList $ (\lt -> (Witch.into @Text lt, lt)) <$> userAllowedLogTypes + + failure :: J.Parser (EngineLogType Hasura) + failure = + fail $ "Valid list of comma-separated log types: " <> BLC.unpack (J.encode userAllowedLogTypes) data InternalLogTypes = -- | mostly for debug logs - see @debugT@, @debugBS@ and @debugLBS@ functions @@ -120,8 +130,8 @@ data InternalLogTypes instance Hashable InternalLogTypes -instance J.ToJSON InternalLogTypes where - toJSON = \case +instance Witch.From InternalLogTypes Text where + from = \case ILTUnstructured -> "unstructured" ILTEventTrigger -> "event-trigger" ILTScheduledTrigger -> "scheduled-trigger" @@ -133,6 +143,9 @@ instance J.ToJSON InternalLogTypes where ILTSchemaSyncThread -> "schema-sync-thread" ILTSourceCatalogMigration -> "source-catalog-migration" +instance J.ToJSON InternalLogTypes where + toJSON = J.String . Witch.into @Text + -- the default enabled log-types defaultEnabledEngineLogTypes :: Set.HashSet (EngineLogType Hasura) defaultEnabledEngineLogTypes = @@ -161,7 +174,9 @@ userAllowedLogTypes = ELTWebhookLog, ELTWebsocketLog, ELTQueryLog, - ELTLivequeryPollerLog + ELTLivequeryPollerLog, + ELTActionHandler, + ELTDataConnectorLog ] data LogLevel @@ -285,6 +300,9 @@ mkLogger (LoggerCtx loggerSet serverLogLevel timeGetter enabledLogTypes) = Logge when (logLevel >= serverLogLevel && isLogTypeEnabled enabledLogTypes logTy) $ liftIO $ FL.pushLogStrLn loggerSet $ FL.toLogStr (J.encode $ EngineLog localTime logLevel logTy logDet) +nullLogger :: Logger Hasura +nullLogger = Logger \_ -> pure () + eventTriggerLogType :: EngineLogType Hasura eventTriggerLogType = ELTInternal ILTEventTrigger diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs index 9b359c426da..00d6677562e 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs @@ -368,7 +368,7 @@ buildSchemaCacheRule logger env = proc (metadata, invalidationKeys) -> do Inc.dependOn -< Inc.selectKeyD sourceName invalidationKeys (| withRecordInconsistency - ( liftEitherA <<< bindA -< resolveSourceConfig @b sourceName sourceConfig backendKind backendConfig env + ( liftEitherA <<< bindA -< resolveSourceConfig @b logger sourceName sourceConfig backendKind backendConfig env ) |) metadataObj diff --git a/server/src-lib/Hasura/RQL/Types/Metadata/Backend.hs b/server/src-lib/Hasura/RQL/Types/Metadata/Backend.hs index 03581456cfb..26d31c0d06c 100644 --- a/server/src-lib/Hasura/RQL/Types/Metadata/Backend.hs +++ b/server/src-lib/Hasura/RQL/Types/Metadata/Backend.hs @@ -7,6 +7,7 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Data.Aeson import Data.Environment qualified as Env import Hasura.Base.Error +import Hasura.Logging (Hasura, Logger) import Hasura.Prelude import Hasura.RQL.IR.BoolExp import Hasura.RQL.Types.Backend @@ -57,6 +58,7 @@ class -- creates a connection pool (and other related parameters) in the process resolveSourceConfig :: (MonadIO m, MonadResolveSource m) => + Logger Hasura -> SourceName -> SourceConnConfiguration b -> BackendSourceKind b -> diff --git a/server/src-lib/Hasura/Server/Init.hs b/server/src-lib/Hasura/Server/Init.hs index 8a5ac56ecff..098a3c75691 100644 --- a/server/src-lib/Hasura/Server/Init.hs +++ b/server/src-lib/Hasura/Server/Init.hs @@ -26,6 +26,7 @@ import Hasura.Base.Error import Hasura.Cache.Bounded qualified as Cache (CacheSize, parseCacheSize) import Hasura.Eventing.EventTrigger (defaultFetchBatchSize) import Hasura.GraphQL.Execute.Subscription.Options qualified as ES +import Hasura.Logging (defaultEnabledEngineLogTypes, userAllowedLogTypes) import Hasura.Logging qualified as L import Hasura.Prelude import Hasura.RQL.Types.Common @@ -51,6 +52,7 @@ import Network.Wai.Handler.Warp (HostPreference) import Network.WebSockets qualified as WS import Options.Applicative import Text.PrettyPrint.ANSI.Leijen qualified as PP +import Witch qualified {- Note [ReadOnly Mode] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -728,9 +730,16 @@ enabledLogsEnv :: (String, String) enabledLogsEnv = ( "HASURA_GRAPHQL_ENABLED_LOG_TYPES", "Comma separated list of enabled log types " - <> "(default: startup,http-log,webhook-log,websocket-log)" - <> "(all: startup,http-log,webhook-log,websocket-log,query-log)" + <> "(default: " + <> defaultLogTypes + <> ")" + <> "(all: " + <> allAllowedLogTypes + <> ")" ) + where + defaultLogTypes = T.unpack . T.intercalate "," $ Witch.into @Text <$> Set.toList defaultEnabledEngineLogTypes + allAllowedLogTypes = T.unpack . T.intercalate "," $ Witch.into @Text <$> userAllowedLogTypes logLevelEnv :: (String, String) logLevelEnv = diff --git a/server/src-lib/Hasura/Tracing.hs b/server/src-lib/Hasura/Tracing.hs index 971702ccc36..09523f9215e 100644 --- a/server/src-lib/Hasura/Tracing.hs +++ b/server/src-lib/Hasura/Tracing.hs @@ -17,6 +17,7 @@ module Hasura.Tracing tracedHttpRequest, injectEventContext, extractEventContext, + word64ToHex, ) where diff --git a/server/src-lib/Network/HTTP/Client/Transformable.hs b/server/src-lib/Network/HTTP/Client/Transformable.hs index 6cae4138b27..34f0d71de67 100644 --- a/server/src-lib/Network/HTTP/Client/Transformable.hs +++ b/server/src-lib/Network/HTTP/Client/Transformable.hs @@ -2,6 +2,7 @@ module Network.HTTP.Client.Transformable ( Request, mkRequestThrow, mkRequestEither, + tryFromClientRequest, url, Network.HTTP.Client.Transformable.method, headers, @@ -132,6 +133,22 @@ mkRequestEither urlTxt = Just httpExc -> httpExc Nothing -> impureThrow someExc +-- | Creates a 'Request', converting it from a 'Client.Request'. This only +-- supports requests that use a Strict/Lazy ByteString as a request body +-- and will fail with all other body types. +-- +-- NOTE: You should avoid creating 'Client.Request's and use the 'mk' +-- functions to create 'Request's. This is for if a framework hands you +-- a precreated 'Client.Request' and you don't have a choice. +tryFromClientRequest :: Client.Request -> Either Text Request +tryFromClientRequest req = case Client.requestBody req of + Client.RequestBodyLBS lbs -> Right $ Request req (Just lbs) + Client.RequestBodyBS bs -> Right $ Request req (Just $ BL.fromStrict bs) + Client.RequestBodyBuilder _ _ -> Left "Unsupported body: Builder" + Client.RequestBodyStream _ _ -> Left "Unsupported body: Stream" + Client.RequestBodyStreamChunked _ -> Left "Unsupported body: Stream Chunked" + Client.RequestBodyIO _ -> Left "Unsupported body: IO" + -- | Url is 'materialized view' into `Request` consisting of -- concatenation of `host`, `port`, `queryParams`, and `path` in the -- underlying request object, as well as a literal url field that