module Hasura.GraphQL.Execute.Mutation
  ( convertMutationSelectionSet,
  )
where

import Data.Environment qualified as Env
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.Tagged qualified as Tagged
import Data.Text.Extended ((<>>))
import Hasura.Base.Error
import Hasura.GraphQL.Context
import Hasura.GraphQL.Execute.Action
import Hasura.GraphQL.Execute.Backend
import Hasura.GraphQL.Execute.Common
import Hasura.GraphQL.Execute.Instances ()
import Hasura.GraphQL.Execute.Remote
import Hasura.GraphQL.Execute.RemoteJoin.Collect qualified as RJ
import Hasura.GraphQL.Execute.Resolve
import Hasura.GraphQL.Namespace
import Hasura.GraphQL.ParameterizedQueryHash
import Hasura.GraphQL.Parser.Directives
import Hasura.GraphQL.Parser.Variable qualified as G
import Hasura.GraphQL.Schema.Parser (runParse, toQErr)
import Hasura.GraphQL.Transport.HTTP.Protocol qualified as GH
import Hasura.Logging qualified as L
import Hasura.Metadata.Class
import Hasura.Prelude
import Hasura.QueryTags
import Hasura.QueryTags.Types
import Hasura.RQL.IR
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.GraphqlSchemaIntrospection
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.Server.Prometheus (PrometheusMetrics (..))
import Hasura.Server.Types
import Hasura.Services
import Hasura.Session
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Syntax qualified as G
import Network.HTTP.Types qualified as HTTP

convertMutationAction ::
  ( MonadIO m,
    MonadError QErr m,
    MonadMetadataStorage m,
    ProvidesNetwork m
  ) =>
  Env.Environment ->
  L.Logger L.Hasura ->
  PrometheusMetrics ->
  UserInfo ->
  HTTP.RequestHeaders ->
  Maybe GH.GQLQueryText ->
  ActionMutation Void ->
  m ActionExecutionPlan
convertMutationAction :: forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadMetadataStorage m,
 ProvidesNetwork m) =>
Environment
-> Logger Hasura
-> PrometheusMetrics
-> UserInfo
-> RequestHeaders
-> Maybe GQLQueryText
-> ActionMutation Void
-> m ActionExecutionPlan
convertMutationAction Environment
env Logger Hasura
logger PrometheusMetrics
prometheusMetrics UserInfo
userInfo RequestHeaders
reqHeaders Maybe GQLQueryText
gqlQueryText ActionMutation Void
action = do
  Manager
httpManager <- m Manager
forall (m :: * -> *). ProvidesNetwork m => m Manager
askHTTPManager
  case ActionMutation Void
action of
    AMSync AnnActionExecution Void
s ->
      ActionExecutionPlan -> m ActionExecutionPlan
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionExecutionPlan -> m ActionExecutionPlan)
-> ActionExecutionPlan -> m ActionExecutionPlan
forall a b. (a -> b) -> a -> b
$ ActionExecution -> ActionExecutionPlan
AEPSync (ActionExecution -> ActionExecutionPlan)
-> ActionExecution -> ActionExecutionPlan
forall a b. (a -> b) -> a -> b
$ Manager
-> Environment
-> Logger Hasura
-> PrometheusMetrics
-> AnnActionExecution Void
-> ActionExecContext
-> Maybe GQLQueryText
-> ActionExecution
resolveActionExecution Manager
httpManager Environment
env Logger Hasura
logger PrometheusMetrics
prometheusMetrics AnnActionExecution Void
s ActionExecContext
actionExecContext Maybe GQLQueryText
gqlQueryText
    AMAsync AnnActionMutationAsync
s ->
      ActionId -> ActionExecutionPlan
AEPAsyncMutation (ActionId -> ActionExecutionPlan)
-> m ActionId -> m ActionExecutionPlan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AnnActionMutationAsync
-> RequestHeaders -> SessionVariables -> m ActionId
forall (m :: * -> *).
(MonadMetadataStorage m, MonadError QErr m) =>
AnnActionMutationAsync
-> RequestHeaders -> SessionVariables -> m ActionId
resolveActionMutationAsync AnnActionMutationAsync
s RequestHeaders
reqHeaders SessionVariables
userSession
  where
    userSession :: SessionVariables
