mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-14 17:02:49 +03:00
Add additional tracing spans to HGE GraphQL queries and the Super Connector
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/9332 GitOrigin-RevId: ecde2383a42acf93fa8c6abb8bbd4c3b074b77fb
This commit is contained in:
parent
9de3db4729
commit
bfd046b224
@ -120,3 +120,4 @@ instance HasSourceConfiguration 'BigQuery where
|
|||||||
type SourceConnConfiguration 'BigQuery = BigQuery.BigQueryConnSourceConfig
|
type SourceConnConfiguration 'BigQuery = BigQuery.BigQueryConnSourceConfig
|
||||||
sourceConfigNumReadReplicas = const 0 -- not supported
|
sourceConfigNumReadReplicas = const 0 -- not supported
|
||||||
sourceConfigConnectonTemplateEnabled = const False -- not supported
|
sourceConfigConnectonTemplateEnabled = const False -- not supported
|
||||||
|
sourceConfigBackendSourceKind _sourceConfig = BigQueryKind
|
||||||
|
@ -25,7 +25,7 @@ import Hasura.Base.Error (Code (ValidationFailed), QErr, runAesonParser, throw40
|
|||||||
import Hasura.Prelude
|
import Hasura.Prelude
|
||||||
import Hasura.RQL.IR.BoolExp
|
import Hasura.RQL.IR.BoolExp
|
||||||
import Hasura.RQL.Types.Backend (Backend (..), ComputedFieldReturnType, HasSourceConfiguration (..), SupportedNamingCase (..), XDisable, XEnable)
|
import Hasura.RQL.Types.Backend (Backend (..), ComputedFieldReturnType, HasSourceConfiguration (..), SupportedNamingCase (..), XDisable, XEnable)
|
||||||
import Hasura.RQL.Types.BackendType (BackendType (DataConnector))
|
import Hasura.RQL.Types.BackendType (BackendSourceKind (DataConnectorKind), BackendType (DataConnector))
|
||||||
import Hasura.RQL.Types.Column (ColumnType (..))
|
import Hasura.RQL.Types.Column (ColumnType (..))
|
||||||
import Hasura.RQL.Types.ResizePool
|
import Hasura.RQL.Types.ResizePool
|
||||||
import Language.GraphQL.Draft.Syntax qualified as G
|
import Language.GraphQL.Draft.Syntax qualified as G
|
||||||
@ -168,6 +168,7 @@ instance HasSourceConfiguration 'DataConnector where
|
|||||||
type SourceConnConfiguration 'DataConnector = DC.ConnSourceConfig
|
type SourceConnConfiguration 'DataConnector = DC.ConnSourceConfig
|
||||||
sourceConfigNumReadReplicas = const 0 -- not supported
|
sourceConfigNumReadReplicas = const 0 -- not supported
|
||||||
sourceConfigConnectonTemplateEnabled = const False -- not supported
|
sourceConfigConnectonTemplateEnabled = const False -- not supported
|
||||||
|
sourceConfigBackendSourceKind DC.SourceConfig {..} = DataConnectorKind _scDataConnectorName
|
||||||
|
|
||||||
data CustomBooleanOperator a = CustomBooleanOperator
|
data CustomBooleanOperator a = CustomBooleanOperator
|
||||||
{ _cboName :: Text,
|
{ _cboName :: Text,
|
||||||
|
@ -30,6 +30,7 @@ import Hasura.RQL.Types.Common qualified as RQL
|
|||||||
import Hasura.SQL.AnyBackend (mkAnyBackend)
|
import Hasura.SQL.AnyBackend (mkAnyBackend)
|
||||||
import Hasura.Session
|
import Hasura.Session
|
||||||
import Hasura.Tracing (MonadTrace)
|
import Hasura.Tracing (MonadTrace)
|
||||||
|
import Hasura.Tracing qualified as Tracing
|
||||||
|
|
||||||
data DataConnectorPreparedQuery
|
data DataConnectorPreparedQuery
|
||||||
= QueryRequest API.QueryRequest
|
= QueryRequest API.QueryRequest
|
||||||
@ -112,7 +113,7 @@ instance BackendExecute 'DataConnector where
|
|||||||
buildQueryAction :: (MonadIO m, MonadTrace m, MonadError QErr m) => RQL.SourceName -> SourceConfig -> Plan API.QueryRequest API.QueryResponse -> AgentClientT m EncJSON
|
buildQueryAction :: (MonadIO m, MonadTrace m, MonadError QErr m) => RQL.SourceName -> SourceConfig -> Plan API.QueryRequest API.QueryResponse -> AgentClientT m EncJSON
|
||||||
buildQueryAction sourceName SourceConfig {..} Plan {..} = do
|
buildQueryAction sourceName SourceConfig {..} Plan {..} = do
|
||||||
queryResponse <- Client.query sourceName _scConfig _pRequest
|
queryResponse <- Client.query sourceName _scConfig _pRequest
|
||||||
reshapedResponse <- _pResponseReshaper queryResponse
|
reshapedResponse <- Tracing.newSpan "QueryResponse reshaping" $ _pResponseReshaper queryResponse
|
||||||
pure . encJFromBuilder $ J.fromEncoding reshapedResponse
|
pure . encJFromBuilder $ J.fromEncoding reshapedResponse
|
||||||
|
|
||||||
-- Delegates the generation to the Agent's /explain endpoint if it has that capability,
|
-- Delegates the generation to the Agent's /explain endpoint if it has that capability,
|
||||||
@ -136,6 +137,6 @@ toExplainPlan fieldName queryRequest =
|
|||||||
|
|
||||||
buildMutationAction :: (MonadIO m, MonadTrace m, MonadError QErr m) => RQL.SourceName -> SourceConfig -> Plan API.MutationRequest API.MutationResponse -> AgentClientT m EncJSON
|
buildMutationAction :: (MonadIO m, MonadTrace m, MonadError QErr m) => RQL.SourceName -> SourceConfig -> Plan API.MutationRequest API.MutationResponse -> AgentClientT m EncJSON
|
||||||
buildMutationAction sourceName SourceConfig {..} Plan {..} = do
|
buildMutationAction sourceName SourceConfig {..} Plan {..} = do
|
||||||
queryResponse <- Client.mutation sourceName _scConfig _pRequest
|
mutationResponse <- Client.mutation sourceName _scConfig _pRequest
|
||||||
reshapedResponse <- _pResponseReshaper queryResponse
|
reshapedResponse <- Tracing.newSpan "MutationResponse reshaping" $ _pResponseReshaper mutationResponse
|
||||||
pure . encJFromBuilder $ J.fromEncoding reshapedResponse
|
pure . encJFromBuilder $ J.fromEncoding reshapedResponse
|
||||||
|
@ -58,7 +58,7 @@ runDBQuery' ::
|
|||||||
Maybe DataConnectorPreparedQuery ->
|
Maybe DataConnectorPreparedQuery ->
|
||||||
ResolvedConnectionTemplate 'DataConnector ->
|
ResolvedConnectionTemplate 'DataConnector ->
|
||||||
m (DiffTime, EncJSON)
|
m (DiffTime, EncJSON)
|
||||||
runDBQuery' requestId query fieldName _userInfo logger licenseKeyCacheMaybe SourceConfig {..} action queryRequest _ = do
|
runDBQuery' requestId query fieldName _userInfo logger licenseKeyCacheMaybe sourceConfig@SourceConfig {..} action queryRequest _ = do
|
||||||
agentAuthKey <-
|
agentAuthKey <-
|
||||||
for licenseKeyCacheMaybe \licenseKeyCache -> do
|
for licenseKeyCacheMaybe \licenseKeyCache -> do
|
||||||
(key, _requestKeyRefresh) <- liftIO $ atomically $ getCredential licenseKeyCache
|
(key, _requestKeyRefresh) <- liftIO $ atomically $ getCredential licenseKeyCache
|
||||||
@ -73,6 +73,7 @@ runDBQuery' requestId query fieldName _userInfo logger licenseKeyCacheMaybe Sour
|
|||||||
void $ HGL.logQueryLog logger $ mkQueryLog query fieldName queryRequest requestId
|
void $ HGL.logQueryLog logger $ mkQueryLog query fieldName queryRequest requestId
|
||||||
withElapsedTime
|
withElapsedTime
|
||||||
. Tracing.newSpan ("Data Connector backend query for root field " <>> fieldName)
|
. Tracing.newSpan ("Data Connector backend query for root field " <>> fieldName)
|
||||||
|
. (<* Tracing.attachSourceConfigAttributes @'DataConnector sourceConfig)
|
||||||
. flip runAgentClientT (AgentClientContext logger _scEndpoint _scManager _scTimeoutMicroseconds agentAuthKey)
|
. flip runAgentClientT (AgentClientContext logger _scEndpoint _scManager _scTimeoutMicroseconds agentAuthKey)
|
||||||
. runOnBaseMonad
|
. runOnBaseMonad
|
||||||
. fmap snd
|
. fmap snd
|
||||||
@ -134,7 +135,7 @@ runDBMutation' ::
|
|||||||
Maybe DataConnectorPreparedQuery ->
|
Maybe DataConnectorPreparedQuery ->
|
||||||
ResolvedConnectionTemplate 'DataConnector ->
|
ResolvedConnectionTemplate 'DataConnector ->
|
||||||
m (DiffTime, a)
|
m (DiffTime, a)
|
||||||
runDBMutation' requestId query fieldName _userInfo logger licenseKeyCacheMaybe SourceConfig {..} action queryRequest _ = do
|
runDBMutation' requestId query fieldName _userInfo logger licenseKeyCacheMaybe sourceConfig@SourceConfig {..} action queryRequest _ = do
|
||||||
agentAuthKey <-
|
agentAuthKey <-
|
||||||
for licenseKeyCacheMaybe \licenseKeyCache -> do
|
for licenseKeyCacheMaybe \licenseKeyCache -> do
|
||||||
(key, _requestKeyRefresh) <- liftIO $ atomically $ getCredential licenseKeyCache
|
(key, _requestKeyRefresh) <- liftIO $ atomically $ getCredential licenseKeyCache
|
||||||
@ -149,6 +150,7 @@ runDBMutation' requestId query fieldName _userInfo logger licenseKeyCacheMaybe S
|
|||||||
void $ HGL.logQueryLog logger $ mkQueryLog query fieldName queryRequest requestId
|
void $ HGL.logQueryLog logger $ mkQueryLog query fieldName queryRequest requestId
|
||||||
withElapsedTime
|
withElapsedTime
|
||||||
. Tracing.newSpan ("Data Connector backend mutation for root field " <>> fieldName)
|
. Tracing.newSpan ("Data Connector backend mutation for root field " <>> fieldName)
|
||||||
|
. (<* Tracing.attachSourceConfigAttributes @'DataConnector sourceConfig)
|
||||||
. flip runAgentClientT (AgentClientContext logger _scEndpoint _scManager _scTimeoutMicroseconds agentAuthKey)
|
. flip runAgentClientT (AgentClientContext logger _scEndpoint _scManager _scTimeoutMicroseconds agentAuthKey)
|
||||||
. runOnBaseMonad
|
. runOnBaseMonad
|
||||||
$ action
|
$ action
|
||||||
|
@ -75,10 +75,11 @@ runQuery ::
|
|||||||
ResolvedConnectionTemplate 'MSSQL ->
|
ResolvedConnectionTemplate 'MSSQL ->
|
||||||
-- | Also return the time spent in the PG query; for telemetry.
|
-- | Also return the time spent in the PG query; for telemetry.
|
||||||
m (DiffTime, EncJSON)
|
m (DiffTime, EncJSON)
|
||||||
runQuery reqId query fieldName _userInfo logger _ _sourceConfig tx genSql _ = do
|
runQuery reqId query fieldName _userInfo logger _ sourceConfig tx genSql _ = do
|
||||||
logQueryLog logger $ mkQueryLog query fieldName genSql reqId
|
logQueryLog logger $ mkQueryLog query fieldName genSql reqId
|
||||||
withElapsedTime
|
withElapsedTime
|
||||||
$ newSpan ("MSSQL Query for root field " <>> fieldName)
|
$ newSpan ("MSSQL Query for root field " <>> fieldName)
|
||||||
|
$ (<* attachSourceConfigAttributes @'MSSQL sourceConfig)
|
||||||
$ fmap snd (run tx)
|
$ fmap snd (run tx)
|
||||||
|
|
||||||
runQueryExplain ::
|
runQueryExplain ::
|
||||||
@ -112,10 +113,11 @@ runMutation ::
|
|||||||
-- | Also return 'Mutation' when the operation was a mutation, and the time
|
-- | Also return 'Mutation' when the operation was a mutation, and the time
|
||||||
-- spent in the PG query; for telemetry.
|
-- spent in the PG query; for telemetry.
|
||||||
m (DiffTime, EncJSON)
|
m (DiffTime, EncJSON)
|
||||||
runMutation reqId query fieldName _userInfo logger _ _sourceConfig tx _genSql _ = do
|
runMutation reqId query fieldName _userInfo logger _ sourceConfig tx _genSql _ = do
|
||||||
logQueryLog logger $ mkQueryLog query fieldName Nothing reqId
|
logQueryLog logger $ mkQueryLog query fieldName Nothing reqId
|
||||||
withElapsedTime
|
withElapsedTime
|
||||||
$ newSpan ("MSSQL Mutation for root field " <>> fieldName)
|
$ newSpan ("MSSQL Mutation for root field " <>> fieldName)
|
||||||
|
$ (<* attachSourceConfigAttributes @'MSSQL sourceConfig)
|
||||||
$ run tx
|
$ run tx
|
||||||
|
|
||||||
runSubscription ::
|
runSubscription ::
|
||||||
|
@ -126,3 +126,4 @@ instance HasSourceConfiguration 'MSSQL where
|
|||||||
type SourceConnConfiguration 'MSSQL = MSSQL.MSSQLConnConfiguration
|
type SourceConnConfiguration 'MSSQL = MSSQL.MSSQLConnConfiguration
|
||||||
sourceConfigNumReadReplicas = MSSQL._mscReadReplicas
|
sourceConfigNumReadReplicas = MSSQL._mscReadReplicas
|
||||||
sourceConfigConnectonTemplateEnabled = const False -- not supported
|
sourceConfigConnectonTemplateEnabled = const False -- not supported
|
||||||
|
sourceConfigBackendSourceKind _sourceConfig = MSSQLKind
|
||||||
|
@ -41,6 +41,7 @@ import Hasura.Name qualified as Name
|
|||||||
import Hasura.Prelude
|
import Hasura.Prelude
|
||||||
import Hasura.RQL.DDL.ConnectionTemplate (BackendResolvedConnectionTemplate (..), ResolvedConnectionTemplateWrapper (..))
|
import Hasura.RQL.DDL.ConnectionTemplate (BackendResolvedConnectionTemplate (..), ResolvedConnectionTemplateWrapper (..))
|
||||||
import Hasura.RQL.Types.Backend
|
import Hasura.RQL.Types.Backend
|
||||||
|
import Hasura.RQL.Types.BackendTag (HasTag)
|
||||||
import Hasura.RQL.Types.BackendType
|
import Hasura.RQL.Types.BackendType
|
||||||
import Hasura.SQL.AnyBackend qualified as AB
|
import Hasura.SQL.AnyBackend qualified as AB
|
||||||
import Hasura.Server.Types (RequestId)
|
import Hasura.Server.Types (RequestId)
|
||||||
@ -53,14 +54,16 @@ instance
|
|||||||
) =>
|
) =>
|
||||||
BackendTransport ('Postgres pgKind)
|
BackendTransport ('Postgres pgKind)
|
||||||
where
|
where
|
||||||
runDBQuery = runPGQuery
|
runDBQuery = runPGQuery @pgKind
|
||||||
runDBMutation = runPGMutation
|
runDBMutation = runPGMutation @pgKind
|
||||||
runDBSubscription = runPGSubscription
|
runDBSubscription = runPGSubscription
|
||||||
runDBStreamingSubscription = runPGStreamingSubscription
|
runDBStreamingSubscription = runPGStreamingSubscription
|
||||||
runDBQueryExplain = runPGQueryExplain
|
runDBQueryExplain = runPGQueryExplain
|
||||||
|
|
||||||
runPGQuery ::
|
runPGQuery ::
|
||||||
( MonadIO m,
|
forall pgKind m.
|
||||||
|
( HasTag ('Postgres pgKind),
|
||||||
|
MonadIO m,
|
||||||
MonadBaseControl IO m,
|
MonadBaseControl IO m,
|
||||||
MonadError QErr m,
|
MonadError QErr m,
|
||||||
MonadQueryLog m,
|
MonadQueryLog m,
|
||||||
@ -83,11 +86,14 @@ runPGQuery reqId query fieldName _userInfo logger _ sourceConfig tx genSql resol
|
|||||||
logQueryLog logger $ mkQueryLog query fieldName genSql reqId (resolvedConnectionTemplate <$ resolvedConnectionTemplate)
|
logQueryLog logger $ mkQueryLog query fieldName genSql reqId (resolvedConnectionTemplate <$ resolvedConnectionTemplate)
|
||||||
withElapsedTime
|
withElapsedTime
|
||||||
$ newSpan ("Postgres Query for root field " <>> fieldName)
|
$ newSpan ("Postgres Query for root field " <>> fieldName)
|
||||||
|
$ (<* attachSourceConfigAttributes @('Postgres pgKind) sourceConfig)
|
||||||
$ runQueryTx (_pscExecCtx sourceConfig) (GraphQLQuery resolvedConnectionTemplate)
|
$ runQueryTx (_pscExecCtx sourceConfig) (GraphQLQuery resolvedConnectionTemplate)
|
||||||
$ fmap snd (runOnBaseMonad tx)
|
$ fmap snd (runOnBaseMonad tx)
|
||||||
|
|
||||||
runPGMutation ::
|
runPGMutation ::
|
||||||
( MonadIO m,
|
forall pgKind m.
|
||||||
|
( HasTag ('Postgres pgKind),
|
||||||
|
MonadIO m,
|
||||||
MonadBaseControl IO m,
|
MonadBaseControl IO m,
|
||||||
MonadError QErr m,
|
MonadError QErr m,
|
||||||
MonadQueryLog m,
|
MonadQueryLog m,
|
||||||
@ -109,6 +115,7 @@ runPGMutation reqId query fieldName userInfo logger _ sourceConfig tx _genSql re
|
|||||||
logQueryLog logger $ mkQueryLog query fieldName Nothing reqId (resolvedConnectionTemplate <$ resolvedConnectionTemplate)
|
logQueryLog logger $ mkQueryLog query fieldName Nothing reqId (resolvedConnectionTemplate <$ resolvedConnectionTemplate)
|
||||||
withElapsedTime
|
withElapsedTime
|
||||||
$ newSpan ("Postgres Mutation for root field " <>> fieldName)
|
$ newSpan ("Postgres Mutation for root field " <>> fieldName)
|
||||||
|
$ (<* attachSourceConfigAttributes @('Postgres pgKind) sourceConfig)
|
||||||
$ runTxWithCtxAndUserInfo userInfo (_pscExecCtx sourceConfig) (Tx PG.ReadWrite Nothing) (GraphQLQuery resolvedConnectionTemplate)
|
$ runTxWithCtxAndUserInfo userInfo (_pscExecCtx sourceConfig) (Tx PG.ReadWrite Nothing) (GraphQLQuery resolvedConnectionTemplate)
|
||||||
$ runOnBaseMonad tx
|
$ runOnBaseMonad tx
|
||||||
|
|
||||||
@ -176,7 +183,9 @@ mkQueryLog gqlQuery fieldName preparedSql requestId resolvedConnectionTemplate =
|
|||||||
-- see Note [Backwards-compatible transaction optimisation]
|
-- see Note [Backwards-compatible transaction optimisation]
|
||||||
|
|
||||||
runPGMutationTransaction ::
|
runPGMutationTransaction ::
|
||||||
( MonadIO m,
|
forall pgKind m.
|
||||||
|
( HasTag ('Postgres pgKind),
|
||||||
|
MonadIO m,
|
||||||
MonadBaseControl IO m,
|
MonadBaseControl IO m,
|
||||||
MonadError QErr m,
|
MonadError QErr m,
|
||||||
MonadQueryLog m,
|
MonadQueryLog m,
|
||||||
@ -196,6 +205,7 @@ runPGMutationTransaction reqId query userInfo logger sourceConfig resolvedConnec
|
|||||||
$ runTxWithCtxAndUserInfo userInfo (_pscExecCtx sourceConfig) (Tx PG.ReadWrite Nothing) (GraphQLQuery resolvedConnectionTemplate)
|
$ runTxWithCtxAndUserInfo userInfo (_pscExecCtx sourceConfig) (Tx PG.ReadWrite Nothing) (GraphQLQuery resolvedConnectionTemplate)
|
||||||
$ flip InsOrdHashMap.traverseWithKey mutations \fieldName dbsi ->
|
$ flip InsOrdHashMap.traverseWithKey mutations \fieldName dbsi ->
|
||||||
newSpan ("Postgres Mutation for root field " <>> fieldName)
|
newSpan ("Postgres Mutation for root field " <>> fieldName)
|
||||||
|
$ (<* attachSourceConfigAttributes @('Postgres pgKind) sourceConfig)
|
||||||
$ fmap arResult
|
$ fmap arResult
|
||||||
$ runOnBaseMonad
|
$ runOnBaseMonad
|
||||||
$ dbsiAction dbsi
|
$ dbsiAction dbsi
|
||||||
|
@ -171,3 +171,8 @@ instance
|
|||||||
type SourceConnConfiguration ('Postgres pgKind) = Postgres.PostgresConnConfiguration
|
type SourceConnConfiguration ('Postgres pgKind) = Postgres.PostgresConnConfiguration
|
||||||
sourceConfigNumReadReplicas = Postgres.sourceConfigNumReadReplicas
|
sourceConfigNumReadReplicas = Postgres.sourceConfigNumReadReplicas
|
||||||
sourceConfigConnectonTemplateEnabled = Postgres.sourceConfigConnectonTemplateEnabled
|
sourceConfigConnectonTemplateEnabled = Postgres.sourceConfigConnectonTemplateEnabled
|
||||||
|
sourceConfigBackendSourceKind _sourceConfig =
|
||||||
|
case backendTag @('Postgres pgKind) of
|
||||||
|
PostgresVanillaTag -> PostgresVanillaKind
|
||||||
|
PostgresCitusTag -> PostgresCitusKind
|
||||||
|
PostgresCockroachTag -> PostgresCockroachKind
|
||||||
|
@ -352,7 +352,7 @@ getResolvedExecPlan
|
|||||||
-- Construct the full 'ResolvedExecutionPlan' from the 'queryParts :: SingleOperation'.
|
-- Construct the full 'ResolvedExecutionPlan' from the 'queryParts :: SingleOperation'.
|
||||||
(parameterizedQueryHash, resolvedExecPlan) <-
|
(parameterizedQueryHash, resolvedExecPlan) <-
|
||||||
case queryParts of
|
case queryParts of
|
||||||
G.TypedOperationDefinition G.OperationTypeQuery _ varDefs directives inlinedSelSet -> do
|
G.TypedOperationDefinition G.OperationTypeQuery _ varDefs directives inlinedSelSet -> Tracing.newSpan "Resolve query execution plan" $ do
|
||||||
(executionPlan, queryRootFields, dirMap, parameterizedQueryHash) <-
|
(executionPlan, queryRootFields, dirMap, parameterizedQueryHash) <-
|
||||||
EQ.convertQuerySelSet
|
EQ.convertQuerySelSet
|
||||||
env
|
env
|
||||||
@ -368,9 +368,9 @@ getResolvedExecPlan
|
|||||||
(scSetGraphqlIntrospectionOptions sc)
|
(scSetGraphqlIntrospectionOptions sc)
|
||||||
reqId
|
reqId
|
||||||
maybeOperationName
|
maybeOperationName
|
||||||
Tracing.attachMetadata [("parameterized_query_hash", bsToTxt $ unParamQueryHash parameterizedQueryHash)]
|
Tracing.attachMetadata [("graphql.operation.type", "query"), ("parameterized_query_hash", bsToTxt $ unParamQueryHash parameterizedQueryHash)]
|
||||||
pure (parameterizedQueryHash, QueryExecutionPlan executionPlan queryRootFields dirMap)
|
pure (parameterizedQueryHash, QueryExecutionPlan executionPlan queryRootFields dirMap)
|
||||||
G.TypedOperationDefinition G.OperationTypeMutation _ varDefs directives inlinedSelSet -> do
|
G.TypedOperationDefinition G.OperationTypeMutation _ varDefs directives inlinedSelSet -> Tracing.newSpan "Resolve mutation execution plan" $ do
|
||||||
when (readOnlyMode == ReadOnlyModeEnabled)
|
when (readOnlyMode == ReadOnlyModeEnabled)
|
||||||
$ throw400 NotSupported "Mutations are not allowed when read-only mode is enabled"
|
$ throw400 NotSupported "Mutations are not allowed when read-only mode is enabled"
|
||||||
(executionPlan, parameterizedQueryHash) <-
|
(executionPlan, parameterizedQueryHash) <-
|
||||||
@ -389,8 +389,9 @@ getResolvedExecPlan
|
|||||||
(scSetGraphqlIntrospectionOptions sc)
|
(scSetGraphqlIntrospectionOptions sc)
|
||||||
reqId
|
reqId
|
||||||
maybeOperationName
|
maybeOperationName
|
||||||
|
Tracing.attachMetadata [("graphql.operation.type", "mutation")]
|
||||||
pure (parameterizedQueryHash, MutationExecutionPlan executionPlan)
|
pure (parameterizedQueryHash, MutationExecutionPlan executionPlan)
|
||||||
G.TypedOperationDefinition G.OperationTypeSubscription _ varDefs directives inlinedSelSet -> do
|
G.TypedOperationDefinition G.OperationTypeSubscription _ varDefs directives inlinedSelSet -> Tracing.newSpan "Resolve subscription execution plan" $ do
|
||||||
(normalizedDirectives, normalizedSelectionSet) <-
|
(normalizedDirectives, normalizedSelectionSet) <-
|
||||||
ER.resolveVariables
|
ER.resolveVariables
|
||||||
varDefs
|
varDefs
|
||||||
@ -398,7 +399,7 @@ getResolvedExecPlan
|
|||||||
directives
|
directives
|
||||||
inlinedSelSet
|
inlinedSelSet
|
||||||
subscriptionParser <- C.gqlSubscriptionParser gCtx `onNothing` throw400 ValidationFailed "no subscriptions exist"
|
subscriptionParser <- C.gqlSubscriptionParser gCtx `onNothing` throw400 ValidationFailed "no subscriptions exist"
|
||||||
unpreparedAST <- liftEither $ subscriptionParser normalizedSelectionSet
|
unpreparedAST <- Tracing.newSpan "Parse subscription IR" $ liftEither $ subscriptionParser normalizedSelectionSet
|
||||||
let parameterizedQueryHash = calculateParameterizedQueryHash normalizedSelectionSet
|
let parameterizedQueryHash = calculateParameterizedQueryHash normalizedSelectionSet
|
||||||
-- Process directives on the subscription
|
-- Process directives on the subscription
|
||||||
dirMap <-
|
dirMap <-
|
||||||
@ -416,6 +417,7 @@ getResolvedExecPlan
|
|||||||
unless (allowMultipleRootFields && isSingleNamespace unpreparedAST)
|
unless (allowMultipleRootFields && isSingleNamespace unpreparedAST)
|
||||||
$ throw400 ValidationFailed "subscriptions must select one top level field"
|
$ throw400 ValidationFailed "subscriptions must select one top level field"
|
||||||
subscriptionPlan <- buildSubscriptionPlan userInfo unpreparedAST parameterizedQueryHash reqHeaders maybeOperationName
|
subscriptionPlan <- buildSubscriptionPlan userInfo unpreparedAST parameterizedQueryHash reqHeaders maybeOperationName
|
||||||
|
Tracing.attachMetadata [("graphql.operation.type", "subscription")]
|
||||||
pure (parameterizedQueryHash, SubscriptionExecutionPlan subscriptionPlan)
|
pure (parameterizedQueryHash, SubscriptionExecutionPlan subscriptionPlan)
|
||||||
-- the parameterized query hash is calculated here because it is used in multiple
|
-- the parameterized query hash is calculated here because it is used in multiple
|
||||||
-- places and instead of calculating it separately, this is a common place to calculate
|
-- places and instead of calculating it separately, this is a common place to calculate
|
||||||
|
@ -7,6 +7,7 @@ import Data.Environment qualified as Env
|
|||||||
import Data.HashMap.Strict qualified as HashMap
|
import Data.HashMap.Strict qualified as HashMap
|
||||||
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
|
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
|
||||||
import Data.Tagged qualified as Tagged
|
import Data.Tagged qualified as Tagged
|
||||||
|
import Data.Text.Extended ((<>>))
|
||||||
import Hasura.Base.Error
|
import Hasura.Base.Error
|
||||||
import Hasura.GraphQL.Context
|
import Hasura.GraphQL.Context
|
||||||
import Hasura.GraphQL.Execute.Action
|
import Hasura.GraphQL.Execute.Action
|
||||||
@ -112,16 +113,15 @@ convertMutationSelectionSet
|
|||||||
|
|
||||||
(resolvedDirectives, resolvedSelSet) <- resolveVariables varDefs (fromMaybe HashMap.empty (GH._grVariables gqlUnparsed)) directives fields
|
(resolvedDirectives, resolvedSelSet) <- resolveVariables varDefs (fromMaybe HashMap.empty (GH._grVariables gqlUnparsed)) directives fields
|
||||||
-- Parse the GraphQL query into the RQL AST
|
-- Parse the GraphQL query into the RQL AST
|
||||||
unpreparedQueries ::
|
(unpreparedQueries :: RootFieldMap (MutationRootField UnpreparedValue)) <-
|
||||||
RootFieldMap (MutationRootField UnpreparedValue) <-
|
Tracing.newSpan "Parse mutation IR" $ liftEither $ mutationParser resolvedSelSet
|
||||||
liftEither $ mutationParser resolvedSelSet
|
|
||||||
|
|
||||||
-- Process directives on the mutation
|
-- Process directives on the mutation
|
||||||
_dirMap <- toQErr $ runParse (parseDirectives customDirectives (G.DLExecutable G.EDLMUTATION) resolvedDirectives)
|
_dirMap <- toQErr $ runParse (parseDirectives customDirectives (G.DLExecutable G.EDLMUTATION) resolvedDirectives)
|
||||||
|
|
||||||
let parameterizedQueryHash = calculateParameterizedQueryHash resolvedSelSet
|
let parameterizedQueryHash = calculateParameterizedQueryHash resolvedSelSet
|
||||||
|
|
||||||
resolveExecutionSteps rootFieldName rootFieldUnpreparedValue = do
|
resolveExecutionSteps rootFieldName rootFieldUnpreparedValue = Tracing.newSpan ("Resolve execution step for " <>> rootFieldName) do
|
||||||
case rootFieldUnpreparedValue of
|
case rootFieldUnpreparedValue of
|
||||||
RFDB sourceName exists ->
|
RFDB sourceName exists ->
|
||||||
AB.dispatchAnyBackend @BackendExecute
|
AB.dispatchAnyBackend @BackendExecute
|
||||||
|
@ -9,6 +9,7 @@ import Data.Environment qualified as Env
|
|||||||
import Data.HashMap.Strict qualified as HashMap
|
import Data.HashMap.Strict qualified as HashMap
|
||||||
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
|
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
|
||||||
import Data.Tagged qualified as Tagged
|
import Data.Tagged qualified as Tagged
|
||||||
|
import Data.Text.Extended ((<>>))
|
||||||
import Hasura.Base.Error
|
import Hasura.Base.Error
|
||||||
import Hasura.GraphQL.Context
|
import Hasura.GraphQL.Context
|
||||||
import Hasura.GraphQL.Execute.Action
|
import Hasura.GraphQL.Execute.Action
|
||||||
@ -36,6 +37,8 @@ import Hasura.Server.Prometheus (PrometheusMetrics (..))
|
|||||||
import Hasura.Server.Types (RequestId (..))
|
import Hasura.Server.Types (RequestId (..))
|
||||||
import Hasura.Services.Network
|
import Hasura.Services.Network
|
||||||
import Hasura.Session
|
import Hasura.Session
|
||||||
|
import Hasura.Tracing (MonadTrace)
|
||||||
|
import Hasura.Tracing qualified as Tracing
|
||||||
import Language.GraphQL.Draft.Syntax qualified as G
|
import Language.GraphQL.Draft.Syntax qualified as G
|
||||||
import Network.HTTP.Types qualified as HTTP
|
import Network.HTTP.Types qualified as HTTP
|
||||||
|
|
||||||
@ -60,6 +63,8 @@ parseGraphQLQuery gqlContext varDefs varValsM directives fields = do
|
|||||||
convertQuerySelSet ::
|
convertQuerySelSet ::
|
||||||
forall m.
|
forall m.
|
||||||
( MonadError QErr m,
|
( MonadError QErr m,
|
||||||
|
MonadTrace m,
|
||||||
|
MonadIO m,
|
||||||
MonadGQLExecutionCheck m,
|
MonadGQLExecutionCheck m,
|
||||||
MonadQueryTags m,
|
MonadQueryTags m,
|
||||||
ProvidesNetwork m
|
ProvidesNetwork m
|
||||||
@ -95,14 +100,14 @@ convertQuerySelSet
|
|||||||
maybeOperationName = do
|
maybeOperationName = do
|
||||||
-- 1. Parse the GraphQL query into the 'RootFieldMap' and a 'SelectionSet'
|
-- 1. Parse the GraphQL query into the 'RootFieldMap' and a 'SelectionSet'
|
||||||
(unpreparedQueries, normalizedDirectives, normalizedSelectionSet) <-
|
(unpreparedQueries, normalizedDirectives, normalizedSelectionSet) <-
|
||||||
parseGraphQLQuery gqlContext varDefs (GH._grVariables gqlUnparsed) directives fields
|
Tracing.newSpan "Parse query IR" $ parseGraphQLQuery gqlContext varDefs (GH._grVariables gqlUnparsed) directives fields
|
||||||
|
|
||||||
-- 2. Parse directives on the query
|
-- 2. Parse directives on the query
|
||||||
dirMap <- toQErr $ runParse (parseDirectives customDirectives (G.DLExecutable G.EDLQUERY) normalizedDirectives)
|
dirMap <- toQErr $ runParse (parseDirectives customDirectives (G.DLExecutable G.EDLQUERY) normalizedDirectives)
|
||||||
|
|
||||||
let parameterizedQueryHash = calculateParameterizedQueryHash normalizedSelectionSet
|
let parameterizedQueryHash = calculateParameterizedQueryHash normalizedSelectionSet
|
||||||
|
|
||||||
resolveExecutionSteps rootFieldName rootFieldUnpreparedValue = do
|
resolveExecutionSteps rootFieldName rootFieldUnpreparedValue = Tracing.newSpan ("Resolve execution step for " <>> rootFieldName) do
|
||||||
case rootFieldUnpreparedValue of
|
case rootFieldUnpreparedValue of
|
||||||
RFMulti lst -> do
|
RFMulti lst -> do
|
||||||
allSteps <- traverse (resolveExecutionSteps rootFieldName) lst
|
allSteps <- traverse (resolveExecutionSteps rootFieldName) lst
|
||||||
@ -111,6 +116,7 @@ convertQuerySelSet
|
|||||||
AB.dispatchAnyBackend @BackendExecute
|
AB.dispatchAnyBackend @BackendExecute
|
||||||
exists
|
exists
|
||||||
\(SourceConfigWith (sourceConfig :: (SourceConfig b)) queryTagsConfig (QDBR db)) -> do
|
\(SourceConfigWith (sourceConfig :: (SourceConfig b)) queryTagsConfig (QDBR db)) -> do
|
||||||
|
Tracing.attachSourceConfigAttributes @b sourceConfig
|
||||||
let mReqId =
|
let mReqId =
|
||||||
case _qtcOmitRequestId <$> queryTagsConfig of
|
case _qtcOmitRequestId <$> queryTagsConfig of
|
||||||
-- we include the request id only if a user explicitly wishes for it to be included.
|
-- we include the request id only if a user explicitly wishes for it to be included.
|
||||||
|
@ -76,7 +76,7 @@ processRemoteJoins ::
|
|||||||
GQLReqUnparsed ->
|
GQLReqUnparsed ->
|
||||||
m EncJSON
|
m EncJSON
|
||||||
processRemoteJoins requestId logger agentLicenseKey env requestHeaders userInfo lhs maybeJoinTree gqlreq =
|
processRemoteJoins requestId logger agentLicenseKey env requestHeaders userInfo lhs maybeJoinTree gqlreq =
|
||||||
forRemoteJoins maybeJoinTree lhs \joinTree -> do
|
Tracing.newSpan "Process remote joins" $ forRemoteJoins maybeJoinTree lhs \joinTree -> do
|
||||||
lhsParsed <-
|
lhsParsed <-
|
||||||
JO.eitherDecode (encJToLBS lhs)
|
JO.eitherDecode (encJToLBS lhs)
|
||||||
`onLeft` (throw500 . T.pack)
|
`onLeft` (throw500 . T.pack)
|
||||||
@ -133,7 +133,9 @@ processRemoteJoins requestId logger agentLicenseKey env requestHeaders userInfo
|
|||||||
foldJoinTreeWith ::
|
foldJoinTreeWith ::
|
||||||
( MonadError QErr m,
|
( MonadError QErr m,
|
||||||
MonadQueryTags m,
|
MonadQueryTags m,
|
||||||
Traversable f
|
Traversable f,
|
||||||
|
Tracing.MonadTrace m,
|
||||||
|
MonadIO m
|
||||||
) =>
|
) =>
|
||||||
-- | How to process a call to a source.
|
-- | How to process a call to a source.
|
||||||
(AB.AnyBackend S.SourceJoinCall -> m BL.ByteString) ->
|
(AB.AnyBackend S.SourceJoinCall -> m BL.ByteString) ->
|
||||||
@ -156,7 +158,7 @@ foldJoinTreeWith callSource callRemoteSchema userInfo lhs joinTree reqHeaders op
|
|||||||
previousStep <- case _jalJoin of
|
previousStep <- case _jalJoin of
|
||||||
RemoteJoinRemoteSchema remoteSchemaJoin childJoinTree -> do
|
RemoteJoinRemoteSchema remoteSchemaJoin childJoinTree -> do
|
||||||
let remoteSchemaInfo = rsDef $ _rsjRemoteSchema remoteSchemaJoin
|
let remoteSchemaInfo = rsDef $ _rsjRemoteSchema remoteSchemaJoin
|
||||||
maybeJoinIndex <- RS.makeRemoteSchemaJoinCall (callRemoteSchema remoteSchemaInfo) userInfo remoteSchemaJoin joinArguments
|
maybeJoinIndex <- RS.makeRemoteSchemaJoinCall (callRemoteSchema remoteSchemaInfo) userInfo remoteSchemaJoin _jalFieldName joinArguments
|
||||||
pure $ fmap (childJoinTree,) maybeJoinIndex
|
pure $ fmap (childJoinTree,) maybeJoinIndex
|
||||||
RemoteJoinSource sourceJoin childJoinTree -> do
|
RemoteJoinSource sourceJoin childJoinTree -> do
|
||||||
maybeJoinIndex <- S.makeSourceJoinCall callSource userInfo sourceJoin _jalFieldName joinArguments reqHeaders operationName
|
maybeJoinIndex <- S.makeSourceJoinCall callSource userInfo sourceJoin _jalFieldName joinArguments reqHeaders operationName
|
||||||
@ -173,7 +175,8 @@ foldJoinTreeWith callSource callRemoteSchema userInfo lhs joinTree reqHeaders op
|
|||||||
reqHeaders
|
reqHeaders
|
||||||
operationName
|
operationName
|
||||||
pure $ IntMap.fromAscList $ zip (IntMap.keys joinIndex) results
|
pure $ IntMap.fromAscList $ zip (IntMap.keys joinIndex) results
|
||||||
joinResults joinIndices compositeValue
|
Tracing.newSpan "Join remote join results"
|
||||||
|
$ joinResults joinIndices compositeValue
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
@ -29,7 +29,7 @@ import Data.HashMap.Strict.Extended qualified as HashMap
|
|||||||
import Data.IntMap.Strict qualified as IntMap
|
import Data.IntMap.Strict qualified as IntMap
|
||||||
import Data.List.NonEmpty qualified as NE
|
import Data.List.NonEmpty qualified as NE
|
||||||
import Data.Text qualified as T
|
import Data.Text qualified as T
|
||||||
import Data.Text.Extended (commaSeparated, toTxt, (<<>))
|
import Data.Text.Extended (commaSeparated, toTxt, (<<>), (<>>))
|
||||||
import Data.Validation (Validation (..), toEither)
|
import Data.Validation (Validation (..), toEither)
|
||||||
import Hasura.Base.Error
|
import Hasura.Base.Error
|
||||||
import Hasura.Base.ErrorMessage (fromErrorMessage)
|
import Hasura.Base.ErrorMessage (fromErrorMessage)
|
||||||
@ -47,6 +47,8 @@ import Hasura.RQL.Types.Common
|
|||||||
import Hasura.RQL.Types.ResultCustomization
|
import Hasura.RQL.Types.ResultCustomization
|
||||||
import Hasura.RemoteSchema.SchemaCache
|
import Hasura.RemoteSchema.SchemaCache
|
||||||
import Hasura.Session
|
import Hasura.Session
|
||||||
|
import Hasura.Tracing (MonadTrace)
|
||||||
|
import Hasura.Tracing qualified as Tracing
|
||||||
import Language.GraphQL.Draft.Syntax qualified as G
|
import Language.GraphQL.Draft.Syntax qualified as G
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
@ -54,26 +56,32 @@ import Language.GraphQL.Draft.Syntax qualified as G
|
|||||||
|
|
||||||
-- | Construct and execute a call to a remote schema for a remote join.
|
-- | Construct and execute a call to a remote schema for a remote join.
|
||||||
makeRemoteSchemaJoinCall ::
|
makeRemoteSchemaJoinCall ::
|
||||||
(MonadError QErr m) =>
|
(MonadError QErr m, MonadTrace m, MonadIO m) =>
|
||||||
-- | Function to send a request over the network.
|
-- | Function to send a request over the network.
|
||||||
(GQLReqOutgoing -> m BL.ByteString) ->
|
(GQLReqOutgoing -> m BL.ByteString) ->
|
||||||
-- | User information.
|
-- | User information.
|
||||||
UserInfo ->
|
UserInfo ->
|
||||||
-- | Information about that remote join.
|
-- | Information about that remote join.
|
||||||
RemoteSchemaJoin ->
|
RemoteSchemaJoin ->
|
||||||
|
-- | Name of the field from the join arguments.
|
||||||
|
FieldName ->
|
||||||
-- | Mapping from 'JoinArgumentId' to its corresponding 'JoinArgument'.
|
-- | Mapping from 'JoinArgumentId' to its corresponding 'JoinArgument'.
|
||||||
IntMap.IntMap JoinArgument ->
|
IntMap.IntMap JoinArgument ->
|
||||||
-- | The resulting join index (see 'buildJoinIndex') if any.
|
-- | The resulting join index (see 'buildJoinIndex') if any.
|
||||||
m (Maybe (IntMap.IntMap AO.Value))
|
m (Maybe (IntMap.IntMap AO.Value))
|
||||||
makeRemoteSchemaJoinCall networkFunction userInfo remoteSchemaJoin joinArguments = do
|
makeRemoteSchemaJoinCall networkFunction userInfo remoteSchemaJoin jaFieldName joinArguments = do
|
||||||
-- step 1: construct the internal intermediary representation
|
Tracing.newSpan ("Remote join to remote schema for field " <>> jaFieldName) do
|
||||||
maybeRemoteCall <- buildRemoteSchemaCall remoteSchemaJoin joinArguments userInfo
|
-- step 1: construct the internal intermediary representation
|
||||||
-- if there actually is a remote call:
|
maybeRemoteCall <-
|
||||||
for maybeRemoteCall \remoteCall -> do
|
Tracing.newSpan "Resolve execution step for remote join field"
|
||||||
-- step 2: execute it over the network
|
$ buildRemoteSchemaCall remoteSchemaJoin joinArguments userInfo
|
||||||
responseValue <- executeRemoteSchemaCall networkFunction remoteCall
|
-- if there actually is a remote call:
|
||||||
-- step 3: build the join index
|
for maybeRemoteCall \remoteCall -> do
|
||||||
buildJoinIndex remoteCall responseValue
|
-- step 2: execute it over the network
|
||||||
|
responseValue <- executeRemoteSchemaCall networkFunction remoteCall
|
||||||
|
-- step 3: build the join index
|
||||||
|
Tracing.newSpan "Build remote join index"
|
||||||
|
$ buildJoinIndex remoteCall responseValue
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- Internal representation
|
-- Internal representation
|
||||||
|
@ -31,6 +31,7 @@ import Data.IntMap.Strict qualified as IntMap
|
|||||||
import Data.List.NonEmpty qualified as NE
|
import Data.List.NonEmpty qualified as NE
|
||||||
import Data.Scientific qualified as Scientific
|
import Data.Scientific qualified as Scientific
|
||||||
import Data.Text qualified as T
|
import Data.Text qualified as T
|
||||||
|
import Data.Text.Extended ((<<>), (<>>))
|
||||||
import Data.Text.Read qualified as TR
|
import Data.Text.Read qualified as TR
|
||||||
import Hasura.Base.Error
|
import Hasura.Base.Error
|
||||||
import Hasura.GraphQL.Execute.Backend qualified as EB
|
import Hasura.GraphQL.Execute.Backend qualified as EB
|
||||||
@ -44,6 +45,8 @@ import Hasura.RQL.Types.Backend
|
|||||||
import Hasura.RQL.Types.Common
|
import Hasura.RQL.Types.Common
|
||||||
import Hasura.SQL.AnyBackend qualified as AB
|
import Hasura.SQL.AnyBackend qualified as AB
|
||||||
import Hasura.Session
|
import Hasura.Session
|
||||||
|
import Hasura.Tracing (MonadTrace)
|
||||||
|
import Hasura.Tracing qualified as Tracing
|
||||||
import Language.GraphQL.Draft.Syntax qualified as G
|
import Language.GraphQL.Draft.Syntax qualified as G
|
||||||
import Network.HTTP.Types qualified as HTTP
|
import Network.HTTP.Types qualified as HTTP
|
||||||
|
|
||||||
@ -52,7 +55,7 @@ import Network.HTTP.Types qualified as HTTP
|
|||||||
|
|
||||||
-- | Construct and execute a call to a source for a remote join.
|
-- | Construct and execute a call to a source for a remote join.
|
||||||
makeSourceJoinCall ::
|
makeSourceJoinCall ::
|
||||||
(MonadQueryTags m, MonadError QErr m) =>
|
(MonadQueryTags m, MonadError QErr m, MonadTrace m, MonadIO m) =>
|
||||||
-- | Function to dispatch a request to a source.
|
-- | Function to dispatch a request to a source.
|
||||||
(AB.AnyBackend SourceJoinCall -> m BL.ByteString) ->
|
(AB.AnyBackend SourceJoinCall -> m BL.ByteString) ->
|
||||||
-- | User information.
|
-- | User information.
|
||||||
@ -67,20 +70,25 @@ makeSourceJoinCall ::
|
|||||||
Maybe G.Name ->
|
Maybe G.Name ->
|
||||||
-- | The resulting join index (see 'buildJoinIndex') if any.
|
-- | The resulting join index (see 'buildJoinIndex') if any.
|
||||||
m (Maybe (IntMap.IntMap AO.Value))
|
m (Maybe (IntMap.IntMap AO.Value))
|
||||||
makeSourceJoinCall networkFunction userInfo remoteSourceJoin jaFieldName joinArguments reqHeaders operationName = do
|
makeSourceJoinCall networkFunction userInfo remoteSourceJoin jaFieldName joinArguments reqHeaders operationName =
|
||||||
-- step 1: create the SourceJoinCall
|
Tracing.newSpan ("Remote join to data source " <> sourceName <<> " for field " <>> jaFieldName) do
|
||||||
-- maybeSourceCall <-
|
-- step 1: create the SourceJoinCall
|
||||||
-- AB.dispatchAnyBackend @EB.BackendExecute remoteSourceJoin \(sjc :: SourceJoinCall b) ->
|
-- maybeSourceCall <-
|
||||||
-- buildSourceJoinCall @b userInfo jaFieldName joinArguments sjc
|
-- AB.dispatchAnyBackend @EB.BackendExecute remoteSourceJoin \(sjc :: SourceJoinCall b) ->
|
||||||
maybeSourceCall <-
|
-- buildSourceJoinCall @b userInfo jaFieldName joinArguments sjc
|
||||||
AB.dispatchAnyBackend @EB.BackendExecute remoteSourceJoin
|
maybeSourceCall <-
|
||||||
$ buildSourceJoinCall userInfo jaFieldName joinArguments reqHeaders operationName
|
AB.dispatchAnyBackend @EB.BackendExecute remoteSourceJoin
|
||||||
-- if there actually is a remote call:
|
$ buildSourceJoinCall userInfo jaFieldName joinArguments reqHeaders operationName
|
||||||
for maybeSourceCall \sourceCall -> do
|
-- if there actually is a remote call:
|
||||||
-- step 2: send this call over the network
|
for maybeSourceCall \sourceCall -> do
|
||||||
sourceResponse <- networkFunction sourceCall
|
-- step 2: send this call over the network
|
||||||
-- step 3: build the join index
|
sourceResponse <- networkFunction sourceCall
|
||||||
buildJoinIndex sourceResponse
|
-- step 3: build the join index
|
||||||
|
Tracing.newSpan "Build remote join index"
|
||||||
|
$ buildJoinIndex sourceResponse
|
||||||
|
where
|
||||||
|
sourceName :: SourceName
|
||||||
|
sourceName = AB.dispatchAnyBackend @Backend remoteSourceJoin _rsjSource
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- Internal representation
|
-- Internal representation
|
||||||
@ -97,7 +105,8 @@ data SourceJoinCall b = SourceJoinCall
|
|||||||
-- Step 1: building the source call
|
-- Step 1: building the source call
|
||||||
|
|
||||||
buildSourceJoinCall ::
|
buildSourceJoinCall ::
|
||||||
(EB.BackendExecute b, MonadQueryTags m, MonadError QErr m) =>
|
forall b m.
|
||||||
|
(EB.BackendExecute b, MonadQueryTags m, MonadError QErr m, MonadTrace m, MonadIO m) =>
|
||||||
UserInfo ->
|
UserInfo ->
|
||||||
FieldName ->
|
FieldName ->
|
||||||
IntMap.IntMap JoinArgument ->
|
IntMap.IntMap JoinArgument ->
|
||||||
@ -106,39 +115,41 @@ buildSourceJoinCall ::
|
|||||||
RemoteSourceJoin b ->
|
RemoteSourceJoin b ->
|
||||||
m (Maybe (AB.AnyBackend SourceJoinCall))
|
m (Maybe (AB.AnyBackend SourceJoinCall))
|
||||||
buildSourceJoinCall userInfo jaFieldName joinArguments reqHeaders operationName remoteSourceJoin = do
|
buildSourceJoinCall userInfo jaFieldName joinArguments reqHeaders operationName remoteSourceJoin = do
|
||||||
let rows =
|
Tracing.newSpan "Resolve execution step for remote join field" do
|
||||||
IntMap.toList joinArguments <&> \(argumentId, argument) ->
|
let rows =
|
||||||
KM.insert "__argument_id__" (J.toJSON argumentId)
|
IntMap.toList joinArguments <&> \(argumentId, argument) ->
|
||||||
$ KM.fromList
|
KM.insert "__argument_id__" (J.toJSON argumentId)
|
||||||
$ map (bimap (K.fromText . getFieldNameTxt) JO.fromOrdered)
|
$ KM.fromList
|
||||||
$ HashMap.toList
|
$ map (bimap (K.fromText . getFieldNameTxt) JO.fromOrdered)
|
||||||
$ unJoinArgument argument
|
$ HashMap.toList
|
||||||
rowSchema = fmap snd (_rsjJoinColumns remoteSourceJoin)
|
$ unJoinArgument argument
|
||||||
for (NE.nonEmpty rows) $ \nonEmptyRows -> do
|
rowSchema = fmap snd (_rsjJoinColumns remoteSourceJoin)
|
||||||
let sourceConfig = _rsjSourceConfig remoteSourceJoin
|
for (NE.nonEmpty rows) $ \nonEmptyRows -> do
|
||||||
stepInfo <-
|
let sourceConfig = _rsjSourceConfig remoteSourceJoin
|
||||||
EB.mkDBRemoteRelationshipPlan
|
Tracing.attachSourceConfigAttributes @b sourceConfig
|
||||||
userInfo
|
stepInfo <-
|
||||||
(_rsjSource remoteSourceJoin)
|
EB.mkDBRemoteRelationshipPlan
|
||||||
sourceConfig
|
userInfo
|
||||||
nonEmptyRows
|
(_rsjSource remoteSourceJoin)
|
||||||
rowSchema
|
sourceConfig
|
||||||
(FieldName "__argument_id__")
|
nonEmptyRows
|
||||||
(FieldName "f", _rsjRelationship remoteSourceJoin)
|
rowSchema
|
||||||
reqHeaders
|
(FieldName "__argument_id__")
|
||||||
operationName
|
(FieldName "f", _rsjRelationship remoteSourceJoin)
|
||||||
(_rsjStringifyNum remoteSourceJoin)
|
reqHeaders
|
||||||
-- This should never fail, as field names in remote relationships are
|
operationName
|
||||||
-- validated when building the schema cache.
|
(_rsjStringifyNum remoteSourceJoin)
|
||||||
fieldName <-
|
-- This should never fail, as field names in remote relationships are
|
||||||
G.mkName (getFieldNameTxt jaFieldName)
|
-- validated when building the schema cache.
|
||||||
`onNothing` throw500 ("'" <> getFieldNameTxt jaFieldName <> "' is not a valid GraphQL name")
|
fieldName <-
|
||||||
-- NOTE: We're making an assumption that the 'FieldName' propagated upwards
|
G.mkName (getFieldNameTxt jaFieldName)
|
||||||
-- from 'collectJoinArguments' is reasonable to use for logging.
|
`onNothing` throw500 ("'" <> getFieldNameTxt jaFieldName <> "' is not a valid GraphQL name")
|
||||||
let rootFieldAlias = mkUnNamespacedRootFieldAlias fieldName
|
-- NOTE: We're making an assumption that the 'FieldName' propagated upwards
|
||||||
pure
|
-- from 'collectJoinArguments' is reasonable to use for logging.
|
||||||
$ AB.mkAnyBackend
|
let rootFieldAlias = mkUnNamespacedRootFieldAlias fieldName
|
||||||
$ SourceJoinCall rootFieldAlias sourceConfig stepInfo
|
pure
|
||||||
|
$ AB.mkAnyBackend
|
||||||
|
$ SourceJoinCall rootFieldAlias sourceConfig stepInfo
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- Step 3: extracting the join index
|
-- Step 3: extracting the join index
|
||||||
|
@ -38,6 +38,7 @@ import Data.Environment qualified as Env
|
|||||||
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
|
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
|
||||||
import Data.Monoid (Any (..))
|
import Data.Monoid (Any (..))
|
||||||
import Data.Text qualified as T
|
import Data.Text qualified as T
|
||||||
|
import Data.Text.Extended ((<>>))
|
||||||
import Hasura.Backends.DataConnector.Agent.Client (AgentLicenseKey)
|
import Hasura.Backends.DataConnector.Agent.Client (AgentLicenseKey)
|
||||||
import Hasura.Backends.Postgres.Instances.Transport (runPGMutationTransaction)
|
import Hasura.Backends.Postgres.Instances.Transport (runPGMutationTransaction)
|
||||||
import Hasura.Base.Error
|
import Hasura.Base.Error
|
||||||
@ -90,6 +91,7 @@ import Hasura.Server.Types (ReadOnlyMode (..), RequestId (..))
|
|||||||
import Hasura.Services
|
import Hasura.Services
|
||||||
import Hasura.Session (SessionVariable, SessionVariableValue, SessionVariables, UserInfo (..), filterSessionVariables)
|
import Hasura.Session (SessionVariable, SessionVariableValue, SessionVariables, UserInfo (..), filterSessionVariables)
|
||||||
import Hasura.Tracing (MonadTrace, attachMetadata)
|
import Hasura.Tracing (MonadTrace, attachMetadata)
|
||||||
|
import Hasura.Tracing qualified as Tracing
|
||||||
import Language.GraphQL.Draft.Syntax qualified as G
|
import Language.GraphQL.Draft.Syntax qualified as G
|
||||||
import Network.HTTP.Types qualified as HTTP
|
import Network.HTTP.Types qualified as HTTP
|
||||||
import Network.Wai.Extended qualified as Wai
|
import Network.Wai.Extended qualified as Wai
|
||||||
@ -311,7 +313,7 @@ runGQ env sqlGenCtx sc scVer enableAL readOnlyMode prometheusMetrics logger agen
|
|||||||
let gqlMetrics = pmGraphQLRequestMetrics prometheusMetrics
|
let gqlMetrics = pmGraphQLRequestMetrics prometheusMetrics
|
||||||
|
|
||||||
(totalTime, (response, parameterizedQueryHash, gqlOpType)) <- withElapsedTime $ do
|
(totalTime, (response, parameterizedQueryHash, gqlOpType)) <- withElapsedTime $ do
|
||||||
(reqParsed, runLimits, queryParts) <- observeGQLQueryError gqlMetrics Nothing $ do
|
(reqParsed, runLimits, queryParts) <- Tracing.newSpan "Parse GraphQL" $ observeGQLQueryError gqlMetrics Nothing $ do
|
||||||
-- 1. Run system authorization on the 'reqUnparsed :: GQLReqUnparsed' query.
|
-- 1. Run system authorization on the 'reqUnparsed :: GQLReqUnparsed' query.
|
||||||
reqParsed <-
|
reqParsed <-
|
||||||
E.checkGQLExecution userInfo (reqHeaders, ipAddress) enableAL sc reqUnparsed reqId
|
E.checkGQLExecution userInfo (reqHeaders, ipAddress) enableAL sc reqUnparsed reqId
|
||||||
@ -378,8 +380,6 @@ runGQ env sqlGenCtx sc scVer enableAL readOnlyMode prometheusMetrics logger agen
|
|||||||
m AnnotatedResponse
|
m AnnotatedResponse
|
||||||
executePlan reqParsed runLimits execPlan = case execPlan of
|
executePlan reqParsed runLimits execPlan = case execPlan of
|
||||||
E.QueryExecutionPlan queryPlans asts dirMap -> do
|
E.QueryExecutionPlan queryPlans asts dirMap -> do
|
||||||
-- https://opentelemetry.io/docs/reference/specification/trace/semantic_conventions/instrumentation/graphql/
|
|
||||||
attachMetadata [("graphql.operation.type", "query")]
|
|
||||||
let cachedDirective = runIdentity <$> DM.lookup cached dirMap
|
let cachedDirective = runIdentity <$> DM.lookup cached dirMap
|
||||||
-- Attempt to lookup a cached response in the query cache.
|
-- Attempt to lookup a cached response in the query cache.
|
||||||
(cachingHeaders, cachedValue) <- liftEitherM $ cacheLookup queryPlans asts cachedDirective reqParsed userInfo reqHeaders
|
(cachingHeaders, cachedValue) <- liftEitherM $ cacheLookup queryPlans asts cachedDirective reqParsed userInfo reqHeaders
|
||||||
@ -424,8 +424,6 @@ runGQ env sqlGenCtx sc scVer enableAL readOnlyMode prometheusMetrics logger agen
|
|||||||
in -- 4. Return the response.
|
in -- 4. Return the response.
|
||||||
pure $ result {arResponse = addHttpResponseHeaders headers response}
|
pure $ result {arResponse = addHttpResponseHeaders headers response}
|
||||||
E.MutationExecutionPlan mutationPlans -> runLimits $ do
|
E.MutationExecutionPlan mutationPlans -> runLimits $ do
|
||||||
-- https://opentelemetry.io/docs/reference/specification/trace/semantic_conventions/instrumentation/graphql/
|
|
||||||
attachMetadata [("graphql.operation.type", "mutation")]
|
|
||||||
{- Note [Backwards-compatible transaction optimisation]
|
{- Note [Backwards-compatible transaction optimisation]
|
||||||
|
|
||||||
For backwards compatibility, we perform the following optimisation: if all mutation steps
|
For backwards compatibility, we perform the following optimisation: if all mutation steps
|
||||||
@ -528,7 +526,7 @@ runGQ env sqlGenCtx sc scVer enableAL readOnlyMode prometheusMetrics logger agen
|
|||||||
_all <- traverse (executeQueryStep fieldName) lst
|
_all <- traverse (executeQueryStep fieldName) lst
|
||||||
pure $ AnnotatedResponsePart 0 Telem.Local (encJFromList (map arpResponse _all)) []
|
pure $ AnnotatedResponsePart 0 Telem.Local (encJFromList (map arpResponse _all)) []
|
||||||
|
|
||||||
runRemoteGQ fieldName rsi resultCustomizer gqlReq remoteJoins = do
|
runRemoteGQ fieldName rsi resultCustomizer gqlReq remoteJoins = Tracing.newSpan ("Remote schema query for root field " <>> fieldName) $ do
|
||||||
(telemTimeIO_DT, remoteResponseHeaders, resp) <-
|
(telemTimeIO_DT, remoteResponseHeaders, resp) <-
|
||||||
doQErr $ E.execRemoteGQ env userInfo reqHeaders (rsDef rsi) gqlReq
|
doQErr $ E.execRemoteGQ env userInfo reqHeaders (rsDef rsi) gqlReq
|
||||||
value <- extractFieldFromResponse fieldName resultCustomizer resp
|
value <- extractFieldFromResponse fieldName resultCustomizer resp
|
||||||
|
@ -38,6 +38,7 @@ import Data.List.NonEmpty qualified as NE
|
|||||||
import Data.String
|
import Data.String
|
||||||
import Data.Text qualified as T
|
import Data.Text qualified as T
|
||||||
import Data.Text.Encoding qualified as TE
|
import Data.Text.Encoding qualified as TE
|
||||||
|
import Data.Text.Extended ((<>>))
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import Data.Time.Clock qualified as TC
|
import Data.Time.Clock qualified as TC
|
||||||
import Data.Word (Word16)
|
import Data.Word (Word16)
|
||||||
@ -469,10 +470,13 @@ onStart enabledLogTypes agentLicenseKey serverEnv wsConn shouldCaptureVariables
|
|||||||
sqlGenCtx <- liftIO $ acSQLGenCtx <$> getAppContext appStateRef
|
sqlGenCtx <- liftIO $ acSQLGenCtx <$> getAppContext appStateRef
|
||||||
enableAL <- liftIO $ acEnableAllowlist <$> getAppContext appStateRef
|
enableAL <- liftIO $ acEnableAllowlist <$> getAppContext appStateRef
|
||||||
|
|
||||||
reqParsedE <- lift $ E.checkGQLExecution userInfo (reqHdrs, ipAddress) enableAL sc q requestId
|
(reqParsed, queryParts) <- Tracing.newSpan "Parse GraphQL" $ do
|
||||||
reqParsed <- onLeft reqParsedE (withComplete . preExecErr requestId Nothing)
|
reqParsedE <- lift $ E.checkGQLExecution userInfo (reqHdrs, ipAddress) enableAL sc q requestId
|
||||||
queryPartsE <- runExceptT $ getSingleOperation reqParsed
|
reqParsed <- onLeft reqParsedE (withComplete . preExecErr requestId Nothing)
|
||||||
queryParts <- onLeft queryPartsE (withComplete . preExecErr requestId Nothing)
|
queryPartsE <- runExceptT $ getSingleOperation reqParsed
|
||||||
|
queryParts <- onLeft queryPartsE (withComplete . preExecErr requestId Nothing)
|
||||||
|
pure (reqParsed, queryParts)
|
||||||
|
|
||||||
let gqlOpType = G._todType queryParts
|
let gqlOpType = G._todType queryParts
|
||||||
maybeOperationName = _unOperationName <$> _grOperationName reqParsed
|
maybeOperationName = _unOperationName <$> _grOperationName reqParsed
|
||||||
for_ maybeOperationName $ \nm ->
|
for_ maybeOperationName $ \nm ->
|
||||||
@ -500,8 +504,6 @@ onStart enabledLogTypes agentLicenseKey serverEnv wsConn shouldCaptureVariables
|
|||||||
|
|
||||||
case execPlan of
|
case execPlan of
|
||||||
E.QueryExecutionPlan queryPlan asts dirMap -> do
|
E.QueryExecutionPlan queryPlan asts dirMap -> do
|
||||||
-- https://opentelemetry.io/docs/reference/specification/trace/semantic_conventions/instrumentation/graphql/
|
|
||||||
Tracing.attachMetadata [("graphql.operation.type", "query")]
|
|
||||||
let cachedDirective = runIdentity <$> DM.lookup cached dirMap
|
let cachedDirective = runIdentity <$> DM.lookup cached dirMap
|
||||||
|
|
||||||
-- We ignore the response headers (containing TTL information) because
|
-- We ignore the response headers (containing TTL information) because
|
||||||
@ -571,8 +573,6 @@ onStart enabledLogTypes agentLicenseKey serverEnv wsConn shouldCaptureVariables
|
|||||||
|
|
||||||
liftIO $ sendCompleted (Just requestId) (Just parameterizedQueryHash)
|
liftIO $ sendCompleted (Just requestId) (Just parameterizedQueryHash)
|
||||||
E.MutationExecutionPlan mutationPlan -> do
|
E.MutationExecutionPlan mutationPlan -> do
|
||||||
-- https://opentelemetry.io/docs/reference/specification/trace/semantic_conventions/instrumentation/graphql/
|
|
||||||
Tracing.attachMetadata [("graphql.operation.type", "mutation")]
|
|
||||||
-- See Note [Backwards-compatible transaction optimisation]
|
-- See Note [Backwards-compatible transaction optimisation]
|
||||||
case coalescePostgresMutations mutationPlan of
|
case coalescePostgresMutations mutationPlan of
|
||||||
-- we are in the aforementioned case; we circumvent the normal process
|
-- we are in the aforementioned case; we circumvent the normal process
|
||||||
@ -643,8 +643,6 @@ onStart enabledLogTypes agentLicenseKey serverEnv wsConn shouldCaptureVariables
|
|||||||
sendResultFromFragments Telem.Query timerTot requestId conclusion opName parameterizedQueryHash gqlOpType
|
sendResultFromFragments Telem.Query timerTot requestId conclusion opName parameterizedQueryHash gqlOpType
|
||||||
liftIO $ sendCompleted (Just requestId) (Just parameterizedQueryHash)
|
liftIO $ sendCompleted (Just requestId) (Just parameterizedQueryHash)
|
||||||
E.SubscriptionExecutionPlan subExec -> do
|
E.SubscriptionExecutionPlan subExec -> do
|
||||||
-- https://opentelemetry.io/docs/reference/specification/trace/semantic_conventions/instrumentation/graphql/
|
|
||||||
Tracing.attachMetadata [("graphql.operation.type", "subscription")]
|
|
||||||
case subExec of
|
case subExec of
|
||||||
E.SEAsyncActionsWithNoRelationships actions -> do
|
E.SEAsyncActionsWithNoRelationships actions -> do
|
||||||
logQueryLog logger $ QueryLog q Nothing requestId QueryLogKindAction
|
logQueryLog logger $ QueryLog q Nothing requestId QueryLogKindAction
|
||||||
@ -782,7 +780,7 @@ onStart enabledLogTypes agentLicenseKey serverEnv wsConn shouldCaptureVariables
|
|||||||
GQLReqOutgoing ->
|
GQLReqOutgoing ->
|
||||||
Maybe RJ.RemoteJoins ->
|
Maybe RJ.RemoteJoins ->
|
||||||
ExceptT (Either GQExecError QErr) (ExceptT () m) AnnotatedResponsePart
|
ExceptT (Either GQExecError QErr) (ExceptT () m) AnnotatedResponsePart
|
||||||
runRemoteGQ requestId reqUnparsed fieldName userInfo reqHdrs rsi resultCustomizer gqlReq remoteJoins = do
|
runRemoteGQ requestId reqUnparsed fieldName userInfo reqHdrs rsi resultCustomizer gqlReq remoteJoins = Tracing.newSpan ("Remote schema query for root field " <>> fieldName) $ do
|
||||||
env <- liftIO $ acEnvironment <$> getAppContext appStateRef
|
env <- liftIO $ acEnvironment <$> getAppContext appStateRef
|
||||||
(telemTimeIO_DT, _respHdrs, resp) <-
|
(telemTimeIO_DT, _respHdrs, resp) <-
|
||||||
doQErr
|
doQErr
|
||||||
|
@ -41,3 +41,5 @@ class
|
|||||||
-- | Whether the source configuration specifies the use of a connection
|
-- | Whether the source configuration specifies the use of a connection
|
||||||
-- template
|
-- template
|
||||||
sourceConfigConnectonTemplateEnabled :: SourceConfig b -> Bool
|
sourceConfigConnectonTemplateEnabled :: SourceConfig b -> Bool
|
||||||
|
|
||||||
|
sourceConfigBackendSourceKind :: SourceConfig b -> BackendSourceKind b
|
||||||
|
@ -4,12 +4,15 @@
|
|||||||
-- here in the core engine code.
|
-- here in the core engine code.
|
||||||
module Hasura.Tracing.Utils
|
module Hasura.Tracing.Utils
|
||||||
( traceHTTPRequest,
|
( traceHTTPRequest,
|
||||||
|
attachSourceConfigAttributes,
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Data.String
|
import Data.String
|
||||||
|
import Data.Text.Extended (toTxt)
|
||||||
import Hasura.Prelude
|
import Hasura.Prelude
|
||||||
|
import Hasura.RQL.Types.SourceConfiguration (HasSourceConfiguration (..))
|
||||||
import Hasura.Tracing.Class
|
import Hasura.Tracing.Class
|
||||||
import Hasura.Tracing.Context
|
import Hasura.Tracing.Context
|
||||||
import Hasura.Tracing.Sampling
|
import Hasura.Tracing.Sampling
|
||||||
@ -47,3 +50,8 @@ traceHTTPRequest req f = do
|
|||||||
("X-B3-ParentSpanId",) . spanIdToHex <$> tcCurrentParent,
|
("X-B3-ParentSpanId",) . spanIdToHex <$> tcCurrentParent,
|
||||||
("X-B3-Sampled",) <$> samplingStateToHeader tcSamplingState
|
("X-B3-Sampled",) <$> samplingStateToHeader tcSamplingState
|
||||||
]
|
]
|
||||||
|
|
||||||
|
attachSourceConfigAttributes :: forall b m. (HasSourceConfiguration b, MonadTrace m) => SourceConfig b -> m ()
|
||||||
|
attachSourceConfigAttributes sourceConfig = do
|
||||||
|
let backendSourceKind = sourceConfigBackendSourceKind @b sourceConfig
|
||||||
|
attachMetadata [("source.kind", toTxt $ backendSourceKind)]
|
||||||
|
Loading…
Reference in New Issue
Block a user