graphql-engine/server/src-lib/Hasura/RQL/DML/Delete.hs
Antoine Leblanc cdf5e3b5f0 Specialize RQL.DML to postgres.
### Description

When generalizing the code, back in late 2020, we over-eagerly generalized parts of the code that are specific to RQL's DML. This was in part due to the fact that, at the time, the DML types were all mixed alongside other types in `RQL.Types`. As a result, a lot of `RQL.DML.Internal` was generic over the backend type, instead of being specialized to `'Postgres 'Vanilla`.

A consequence of this is that, before this PR, `DML.Internal` ended up having a dependency on non-Postgres backends, due to the use of `annBoolExp`, which requires a `BackendMetadata` instance. Since the code was written in a generic manner, `DML.Internal` in turn depended on having the metadata instances in scope... This PR changes that to, instead, explicitly import the Postgres instance.

(Note that this module didn't import `RQL.Types.Metadata.Instances`, but depends on a module that imports it, and **orphan instances are transitively imported**, as evidenced by the need for that explicit import in #4568.)

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4573
GitOrigin-RevId: 7b82b5d7c23c03654518a1816802d400f37c3c64
2022-05-27 18:23:19 +00:00

127 lines
3.6 KiB
Haskell

module Hasura.RQL.DML.Delete
( validateDeleteQWith,
validateDeleteQ,
AnnDelG (..),
AnnDel,
execDeleteQuery,
runDelete,
)
where
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson
import Data.Sequence qualified as DS
import Database.PG.Query qualified as Q
import Hasura.Backends.Postgres.Connection
import Hasura.Backends.Postgres.Execute.Mutation
import Hasura.Backends.Postgres.SQL.DML qualified as S
import Hasura.Backends.Postgres.Translate.Returning
import Hasura.Backends.Postgres.Types.Table
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.QueryTags
import Hasura.RQL.DML.Internal
import Hasura.RQL.DML.Types
import Hasura.RQL.IR.Delete
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.SchemaCache
import Hasura.SQL.Backend
import Hasura.Server.Types
import Hasura.Session
import Hasura.Tracing qualified as Tracing
validateDeleteQWith ::
(UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m) =>
SessionVariableBuilder m ->
(ColumnType ('Postgres 'Vanilla) -> Value -> m S.SQLExp) ->
DeleteQuery ->
m (AnnDel ('Postgres 'Vanilla))
validateDeleteQWith
sessVarBldr
prepValBldr
(DeleteQuery tableName _ rqlBE mRetCols) = do
tableInfo <- askTableInfoSource tableName
let coreInfo = _tiCoreInfo tableInfo
-- If table is view then check if it deletable
mutableView
tableName
viIsDeletable
(_tciViewInfo coreInfo)
"deletable"
-- Check if the role has delete permissions
delPerm <- askDelPermInfo tableInfo
-- Check if all dependent headers are present
validateHeaders $ dpiRequiredHeaders delPerm
-- Check if select is allowed
selPerm <-
modifyErr (<> selNecessaryMsg) $
askSelPermInfo tableInfo
let fieldInfoMap = _tciFieldInfoMap coreInfo
allCols = getCols fieldInfoMap
-- convert the returning cols into sql returing exp
mAnnRetCols <- forM mRetCols $ \retCols ->
withPathK "returning" $ checkRetCols fieldInfoMap selPerm retCols
-- convert the where clause
annSQLBoolExp <-
withPathK "where" $
convBoolExp fieldInfoMap selPerm rqlBE sessVarBldr tableName (valueParserWithCollectableType prepValBldr)
resolvedDelFltr <-
convAnnBoolExpPartialSQL sessVarBldr $
dpiFilter delPerm
return $
AnnDel
tableName
(resolvedDelFltr, annSQLBoolExp)
(mkDefaultMutFlds mAnnRetCols)
allCols
where
selNecessaryMsg =
"; \"delete\" is only allowed if the role "
<> "has \"select\" permission as \"where\" can't be used "
<> "without \"select\" permission on the table"
validateDeleteQ ::
(QErrM m, UserInfoM m, CacheRM m) =>
DeleteQuery ->
m (AnnDel ('Postgres 'Vanilla), DS.Seq Q.PrepArg)
validateDeleteQ query = do
let source = doSource query
tableCache :: TableCache ('Postgres 'Vanilla) <- fold <$> askTableCache source
flip runTableCacheRT (source, tableCache) $
runDMLP1T $
validateDeleteQWith sessVarFromCurrentSetting binRHSBuilder query
runDelete ::
forall m.
( QErrM m,
UserInfoM m,
CacheRM m,
HasServerConfigCtx m,
MonadIO m,
Tracing.MonadTrace m,
MonadBaseControl IO m,
MetadataM m
) =>
DeleteQuery ->
m EncJSON
runDelete q = do
sourceConfig <- askSourceConfig @('Postgres 'Vanilla) (doSource q)
strfyNum <- stringifyNum . _sccSQLGenCtx <$> askServerConfigCtx
userInfo <- askUserInfo
validateDeleteQ q
>>= runTxWithCtx (_pscExecCtx sourceConfig) Q.ReadWrite
. flip runReaderT emptyQueryTagsComment
. execDeleteQuery strfyNum userInfo