userSession = UserInfo -> SessionVariables
_uiSession UserInfo
userInfo
    actionExecContext :: ActionExecContext
actionExecContext = RequestHeaders -> SessionVariables -> ActionExecContext
ActionExecContext RequestHeaders
reqHeaders (UserInfo -> SessionVariables
_uiSession UserInfo
userInfo)

convertMutationSelectionSet ::
  forall m.
  ( Tracing.MonadTrace m,
    MonadIO m,
    MonadError QErr m,
    MonadMetadataStorage m,
    MonadGQLExecutionCheck m,
    MonadQueryTags m,
    ProvidesNetwork m
  ) =>
  Env.Environment ->
  L.Logger L.Hasura ->
  PrometheusMetrics ->
  GQLContext ->
  SQLGenCtx ->
  UserInfo ->
  HTTP.RequestHeaders ->
  [G.Directive G.Name] ->
  G.SelectionSet G.NoFragments G.Name ->
  [G.VariableDefinition] ->
  GH.GQLReqUnparsed ->
  SetGraphqlIntrospectionOptions ->
  RequestId ->
  -- | Graphql Operation Name
  Maybe G.Name ->
  m (ExecutionPlan, ParameterizedQueryHash)
convertMutationSelectionSet :: forall (m :: * -> *).
(MonadTrace m, MonadIO m, MonadError QErr m,
 MonadMetadataStorage m, MonadGQLExecutionCheck m, MonadQueryTags m,
 ProvidesNetwork m) =>
Environment
-> Logger Hasura
-> PrometheusMetrics
-> GQLContext
-> SQLGenCtx
-> UserInfo
-> RequestHeaders
-> [Directive Name]
-> SelectionSet NoFragments Name
-> [VariableDefinition]
-> GQLReqUnparsed
-> SetGraphqlIntrospectionOptions
-> RequestId
-> Maybe Name
-> m (ExecutionPlan, ParameterizedQueryHash)
convertMutationSelectionSet
  Environment
env
  Logger Hasura
logger
  PrometheusMetrics
prometheusMetrics
  GQLContext
gqlContext
  SQLGenCtx {StringifyNumbers
stringifyNum :: StringifyNumbers
stringifyNum :: SQLGenCtx -> StringifyNumbers
stringifyNum}
  UserInfo
userInfo
  RequestHeaders
reqHeaders
  [Directive Name]
directives
  SelectionSet NoFragments Name
fields
  [VariableDefinition]
varDefs
  GQLReqUnparsed
gqlUnparsed
  SetGraphqlIntrospectionOptions
introspectionDisabledRoles
  RequestId
reqId
  Maybe Name
maybeOperationName = do
    ParserFn (RootFieldMap (MutationRootField UnpreparedValue))
mutationParser <-
      Maybe (ParserFn (RootFieldMap (MutationRootField UnpreparedValue)))
-> m (ParserFn (RootFieldMap (MutationRootField UnpreparedValue)))
-> m (ParserFn (RootFieldMap (MutationRootField UnpreparedValue)))
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (GQLContext
-> Maybe
     (ParserFn (RootFieldMap (MutationRootField UnpreparedValue)))
gqlMutationParser GQLContext
gqlContext)
        (m (ParserFn (RootFieldMap (MutationRootField UnpreparedValue)))
 -> m (ParserFn (RootFieldMap (MutationRootField UnpreparedValue))))
