graphql-engine/server/src-lib/Hasura/Backends/DataConnector/Adapter/Transport.hs
awjchen ee78e32c6e server: implement trace sampling
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7300
GitOrigin-RevId: d96d7fa5aaf0c1e71d1c4c0fa8f0162abce39e18
2022-12-22 19:48:51 +00:00

88 lines
3.2 KiB
Haskell

{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hasura.Backends.DataConnector.Adapter.Transport () where
--------------------------------------------------------------------------------
import Control.Exception.Safe (throwIO)
import Data.Aeson qualified as J
import Data.Text.Extended ((<>>))
import Hasura.Backends.DataConnector.API qualified as API
import Hasura.Backends.DataConnector.Adapter.Execute ()
import Hasura.Backends.DataConnector.Adapter.Types (SourceConfig (..))
import Hasura.Backends.DataConnector.Agent.Client (AgentClientContext (..), AgentClientT, runAgentClientT)
import Hasura.Backends.DataConnector.Plan qualified as DC
import Hasura.Base.Error (Code (NotSupported), QErr, throw400)
import Hasura.EncJSON (EncJSON)
import Hasura.GraphQL.Execute.Backend (DBStepInfo (..))
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, nullLogger)
import Hasura.Prelude
import Hasura.SQL.Backend (BackendType (DataConnector))
import Hasura.Server.Types (RequestId)
import Hasura.Session (UserInfo)
import Hasura.Tracing qualified as Tracing
--------------------------------------------------------------------------------
instance BackendTransport 'DataConnector where
runDBQuery = runDBQuery'
runDBQueryExplain = runDBQueryExplain'
runDBMutation _ _ _ _ _ _ _ _ =
throw400 NotSupported "runDBMutation: not implemented for the Data Connector backend."
runDBStreamingSubscription _ _ _ =
liftIO . throwIO $ userError "runDBStreamingSubscription: not implemented for the Data Connector backend."
runDBSubscription _ _ _ =
liftIO . throwIO $ userError "runDBSubscription: not implemented for the Data Connector backend."
runDBQuery' ::
( MonadIO m,
MonadError QErr m,
Tracing.MonadTrace m,
HGL.MonadQueryLog m
) =>
RequestId ->
GQLReqUnparsed ->
RootFieldAlias ->
UserInfo ->
Logger Hasura ->
SourceConfig ->
AgentClientT (Tracing.TraceT (ExceptT QErr IO)) a ->
Maybe API.QueryRequest ->
m (DiffTime, a)
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 _scTimeoutMicroseconds)
$ action
mkQueryLog ::
GQLReqUnparsed ->
RootFieldAlias ->
Maybe API.QueryRequest ->
RequestId ->
HGL.QueryLog
mkQueryLog gqlQuery fieldName maybeQuery requestId =
HGL.QueryLog
gqlQuery
((\query -> (fieldName, HGL.GeneratedQuery (DC.renderQuery query) J.Null)) <$> maybeQuery)
requestId
HGL.QueryLogKindDatabase
runDBQueryExplain' ::
(MonadIO m, MonadError QErr m) =>
DBStepInfo 'DataConnector ->
m EncJSON
runDBQueryExplain' (DBStepInfo _ SourceConfig {..} _ action) =
liftEitherM
. liftIO
. runExceptT
. Tracing.ignoreTraceT
. flip runAgentClientT (AgentClientContext nullLogger _scEndpoint _scManager _scTimeoutMicroseconds)
$ action