graphql-engine/server/src-lib/Hasura/GraphQL/Execute/Mutation.hs
Antoine Leblanc e99f9a2f57 Remove MetadataStorageT, clean up error handling.
## Description

This PR removes `MetadataStorageT`, and cleans up all top-level error handling. In short: this PR changes `MonadMetadataStorage` to explicitly return a bunch of `Either QErr a`, instead of relying on the stack providing a `MonadError QErr`. Since we implement that class on the base monad *below any ExceptT*, this removes a lot of very complicated instances that make assumptions about the shape of the stack.

On the back of this, we can remove several layers of ExceptT from the core of the code, including the one in `RunT`, which allows us to remove several instances of `liftEitherM . runExceptT`.

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7689
GitOrigin-RevId: 97d600154d690f58c0b93fb4cc2d30fd383fd8b8
2023-02-03 01:05:09 +00:00

160 lines
6.5 KiB
Haskell

module Hasura.GraphQL.Execute.Mutation
( convertMutationSelectionSet,
)
where
import Data.Environment qualified as Env
import Data.HashMap.Strict qualified as Map
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.Tagged qualified as Tagged
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.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.RQL.IR
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.GraphqlSchemaIntrospection
import Hasura.RQL.Types.QueryTags
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.Server.Prometheus (PrometheusMetrics (..))
import Hasura.Server.Types (RequestId (..))
import Hasura.Session
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Syntax qualified as G
import Network.HTTP.Client qualified as HTTP
import Network.HTTP.Types qualified as HTTP
convertMutationAction ::
( MonadIO m,
MonadError QErr m,
MonadMetadataStorage m
) =>
Env.Environment ->
L.Logger L.Hasura ->
PrometheusMetrics ->
UserInfo ->
HTTP.Manager ->
HTTP.RequestHeaders ->
Maybe GH.GQLQueryText ->
ActionMutation Void ->
m ActionExecutionPlan
convertMutationAction env logger prometheusMetrics userInfo manager reqHeaders gqlQueryText = \case
AMSync s ->
pure $ AEPSync $ resolveActionExecution env logger prometheusMetrics userInfo s actionExecContext gqlQueryText
AMAsync s ->
AEPAsyncMutation <$> resolveActionMutationAsync s reqHeaders userSession
where
userSession = _uiSession userInfo
actionExecContext = ActionExecContext manager reqHeaders $ _uiSession userInfo
convertMutationSelectionSet ::
forall m.
( Tracing.MonadTrace m,
MonadIO m,
MonadError QErr m,
MonadMetadataStorage m,
MonadGQLExecutionCheck m,
MonadQueryTags m
) =>
Env.Environment ->
L.Logger L.Hasura ->
PrometheusMetrics ->
GQLContext ->
SQLGenCtx ->
UserInfo ->
HTTP.Manager ->
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
env
logger
prometheusMetrics
gqlContext
SQLGenCtx {stringifyNum}
userInfo
manager
reqHeaders
directives
fields
varDefs
gqlUnparsed
introspectionDisabledRoles
reqId
maybeOperationName = do
mutationParser <-
onNothing (gqlMutationParser gqlContext) $
throw400 ValidationFailed "no mutations exist"
(resolvedDirectives, resolvedSelSet) <- resolveVariables varDefs (fromMaybe Map.empty (GH._grVariables gqlUnparsed)) directives fields
-- Parse the GraphQL query into the RQL AST
unpreparedQueries ::
RootFieldMap (MutationRootField UnpreparedValue) <-
liftEither $ mutationParser resolvedSelSet
-- Process directives on the mutation
_dirMap <- toQErr $ runParse (parseDirectives customDirectives (G.DLExecutable G.EDLMUTATION) resolvedDirectives)
let parameterizedQueryHash = calculateParameterizedQueryHash resolvedSelSet
resolveExecutionSteps rootFieldName rootFieldUnpreparedValue = do
case rootFieldUnpreparedValue of
RFDB sourceName exists ->
AB.dispatchAnyBackend @BackendExecute
exists
\(SourceConfigWith (sourceConfig :: SourceConfig b) queryTagsConfig (MDBR db)) -> do
let mReqId =
case _qtcOmitRequestId <$> queryTagsConfig of
-- we omit the request id only if a user explicitly wishes for it to be omitted.
Just True -> Nothing
_ -> Just reqId
mutationQueryTagsAttributes = encodeQueryTags $ QTMutation $ MutationMetadata mReqId maybeOperationName rootFieldName parameterizedQueryHash
queryTagsComment = Tagged.untag $ createQueryTags @m mutationQueryTagsAttributes queryTagsConfig
(noRelsDBAST, remoteJoins) = RJ.getRemoteJoinsMutationDB db
dbStepInfo <- flip runReaderT queryTagsComment $ mkDBMutationPlan @b userInfo env stringifyNum sourceName sourceConfig noRelsDBAST reqHeaders maybeOperationName
pure $ ExecStepDB [] (AB.mkAnyBackend dbStepInfo) remoteJoins
RFRemote remoteField -> do
RemoteSchemaRootField remoteSchemaInfo resultCustomizer resolvedRemoteField <- runVariableCache $ resolveRemoteField userInfo remoteField
let (noRelsRemoteField, remoteJoins) = RJ.getRemoteJoinsGraphQLField resolvedRemoteField
pure $
buildExecStepRemote remoteSchemaInfo resultCustomizer G.OperationTypeMutation noRelsRemoteField remoteJoins (GH._grOperationName gqlUnparsed)
RFAction action -> do
let (noRelsDBAST, remoteJoins) = RJ.getRemoteJoinsActionMutation action
(actionName, _fch) <- pure $ case noRelsDBAST of
AMSync s -> (_aaeName s, _aaeForwardClientHeaders s)
AMAsync s -> (_aamaName s, _aamaForwardClientHeaders s)
plan <- convertMutationAction env logger prometheusMetrics userInfo manager reqHeaders (Just (GH._grQuery gqlUnparsed)) noRelsDBAST
pure $ ExecStepAction plan (ActionsInfo actionName _fch) remoteJoins -- `_fch` represents the `forward_client_headers` option from the action
-- definition which is currently being ignored for actions that are mutations
RFRaw customFieldVal -> flip onLeft throwError =<< executeIntrospection userInfo customFieldVal introspectionDisabledRoles
RFMulti lst -> do
allSteps <- traverse (resolveExecutionSteps rootFieldName) lst
pure $ ExecStepMulti allSteps
-- Transform the RQL AST into a prepared SQL query
txs <- flip OMap.traverseWithKey unpreparedQueries $ resolveExecutionSteps
return (txs, parameterizedQueryHash)