-> m (ParserFn (RootFieldMap (MutationRootField UnpreparedValue)))
-> m (ParserFn (RootFieldMap (MutationRootField UnpreparedValue)))
forall a b. (a -> b) -> a -> b
$ Code
-> Text
-> m (ParserFn (RootFieldMap (MutationRootField UnpreparedValue)))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ValidationFailed Text
"no mutations exist"

    ([Directive Variable]
resolvedDirectives, SelectionSet NoFragments Variable
resolvedSelSet) <- [VariableDefinition]
-> VariableValues
-> [Directive Name]
-> SelectionSet NoFragments Name
-> m ([Directive Variable], SelectionSet NoFragments Variable)
forall (m :: * -> *) (fragments :: * -> *).
(MonadError QErr m, Traversable fragments) =>
[VariableDefinition]
-> VariableValues
-> [Directive Name]
-> SelectionSet fragments Name
-> m ([Directive Variable], SelectionSet fragments Variable)
resolveVariables [VariableDefinition]
varDefs (VariableValues -> Maybe VariableValues -> VariableValues
forall a. a -> Maybe a -> a
fromMaybe VariableValues
forall k v. HashMap k v
HashMap.empty (GQLReqUnparsed -> Maybe VariableValues
forall a. GQLReq a -> Maybe VariableValues
GH._grVariables GQLReqUnparsed
gqlUnparsed)) [Directive Name]
directives SelectionSet NoFragments Name
fields
    -- Parse the GraphQL query into the RQL AST
    (RootFieldMap (MutationRootField UnpreparedValue)
unpreparedQueries :: RootFieldMap (MutationRootField UnpreparedValue)) <-
      Text
-> m (RootFieldMap (MutationRootField UnpreparedValue))
-> m (RootFieldMap (MutationRootField UnpreparedValue))
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m) =>
Text -> m a -> m a
Tracing.newSpan Text
"Parse mutation IR" (m (RootFieldMap (MutationRootField UnpreparedValue))
 -> m (RootFieldMap (MutationRootField UnpreparedValue)))
-> m (RootFieldMap (MutationRootField UnpreparedValue))
-> m (RootFieldMap (MutationRootField UnpreparedValue))
forall a b. (a -> b) -> a -> b
$ Either QErr (RootFieldMap (MutationRootField UnpreparedValue))
-> m (RootFieldMap (MutationRootField UnpreparedValue))
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either QErr (RootFieldMap (MutationRootField UnpreparedValue))
 -> m (RootFieldMap (MutationRootField UnpreparedValue)))
-> Either QErr (RootFieldMap (MutationRootField UnpreparedValue))
-> m (RootFieldMap (MutationRootField UnpreparedValue))
forall a b. (a -> b) -> a -> b
$ ParserFn (RootFieldMap (MutationRootField UnpreparedValue))
mutationParser SelectionSet NoFragments Variable
resolvedSelSet

    -- Process directives on the mutation
    DirectiveMap
_dirMap <- Either ParseError DirectiveMap -> m DirectiveMap
forall (m :: * -> *) a.
MonadError QErr m =>
Either ParseError a -> m a
toQErr (Either ParseError DirectiveMap -> m DirectiveMap)
-> Either ParseError DirectiveMap -> m DirectiveMap
forall a b. (a -> b) -> a -> b
$ Parse DirectiveMap -> Either ParseError DirectiveMap
forall (m :: * -> *) a. MonadError ParseError m => Parse a -> m a
runParse ([Directive Any Parse]
-> DirectiveLocation -> [Directive Variable] -> Parse DirectiveMap
forall origin (m :: * -> *).
MonadParse m =>
[Directive origin m]
-> DirectiveLocation -> [Directive Variable] -> m DirectiveMap
parseDirectives [Directive Any Parse]
forall (m :: * -> *) origin. MonadParse m => [Directive origin m]
customDirectives (ExecutableDirectiveLocation -> DirectiveLocation
G.DLExecutable ExecutableDirectiveLocation
G.EDLMUTATION) [Directive Variable]
resolvedDirectives)
    let parameterizedQueryHash :: ParameterizedQueryHash
parameterizedQueryHash = SelectionSet NoFragments Variable -> ParameterizedQueryHash
calculateParameterizedQueryHash SelectionSet NoFragments Variable
resolvedSelSet

        resolveExecutionSteps :: RootFieldAlias
