mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 20:41:49 +03:00
ea5c92acae
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8876 GitOrigin-RevId: abfc18eeef96a1f3593bfe823adab4d161161333
315 lines
10 KiB
Haskell
315 lines
10 KiB
Haskell
-- | Postgres Execute Mutation
|
|
--
|
|
-- Generic combinators for translating and excecuting IR mutation statements.
|
|
-- Used by the specific mutation modules, e.g. 'Hasura.Backends.Postgres.Execute.Insert'.
|
|
--
|
|
-- See 'Hasura.Backends.Postgres.Instances.Execute'.
|
|
module Hasura.Backends.Postgres.Execute.Mutation
|
|
( MutateResp (..),
|
|
--
|
|
execDeleteQuery,
|
|
execInsertQuery,
|
|
execUpdateQuery,
|
|
--
|
|
executeMutationOutputQuery,
|
|
mutateAndFetchCols,
|
|
)
|
|
where
|
|
|
|
import Control.Monad.Writer (runWriter)
|
|
import Data.Aeson
|
|
import Data.Sequence qualified as DS
|
|
import Database.PG.Query qualified as PG
|
|
import Hasura.Backends.Postgres.Connection
|
|
import Hasura.Backends.Postgres.SQL.DML qualified as S
|
|
import Hasura.Backends.Postgres.SQL.Types
|
|
import Hasura.Backends.Postgres.SQL.Value
|
|
import Hasura.Backends.Postgres.Translate.Delete
|
|
import Hasura.Backends.Postgres.Translate.Insert
|
|
import Hasura.Backends.Postgres.Translate.Mutation
|
|
import Hasura.Backends.Postgres.Translate.Returning
|
|
import Hasura.Backends.Postgres.Translate.Select
|
|
import Hasura.Backends.Postgres.Translate.Select.Internal.Helpers (customSQLToTopLevelCTEs, toQuery)
|
|
import Hasura.Backends.Postgres.Translate.Update
|
|
import Hasura.Base.Error
|
|
import Hasura.EncJSON
|
|
import Hasura.GraphQL.Schema.NamingCase (NamingCase)
|
|
import Hasura.Prelude
|
|
import Hasura.QueryTags
|
|
import Hasura.RQL.IR.BoolExp
|
|
import Hasura.RQL.IR.Delete
|
|
import Hasura.RQL.IR.Insert
|
|
import Hasura.RQL.IR.Returning
|
|
import Hasura.RQL.IR.Select
|
|
import Hasura.RQL.IR.Update
|
|
import Hasura.RQL.Types.Backend
|
|
import Hasura.RQL.Types.BackendType
|
|
import Hasura.RQL.Types.Column
|
|
import Hasura.RQL.Types.Common
|
|
import Hasura.RQL.Types.Schema.Options qualified as Options
|
|
import Hasura.Session
|
|
|
|
data MutateResp (b :: BackendType) a = MutateResp
|
|
{ _mrAffectedRows :: Int,
|
|
_mrReturningColumns :: [ColumnValues b a]
|
|
}
|
|
deriving (Generic)
|
|
|
|
deriving instance (Backend b, Show a) => Show (MutateResp b a)
|
|
|
|
deriving instance (Backend b, Eq a) => Eq (MutateResp b a)
|
|
|
|
instance (Backend b, ToJSON a) => ToJSON (MutateResp b a) where
|
|
toJSON = genericToJSON hasuraJSON
|
|
|
|
instance (Backend b, FromJSON a) => FromJSON (MutateResp b a) where
|
|
parseJSON = genericParseJSON hasuraJSON
|
|
|
|
data Mutation (b :: BackendType) = Mutation
|
|
{ _mTable :: QualifiedTable,
|
|
_mQuery :: (MutationCTE, DS.Seq PG.PrepArg),
|
|
_mOutput :: MutationOutput b,
|
|
_mCols :: [ColumnInfo b],
|
|
_mStrfyNum :: Options.StringifyNumbers,
|
|
_mNamingConvention :: Maybe NamingCase
|
|
}
|
|
|
|
mkMutation ::
|
|
UserInfo ->
|
|
QualifiedTable ->
|
|
(MutationCTE, DS.Seq PG.PrepArg) ->
|
|
MutationOutput ('Postgres pgKind) ->
|
|
[ColumnInfo ('Postgres pgKind)] ->
|
|
Options.StringifyNumbers ->
|
|
Maybe NamingCase ->
|
|
Mutation ('Postgres pgKind)
|
|
mkMutation _userInfo table query output allCols strfyNum tCase =
|
|
Mutation table query output allCols strfyNum tCase
|
|
|
|
runMutation ::
|
|
( MonadTx m,
|
|
Backend ('Postgres pgKind),
|
|
PostgresAnnotatedFieldJSON pgKind,
|
|
MonadReader QueryTagsComment m
|
|
) =>
|
|
Mutation ('Postgres pgKind) ->
|
|
m EncJSON
|
|
runMutation mut =
|
|
bool (mutateAndReturn mut) (mutateAndSel mut) $
|
|
hasNestedFld $
|
|
_mOutput mut
|
|
|
|
mutateAndReturn ::
|
|
( MonadTx m,
|
|
Backend ('Postgres pgKind),
|
|
PostgresAnnotatedFieldJSON pgKind,
|
|
MonadReader QueryTagsComment m
|
|
) =>
|
|
Mutation ('Postgres pgKind) ->
|
|
m EncJSON
|
|
mutateAndReturn (Mutation qt (cte, p) mutationOutput allCols strfyNum tCase) =
|
|
executeMutationOutputQuery qt allCols Nothing cte mutationOutput strfyNum tCase (toList p)
|
|
|
|
execUpdateQuery ::
|
|
forall pgKind m.
|
|
( MonadTx m,
|
|
Backend ('Postgres pgKind),
|
|
PostgresAnnotatedFieldJSON pgKind,
|
|
MonadReader QueryTagsComment m
|
|
) =>
|
|
Options.StringifyNumbers ->
|
|
Maybe NamingCase ->
|
|
UserInfo ->
|
|
(AnnotatedUpdate ('Postgres pgKind), DS.Seq PG.PrepArg) ->
|
|
m EncJSON
|
|
execUpdateQuery strfyNum tCase userInfo (u, p) =
|
|
case updateCTE of
|
|
Update singleUpdate -> runCTE singleUpdate
|
|
MultiUpdate ctes -> encJFromList <$> traverse runCTE ctes
|
|
where
|
|
updateCTE :: UpdateCTE
|
|
updateCTE = mkUpdateCTE u
|
|
|
|
runCTE :: S.TopLevelCTE -> m EncJSON
|
|
runCTE cte =
|
|
runMutation
|
|
(mkMutation userInfo (_auTable u) (MCCheckConstraint cte, p) (_auOutput u) (_auAllCols u) strfyNum tCase)
|
|
|
|
execDeleteQuery ::
|
|
forall pgKind m.
|
|
( MonadTx m,
|
|
Backend ('Postgres pgKind),
|
|
PostgresAnnotatedFieldJSON pgKind,
|
|
MonadReader QueryTagsComment m
|
|
) =>
|
|
Options.StringifyNumbers ->
|
|
Maybe NamingCase ->
|
|
UserInfo ->
|
|
(AnnDel ('Postgres pgKind), DS.Seq PG.PrepArg) ->
|
|
m EncJSON
|
|
execDeleteQuery strfyNum tCase userInfo (u, p) =
|
|
runMutation
|
|
(mkMutation userInfo (_adTable u) (MCDelete delete, p) (_adOutput u) (_adAllCols u) strfyNum tCase)
|
|
where
|
|
delete = mkDelete u
|
|
|
|
execInsertQuery ::
|
|
( MonadTx m,
|
|
Backend ('Postgres pgKind),
|
|
PostgresAnnotatedFieldJSON pgKind,
|
|
MonadReader QueryTagsComment m
|
|
) =>
|
|
Options.StringifyNumbers ->
|
|
Maybe NamingCase ->
|
|
UserInfo ->
|
|
(InsertQueryP1 ('Postgres pgKind), DS.Seq PG.PrepArg) ->
|
|
m EncJSON
|
|
execInsertQuery strfyNum tCase userInfo (u, p) =
|
|
runMutation
|
|
(mkMutation userInfo (iqp1Table u) (MCCheckConstraint insertCTE, p) (iqp1Output u) (iqp1AllCols u) strfyNum tCase)
|
|
where
|
|
insertCTE = mkInsertCTE u
|
|
|
|
{- Note: [Prepared statements in Mutations]
|
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
The SQL statements we generate for mutations seem to include the actual values
|
|
in the statements in some cases which pretty much makes them unfit for reuse
|
|
(Handling relationships in the returning clause is the source of this
|
|
complexity). Further, `PGConn` has an internal cache which maps a statement to
|
|
a 'prepared statement id' on Postgres. As we prepare more and more single-use
|
|
SQL statements we end up leaking memory both on graphql-engine and Postgres
|
|
till the connection is closed. So a simpler but very crude fix is to not use
|
|
prepared statements for mutations. The performance of insert mutations
|
|
shouldn't be affected but updates and delete mutations with complex boolean
|
|
conditions **might** see some degradation.
|
|
-}
|
|
|
|
mutateAndSel ::
|
|
forall pgKind m.
|
|
( MonadTx m,
|
|
Backend ('Postgres pgKind),
|
|
PostgresAnnotatedFieldJSON pgKind,
|
|
MonadReader QueryTagsComment m
|
|
) =>
|
|
Mutation ('Postgres pgKind) ->
|
|
m EncJSON
|
|
mutateAndSel (Mutation qt q mutationOutput allCols strfyNum tCase) = do
|
|
-- Perform mutation and fetch unique columns
|
|
MutateResp _ columnVals <- liftTx $ mutateAndFetchCols qt allCols q strfyNum tCase
|
|
select <- mkSelectExpFromColumnValues qt allCols columnVals
|
|
-- Perform select query and fetch returning fields
|
|
executeMutationOutputQuery
|
|
qt
|
|
allCols
|
|
Nothing
|
|
(MCSelectValues select)
|
|
mutationOutput
|
|
strfyNum
|
|
tCase
|
|
[]
|
|
|
|
withCheckPermission :: (MonadError QErr m) => m (a, Bool) -> m a
|
|
withCheckPermission sqlTx = do
|
|
(rawResponse, checkConstraint) <- sqlTx
|
|
unless checkConstraint $
|
|
throw400 PermissionError $
|
|
"check constraint of an insert/update permission has failed"
|
|
pure rawResponse
|
|
|
|
executeMutationOutputQuery ::
|
|
forall pgKind m.
|
|
( MonadTx m,
|
|
Backend ('Postgres pgKind),
|
|
PostgresAnnotatedFieldJSON pgKind,
|
|
MonadReader QueryTagsComment m
|
|
) =>
|
|
QualifiedTable ->
|
|
[ColumnInfo ('Postgres pgKind)] ->
|
|
Maybe Int ->
|
|
MutationCTE ->
|
|
MutationOutput ('Postgres pgKind) ->
|
|
Options.StringifyNumbers ->
|
|
Maybe NamingCase ->
|
|
-- | Prepared params
|
|
[PG.PrepArg] ->
|
|
m EncJSON
|
|
executeMutationOutputQuery qt allCols preCalAffRows cte mutOutput strfyNum tCase prepArgs = do
|
|
queryTags <- ask
|
|
let queryTx :: PG.FromRes a => m a
|
|
queryTx = do
|
|
let selectWith = mkMutationOutputExp qt allCols preCalAffRows cte mutOutput strfyNum tCase
|
|
query = toQuery selectWith
|
|
queryWithQueryTags = query {PG.getQueryText = (PG.getQueryText query) <> (_unQueryTagsComment queryTags)}
|
|
-- See Note [Prepared statements in Mutations]
|
|
liftTx (PG.rawQE dmlTxErrorHandler queryWithQueryTags prepArgs False)
|
|
|
|
if checkPermissionRequired cte
|
|
then withCheckPermission $ PG.getRow <$> queryTx
|
|
else runIdentity . PG.getRow <$> queryTx
|
|
|
|
mutateAndFetchCols ::
|
|
forall pgKind.
|
|
(Backend ('Postgres pgKind), PostgresAnnotatedFieldJSON pgKind) =>
|
|
QualifiedTable ->
|
|
[ColumnInfo ('Postgres pgKind)] ->
|
|
(MutationCTE, DS.Seq PG.PrepArg) ->
|
|
Options.StringifyNumbers ->
|
|
Maybe NamingCase ->
|
|
PG.TxE QErr (MutateResp ('Postgres pgKind) TxtEncodedVal)
|
|
mutateAndFetchCols qt cols (cte, p) strfyNum tCase = do
|
|
let mutationTx :: PG.FromRes a => PG.TxE QErr a
|
|
mutationTx =
|
|
-- See Note [Prepared statements in Mutations]
|
|
PG.rawQE dmlTxErrorHandler sqlText (toList p) False
|
|
|
|
if checkPermissionRequired cte
|
|
then withCheckPermission $ (first PG.getViaJSON . PG.getRow) <$> mutationTx
|
|
else (PG.getViaJSON . runIdentity . PG.getRow) <$> mutationTx
|
|
where
|
|
rawAlias = S.mkTableAlias $ "mutres__" <> qualifiedObjectToText qt
|
|
rawIdentifier = S.tableAliasToIdentifier rawAlias
|
|
tabFrom = FromIdentifier $ FIIdentifier (unTableIdentifier rawIdentifier)
|
|
tabPerm = TablePerm annBoolExpTrue Nothing
|
|
selFlds = flip map cols $
|
|
\ci -> (fromCol @('Postgres pgKind) $ ciColumn ci, mkAnnColumnFieldAsText ci)
|
|
|
|
sqlText = toQuery selectWith
|
|
|
|
select =
|
|
S.mkSelect
|
|
{ S.selExtr =
|
|
S.Extractor extrExp Nothing
|
|
: bool [] [S.Extractor checkErrExp Nothing] (checkPermissionRequired cte)
|
|
}
|
|
|
|
selectWith =
|
|
S.SelectWith
|
|
( [(rawAlias, getMutationCTE cte)]
|
|
<> customSQLToTopLevelCTEs customSQLCTEs
|
|
)
|
|
select
|
|
|
|
checkErrExp = mkCheckErrorExp rawIdentifier
|
|
extrExp =
|
|
S.applyJsonBuildObj
|
|
[ S.SELit "affected_rows",
|
|
affRowsSel,
|
|
S.SELit "returning_columns",
|
|
colSel
|
|
]
|
|
|
|
affRowsSel =
|
|
S.SESelect $
|
|
S.mkSelect
|
|
{ S.selExtr = [S.Extractor S.countStar Nothing],
|
|
S.selFrom = Just $ S.FromExp [S.FIIdentifier rawIdentifier]
|
|
}
|
|
|
|
(colSel, customSQLCTEs) =
|
|
runWriter $
|
|
S.SESelect
|
|
<$> mkSQLSelect
|
|
JASMultipleRows
|
|
( AnnSelectG selFlds tabFrom tabPerm noSelectArgs strfyNum tCase
|
|
)
|