mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-10-05 06:18:04 +03:00
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
This commit is contained in:
Daniel Chambers
hasura-bot
parent
cfb7824977
commit
728fcd011e
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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'
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
112
server/src-lib/Hasura/Backends/DataConnector/Logging.hs
Normal file
112
server/src-lib/Hasura/Backends/DataConnector/Logging.hs
Normal file
@ -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
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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 ->
|
||||
|
||||
@ -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 =
|
||||
|
||||
@ -17,6 +17,7 @@ module Hasura.Tracing
|
||||
tracedHttpRequest,
|
||||
injectEventContext,
|
||||
extractEventContext,
|
||||
word64ToHex,
|
||||
)
|
||||
where
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user