-> MutationRootField UnpreparedValue -> m ExecutionStep
resolveExecutionSteps RootFieldAlias
rootFieldName MutationRootField UnpreparedValue
rootFieldUnpreparedValue = Text -> m ExecutionStep -> m ExecutionStep
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m) =>
Text -> m a -> m a
Tracing.newSpan (Text
"Resolve execution step for " Text -> RootFieldAlias -> Text
forall t. ToTxt t => Text -> t -> Text
<>> RootFieldAlias
rootFieldName) do
          case MutationRootField UnpreparedValue
rootFieldUnpreparedValue of
            RFDB SourceName
sourceName AnyBackend
  (SourceConfigWith
     (MutationDBRoot
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
exists ->
              forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @BackendExecute
                AnyBackend
  (SourceConfigWith
     (MutationDBRoot
        (RemoteRelationshipField UnpreparedValue) UnpreparedValue))
exists
                \(SourceConfigWith (SourceConfig b
sourceConfig :: SourceConfig b) Maybe QueryTagsConfig
queryTagsConfig (MDBR MutationDB
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
db)) -> do
                  let mReqId :: Maybe RequestId
mReqId =
                        case QueryTagsConfig -> Bool
_qtcOmitRequestId (QueryTagsConfig -> Bool) -> Maybe QueryTagsConfig -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe QueryTagsConfig
queryTagsConfig of
                          -- we include the request id only if a user explicitly wishes for it to be included.
                          Just Bool
False -> RequestId -> Maybe RequestId
forall a. a -> Maybe a
Just RequestId
reqId
                          Maybe Bool
_ -> Maybe RequestId
forall a. Maybe a
Nothing
                      mutationQueryTagsAttributes :: QueryTagsAttributes
mutationQueryTagsAttributes = QueryTags -> QueryTagsAttributes
encodeQueryTags (QueryTags -> QueryTagsAttributes)
-> QueryTags -> QueryTagsAttributes
forall a b. (a -> b) -> a -> b
$ MutationMetadata -> QueryTags
QTMutation (MutationMetadata -> QueryTags) -> MutationMetadata -> QueryTags
forall a b. (a -> b) -> a -> b
$ Maybe RequestId
-> Maybe Name
-> RootFieldAlias
-> ParameterizedQueryHash
-> MutationMetadata
MutationMetadata Maybe RequestId
mReqId Maybe Name
maybeOperationName RootFieldAlias
rootFieldName ParameterizedQueryHash
parameterizedQueryHash
                      queryTagsComment :: QueryTagsComment
queryTagsComment = Tagged m QueryTagsComment -> QueryTagsComment
forall {k} (s :: k) b. Tagged s b -> b
Tagged.untag (Tagged m QueryTagsComment -> QueryTagsComment)
-> Tagged m QueryTagsComment -> QueryTagsComment
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadQueryTags m =>
QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged m QueryTagsComment
createQueryTags @m QueryTagsAttributes
mutationQueryTagsAttributes Maybe QueryTagsConfig
queryTagsConfig
                      (MutationDB b Void (UnpreparedValue b)
noRelsDBAST, Maybe RemoteJoins
remoteJoins) = MutationDB
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> (MutationDB b Void (UnpreparedValue b), Maybe RemoteJoins)
forall (b :: BackendType).
Backend b =>
MutationDB
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> (MutationDB b Void (UnpreparedValue b), Maybe RemoteJoins)
RJ.getRemoteJoinsMutationDB MutationDB
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
db

                  Manager
httpManager <- m Manager
forall (m :: * -> *). ProvidesNetwork m => m Manager
askHTTPManager
                  let selSetArguments :: Maybe (HashMap Name (Value Variable))
selSetArguments = SelectionSet NoFragments Variable
-> RootFieldAlias -> Maybe (HashMap Name (Value Variable))
getSelSetArgsFromRootField SelectionSet NoFragments Variable
resolvedSelSet RootFieldAlias
rootFieldName
                  DBStepInfo b
dbStepInfo <- (ReaderT QueryTagsComment m (DBStepInfo b)
 -> QueryTagsComment -> m (DBStepInfo b))
-> QueryTagsComment
-> ReaderT QueryTagsComment m (DBStepInfo b)
-> m (DBStepInfo b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT QueryTagsComment m (DBStepInfo b)
-> QueryTagsComment -> m (DBStepInfo b)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT QueryTagsComment
queryTagsComment (ReaderT QueryTagsComment m (DBStepInfo b) -> m (DBStepInfo b))
-> ReaderT QueryTagsComment m (DBStepInfo b) -> m (DBStepInfo b)
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) (m :: * -> *).
(BackendExecute b, MonadError QErr m, MonadIO m, MonadQueryTags m,
 MonadReader QueryTagsComment m, MonadTrace m) =>
Environment
-> Manager
-> Logger Hasura
-> UserInfo
-> StringifyNumbers
-> SourceName
-> SourceConfig b
-> MutationDB b Void (UnpreparedValue b)
-> RequestHeaders
-> Maybe Name
-> Maybe (HashMap Name (Value Variable))
-> m (DBStepInfo b)
mkDBMutationPlan @b Environment
env Manager
httpManager Logger Hasura
logger UserInfo
userInfo StringifyNumbers
stringifyNum SourceName
sourceName SourceConfig b
sourceConfig MutationDB b Void (UnpreparedValue b)
noRelsDBAST RequestHeaders
reqHeaders Maybe Name
maybeOperationName Maybe (HashMap Name (Value Variable))
selSetArguments
                  ExecutionStep -> m ExecutionStep
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecutionStep -> m ExecutionStep)
-> ExecutionStep -> m ExecutionStep
forall a b. (a -> b) -> a -> b
$ RequestHeaders
-> AnyBackend DBStepInfo -> Maybe RemoteJoins -> ExecutionStep
ExecStepDB [] (DBStepInfo b -> AnyBackend DBStepInfo
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend DBStepInfo b
dbStepInfo) Maybe RemoteJoins
remoteJoins
            RFRemote RemoteSchemaRootField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
remoteField -> do
              RemoteSchemaRootField RemoteSchemaInfo
remoteSchemaInfo ResultCustomizer
resultCustomizer GraphQLField (RemoteRelationshipField UnpreparedValue) Variable
resolvedRemoteField <- StateT
  RemoteJSONVariableMap
  m
  (RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) Variable)
-> m (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) Variable)
forall (m :: * -> *) a.
Monad m =>
StateT RemoteJSONVariableMap m a -> m a
runVariableCache (StateT
   RemoteJSONVariableMap
   m
   (RemoteSchemaRootField
      (RemoteRelationshipField UnpreparedValue) Variable)
 -> m (RemoteSchemaRootField
         (RemoteRelationshipField UnpreparedValue) Variable))
-> StateT
     RemoteJSONVariableMap
     m
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) Variable)
-> m (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) Variable)
forall a b. (a -> b) -> a -> b
$ UserInfo
-> RemoteSchemaRootField
     (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
-> StateT
     RemoteJSONVariableMap
     m
     (RemoteSchemaRootField
        (RemoteRelationshipField UnpreparedValue) Variable)
forall (m :: * -> *) r.
MonadError QErr m =>
UserInfo
-> RemoteSchemaRootField r RemoteSchemaVariable
-> StateT
     RemoteJSONVariableMap m (RemoteSchemaRootField r Variable)
resolveRemoteField UserInfo
userInfo RemoteSchemaRootField
  (RemoteRelationshipField UnpreparedValue) RemoteSchemaVariable
remoteField
              let (GraphQLField Void Variable
noRelsRemoteField, Maybe RemoteJoins
remoteJoins) = GraphQLField (RemoteRelationshipField UnpreparedValue) Variable
-> (GraphQLField Void Variable, Maybe RemoteJoins)
forall var.
GraphQLField (RemoteRelationshipField UnpreparedValue) var
-> (GraphQLField Void var, Maybe RemoteJoins)
RJ.getRemoteJoinsGraphQLField GraphQLField (RemoteRelationshipField UnpreparedValue) Variable
resolvedRemoteField
              ExecutionStep -> m ExecutionStep
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                (ExecutionStep -> m ExecutionStep)
-> ExecutionStep -> m ExecutionStep
forall a b. (a -> b) -> a -> b
$ RemoteSchemaInfo
-> ResultCustomizer
-> OperationType
-> GraphQLField Void Variable
-> Maybe RemoteJoins
-> Maybe OperationName
-> ExecutionStep
buildExecStepRemote RemoteSchemaInfo
remoteSchemaInfo ResultCustomizer
resultCustomizer OperationType
G.OperationTypeMutation GraphQLField Void Variable
noRelsRemoteField Maybe RemoteJoins
remoteJoins (GQLReqUnparsed -> Maybe OperationName
forall a. GQLReq a -> Maybe OperationName
GH._grOperationName GQLReqUnparsed
gqlUnparsed)
            RFAction ActionMutation (RemoteRelationshipField UnpreparedValue)
action -> do
              let (ActionMutation Void
noRelsDBAST, Maybe RemoteJoins
remoteJoins) = ActionMutation (RemoteRelationshipField UnpreparedValue)
-> (ActionMutation Void, Maybe RemoteJoins)
RJ.getRemoteJoinsActionMutation ActionMutation (RemoteRelationshipField UnpreparedValue)
action
              (ActionName
actionName, Bool
_fch) <- (ActionName, Bool) -> m (ActionName, Bool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ActionName, Bool) -> m (ActionName, Bool))
-> (ActionName, Bool) -> m (ActionName, Bool)
forall a b. (a -> b) -> a -> b
$ case ActionMutation Void
noRelsDBAST of
                AMSync AnnActionExecution Void
s -> (AnnActionExecution Void -> ActionName
forall r. AnnActionExecution r -> ActionName
_aaeName AnnActionExecution Void
s, AnnActionExecution Void -> Bool
forall r. AnnActionExecution r -> Bool
_aaeForwardClientHeaders AnnActionExecution Void
s)
                AMAsync AnnActionMutationAsync
s -> (AnnActionMutationAsync -> ActionName
_aamaName AnnActionMutationAsync
s, AnnActionMutationAsync -> Bool
_aamaForwardClientHeaders AnnActionMutationAsync
s)
              ActionExecutionPlan
plan <- Environment
-> Logger Hasura
-> PrometheusMetrics
-> UserInfo
-> RequestHeaders
-> Maybe GQLQueryText
-> ActionMutation Void
-> m ActionExecutionPlan
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadMetadataStorage m,
 ProvidesNetwork m) =>
Environment
-> Logger Hasura
-> PrometheusMetrics
-> UserInfo
-> RequestHeaders
-> Maybe GQLQueryText
-> ActionMutation Void
-> m ActionExecutionPlan
convertMutationAction Environment
env Logger Hasura
logger PrometheusMetrics
prometheusMetrics UserInfo
userInfo RequestHeaders
reqHeaders (GQLQueryText -> Maybe GQLQueryText
forall a. a -> Maybe a
Just (GQLReqUnparsed -> GQLQueryText
forall a. GQLReq a -> a
GH._grQuery GQLReqUnparsed
gqlUnparsed)) ActionMutation Void
noRelsDBAST
              ExecutionStep -> m ExecutionStep
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecutionStep -> m ExecutionStep)
-> ExecutionStep -> m ExecutionStep
forall a b. (a -> b) -> a -> b
$ ActionExecutionPlan
-> ActionsInfo -> Maybe RemoteJoins -> ExecutionStep
ExecStepAction ActionExecutionPlan
plan (ActionName -> Bool -> ActionsInfo
ActionsInfo ActionName
actionName Bool
_fch) Maybe RemoteJoins
remoteJoins -- `_fch` represents the `forward_client_headers` option from the action
              -- definition which is currently being ignored for actions that are mutations
            RFRaw Value
customFieldVal -> (Either QErr ExecutionStep
 -> (QErr -> m ExecutionStep) -> m ExecutionStep)
-> (QErr -> m ExecutionStep)
-> Either QErr ExecutionStep
-> m ExecutionStep
forall a b c. (a -> b -> c) -> b -> a -> c
flip Either QErr ExecutionStep
-> (QErr -> m ExecutionStep) -> m ExecutionStep
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
onLeft QErr -> m ExecutionStep
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Either QErr ExecutionStep -> m ExecutionStep)
-> m (Either QErr ExecutionStep) -> m ExecutionStep
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UserInfo
-> Value
-> SetGraphqlIntrospectionOptions
-> m (Either QErr ExecutionStep)
forall (m :: * -> *).
MonadGQLExecutionCheck m =>
UserInfo
-> Value
-> SetGraphqlIntrospectionOptions
-> m (Either QErr ExecutionStep)
executeIntrospection UserInfo
userInfo Value
customFieldVal SetGraphqlIntrospectionOptions
introspectionDisabledRoles
            RFMulti [MutationRootField UnpreparedValue]
lst -> do
              [ExecutionStep]
allSteps <- (MutationRootField UnpreparedValue -> m ExecutionStep)
-> [MutationRootField UnpreparedValue] -> m [ExecutionStep]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (RootFieldAlias
-> MutationRootField UnpreparedValue -> m ExecutionStep
resolveExecutionSteps RootFieldAlias
rootFieldName) [MutationRootField UnpreparedValue]
lst
              ExecutionStep -> m ExecutionStep
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecutionStep -> m ExecutionStep)
-> ExecutionStep -> m ExecutionStep
forall a b. (a -> b) -> a -> b
$ [ExecutionStep] -> ExecutionStep
ExecStepMulti [ExecutionStep]
allSteps

    -- Transform the RQL AST into a prepared SQL query
    ExecutionPlan
txs <- ((RootFieldAlias
  -> MutationRootField UnpreparedValue -> m ExecutionStep)
 -> RootFieldMap (MutationRootField UnpreparedValue)
 -> m ExecutionPlan)
-> RootFieldMap (MutationRootField UnpreparedValue)
-> (RootFieldAlias
    -> MutationRootField UnpreparedValue -> m ExecutionStep)
-> m ExecutionPlan
forall a b c. (a -> b -> c) -> b -> a -> c
flip (RootFieldAlias
 -> MutationRootField UnpreparedValue -> m ExecutionStep)
-> RootFieldMap (MutationRootField UnpreparedValue)
-> m ExecutionPlan
forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f b) -> InsOrdHashMap k a -> f (InsOrdHashMap k b)
InsOrdHashMap.traverseWithKey RootFieldMap (MutationRootField UnpreparedValue)
unpreparedQueries ((RootFieldAlias
  -> MutationRootField UnpreparedValue -> m ExecutionStep)
 -> m ExecutionPlan)
-> (RootFieldAlias
    -> MutationRootField UnpreparedValue -> m ExecutionStep)
-> m ExecutionPlan
forall a b. (a -> b) -> a -> b
$ RootFieldAlias
-> MutationRootField UnpreparedValue -> m ExecutionStep
resolveExecutionSteps
    (ExecutionPlan, ParameterizedQueryHash)
-> m (ExecutionPlan, ParameterizedQueryHash)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExecutionPlan
txs, ParameterizedQueryHash
parameterizedQueryHash)

-- | Extract the arguments from the selection set for a root field
-- This is used to validate the arguments of a mutation.
getSelSetArgsFromRootField :: G.SelectionSet G.NoFragments G.Variable -> RootFieldAlias -> Maybe (HashMap G.Name (G.Value G.Variable))
getSelSetArgsFromRootField :: SelectionSet NoFragments Variable
-> RootFieldAlias -> Maybe (HashMap Name (Value Variable))
getSelSetArgsFromRootField SelectionSet NoFragments Variable
selSet RootFieldAlias
rootFieldName = do
  let maybeSelSet :: Maybe (Selection NoFragments Variable)
maybeSelSet =
        case RootFieldAlias
rootFieldName of
          RootFieldAlias Maybe Name
Nothing Name
alias -> Name
-> SelectionSet NoFragments Variable
-> Maybe (Selection NoFragments Variable)
forall {t :: * -> *} {frag :: * -> *} {var}.
Foldable t =>
Name -> t (Selection frag var) -> Maybe (Selection frag var)
getSelSet Name
alias SelectionSet NoFragments Variable
selSet
          RootFieldAlias (Just Name
namespace) Name
alias -> do
            let namespaceSelSet :: Maybe (Selection NoFragments Variable)
namespaceSelSet = Name
-> SelectionSet NoFragments Variable
-> Maybe (Selection NoFragments Variable)
forall {t :: * -> *} {frag :: * -> *} {var}.
Foldable t =>
Name -> t (Selection frag var) -> Maybe (Selection frag var)
getSelSet Name
namespace SelectionSet NoFragments Variable
selSet
            case Maybe (Selection NoFragments Variable)
namespaceSelSet of
              Just (G.SelectionField Field NoFragments Variable
fld) -> Name
-> SelectionSet NoFragments Variable
-> Maybe (Selection NoFragments Variable)
forall {t :: * -> *} {frag :: * -> *} {var}.
Foldable t =>
Name -> t (Selection frag var) -> Maybe (Selection frag var)
getSelSet Name
alias (Field NoFragments Variable -> SelectionSet NoFragments Variable
forall (frag :: * -> *) var.
Field frag var -> SelectionSet frag var
G._fSelectionSet Field NoFragments Variable
fld)
              Maybe (Selection NoFragments Variable)
_ -> Maybe (Selection NoFragments Variable)
forall a. Maybe a
Nothing
  case Maybe (Selection NoFragments Variable)
maybeSelSet of
    Just (G.SelectionField Field NoFragments Variable
fld) -> HashMap Name (Value Variable)
-> Maybe (HashMap Name (Value Variable))
forall a. a -> Maybe a
Just (HashMap Name (Value Variable)
 -> Maybe (HashMap Name (Value Variable)))
-> HashMap Name (Value Variable)
-> Maybe (HashMap Name (Value Variable))
forall a b. (a -> b) -> a -> b
$ (Field NoFragments Variable -> HashMap Name (Value Variable)
forall (frag :: * -> *) var.
Field frag var -> HashMap Name (Value var)
G._fArguments Field NoFragments Variable
fld)
    Maybe (Selection NoFragments Variable)
_ -> Maybe (HashMap Name (Value Variable))
forall a. Maybe a
Nothing
  where
    getSelSet :: Name -> t (Selection frag var) -> Maybe (Selection frag var)
getSelSet Name
alias t (Selection frag var)
set = ((Selection frag var -> Bool)
 -> t (Selection frag var) -> Maybe (Selection frag var))
-> t (Selection frag var)
-> (Selection frag var -> Bool)
-> Maybe (Selection frag var)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Selection frag var -> Bool)
-> t (Selection frag var) -> Maybe (Selection frag var)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find t (Selection frag var)
set ((Selection frag var -> Bool) -> Maybe (Selection frag var))
-> (Selection frag var -> Bool) -> Maybe (Selection frag var)
forall a b. (a -> b) -> a -> b
$ \case
      G.SelectionField Field frag var
fld ->
        case Field frag var -> Maybe Name
forall (frag :: * -> *) var. Field frag var -> Maybe Name
G._fAlias Field frag var
fld of
          Maybe Name
Nothing -> Name -> Text
G.unName Name
alias Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Text
G.unName (Field frag var -> Name
forall (frag :: * -> *) var. Field frag var -> Name
G._fName Field frag var
fld)
          Just Name
aliasName -> Name -> Text
G.unName Name
alias Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Text
G.unName Name
aliasName
      Selection frag var
_ -> Bool
False