mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-10-05 06:18:04 +03:00
server: split RQL.DML into four different parts (#6072)
* WIP: shuffle everything around * remove all unused imports & unused top-level binds * move types to IR subfolder * revert unrelated changes to Query and Prepare * reduce differences in remote join, deprecate Translate module * clean mutation module * cosmetic: code formatting * moved some RQL-specific stuff out of IR * fix misc compilation issues Co-authored-by: kodiakhq[bot] <49736102+kodiakhq[bot]@users.noreply.github.com>
This commit is contained in:
Antoine Leblanc
GitHub
parent
f5fd1ecd7d
commit
61c990f177
@ -300,12 +300,22 @@ library
|
||||
, Data.Time.Clock.Units
|
||||
, Data.URL.Template
|
||||
, Hasura.App
|
||||
|
||||
, Hasura.Backends.Postgres.Connection
|
||||
, Hasura.Backends.Postgres.Execute.Mutation
|
||||
, Hasura.Backends.Postgres.Execute.RemoteJoin
|
||||
, Hasura.Backends.Postgres.Translate.Delete
|
||||
, Hasura.Backends.Postgres.Translate.Insert
|
||||
, Hasura.Backends.Postgres.Translate.Mutation
|
||||
, Hasura.Backends.Postgres.Translate.Returning
|
||||
, Hasura.Backends.Postgres.Translate.Select
|
||||
, Hasura.Backends.Postgres.Translate.Update
|
||||
, Hasura.Backends.Postgres.SQL.DML
|
||||
, Hasura.Backends.Postgres.SQL.Error
|
||||
, Hasura.Backends.Postgres.Connection
|
||||
, Hasura.Backends.Postgres.SQL.Rewrite
|
||||
, Hasura.Backends.Postgres.SQL.Types
|
||||
, Hasura.Backends.Postgres.SQL.Value
|
||||
|
||||
-- Exposed for benchmark:
|
||||
, Hasura.Cache.Bounded
|
||||
, Hasura.Logging
|
||||
@ -412,20 +422,17 @@ library
|
||||
, Hasura.RQL.DDL.Utils
|
||||
, Hasura.RQL.DDL.EventTrigger
|
||||
, Hasura.RQL.DDL.ScheduledTrigger
|
||||
, Hasura.RQL.DML.Delete
|
||||
, Hasura.RQL.DML.Delete.Types
|
||||
, Hasura.RQL.DML.Internal
|
||||
, Hasura.RQL.DML.Insert
|
||||
, Hasura.RQL.DML.Insert.Types
|
||||
, Hasura.RQL.DML.Mutation
|
||||
, Hasura.RQL.DML.RemoteJoin
|
||||
, Hasura.RQL.DML.Returning
|
||||
, Hasura.RQL.DML.Returning.Types
|
||||
, Hasura.RQL.DML.Select.Internal
|
||||
, Hasura.RQL.DML.Select.Types
|
||||
, Hasura.RQL.DML.Update
|
||||
, Hasura.RQL.DML.Update.Types
|
||||
, Hasura.RQL.DML.Count
|
||||
, Hasura.RQL.DML.Delete
|
||||
, Hasura.RQL.DML.Insert
|
||||
, Hasura.RQL.DML.Internal
|
||||
, Hasura.RQL.DML.Update
|
||||
, Hasura.RQL.IR.Delete
|
||||
, Hasura.RQL.IR.Insert
|
||||
, Hasura.RQL.IR.RemoteJoin
|
||||
, Hasura.RQL.IR.Returning
|
||||
, Hasura.RQL.IR.Select
|
||||
, Hasura.RQL.IR.Update
|
||||
, Hasura.RQL.GBoolExp
|
||||
, Hasura.GraphQL.Explain
|
||||
, Hasura.GraphQL.Execute.Action
|
||||
|
||||
@ -1,40 +1,49 @@
|
||||
module Hasura.RQL.DML.Mutation
|
||||
( Mutation(..)
|
||||
, mkMutation
|
||||
, MutationRemoteJoinCtx
|
||||
, runMutation
|
||||
module Hasura.Backends.Postgres.Execute.Mutation
|
||||
( MutationRemoteJoinCtx
|
||||
--
|
||||
, execDeleteQuery
|
||||
, execInsertQuery
|
||||
, execUpdateQuery
|
||||
--
|
||||
, executeMutationOutputQuery
|
||||
, mutateAndFetchCols
|
||||
, mkSelCTEFromColVals
|
||||
)
|
||||
where
|
||||
) where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.Environment as Env
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.Sequence as DS
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Network.HTTP.Client as HTTP
|
||||
import qualified Network.HTTP.Types as N
|
||||
import qualified Data.Environment as Env
|
||||
import qualified Data.Sequence as DS
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Network.HTTP.Client as HTTP
|
||||
import qualified Network.HTTP.Types as N
|
||||
|
||||
import Data.Text.Extended
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
import Instances.TH.Lift ()
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
|
||||
import Hasura.Backends.Postgres.Connection
|
||||
import Hasura.Backends.Postgres.Execute.RemoteJoin
|
||||
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.Update
|
||||
import Hasura.EncJSON
|
||||
import Hasura.RQL.DML.Internal
|
||||
import Hasura.RQL.DML.RemoteJoin
|
||||
import Hasura.RQL.DML.Returning
|
||||
import Hasura.RQL.DML.Returning.Types
|
||||
import Hasura.RQL.DML.Select
|
||||
import Hasura.RQL.Instances ()
|
||||
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.Instances ()
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.SQL.Types
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Session
|
||||
|
||||
|
||||
@ -93,6 +102,63 @@ mutateAndReturn env (Mutation qt (cte, p) mutationOutput allCols remoteJoins str
|
||||
sqlQuery = Q.fromBuilder $ toSQL $
|
||||
mkMutationOutputExp qt allCols Nothing cte mutationOutput strfyNum
|
||||
|
||||
|
||||
execUpdateQuery
|
||||
::
|
||||
( HasVersion
|
||||
, MonadTx m
|
||||
, MonadIO m
|
||||
, Tracing.MonadTrace m
|
||||
)
|
||||
=> Env.Environment
|
||||
-> Bool
|
||||
-> Maybe MutationRemoteJoinCtx
|
||||
-> (AnnUpd 'Postgres, DS.Seq Q.PrepArg)
|
||||
-> m EncJSON
|
||||
execUpdateQuery env strfyNum remoteJoinCtx (u, p) =
|
||||
runMutation env $ mkMutation remoteJoinCtx (uqp1Table u) (updateCTE, p)
|
||||
(uqp1Output u) (uqp1AllCols u) strfyNum
|
||||
where
|
||||
updateCTE = mkUpdateCTE u
|
||||
|
||||
execDeleteQuery
|
||||
::
|
||||
( HasVersion
|
||||
, MonadTx m
|
||||
, MonadIO m
|
||||
, Tracing.MonadTrace m
|
||||
)
|
||||
=> Env.Environment
|
||||
-> Bool
|
||||
-> Maybe MutationRemoteJoinCtx
|
||||
-> (AnnDel 'Postgres, DS.Seq Q.PrepArg)
|
||||
-> m EncJSON
|
||||
execDeleteQuery env strfyNum remoteJoinCtx (u, p) =
|
||||
runMutation env $ mkMutation remoteJoinCtx (dqp1Table u) (deleteCTE, p)
|
||||
(dqp1Output u) (dqp1AllCols u) strfyNum
|
||||
where
|
||||
deleteCTE = mkDeleteCTE u
|
||||
|
||||
execInsertQuery
|
||||
:: ( HasVersion
|
||||
, MonadTx m
|
||||
, MonadIO m
|
||||
, Tracing.MonadTrace m
|
||||
)
|
||||
=> Env.Environment
|
||||
-> Bool
|
||||
-> Maybe MutationRemoteJoinCtx
|
||||
-> (InsertQueryP1 'Postgres, DS.Seq Q.PrepArg)
|
||||
-> m EncJSON
|
||||
execInsertQuery env strfyNum remoteJoinCtx (u, p) =
|
||||
runMutation env
|
||||
$ mkMutation remoteJoinCtx (iqp1Table u) (insertCTE, p)
|
||||
(iqp1Output u) (iqp1AllCols u) strfyNum
|
||||
where
|
||||
insertCTE = mkInsertCTE u
|
||||
|
||||
|
||||
|
||||
{- Note: [Prepared statements in Mutations]
|
||||
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
The SQL statements we generate for mutations seem to include the actual values
|
||||
@ -177,42 +243,3 @@ mutateAndFetchCols qt cols (cte, p) strfyNum =
|
||||
}
|
||||
colSel = S.SESelect $ mkSQLSelect JASMultipleRows $
|
||||
AnnSelectG selFlds tabFrom tabPerm noSelectArgs strfyNum
|
||||
|
||||
-- | Note:- Using sorted columns is necessary to enable casting the rows returned by VALUES expression to table type.
|
||||
-- For example, let's consider the table, `CREATE TABLE test (id serial primary key, name text not null, age int)`.
|
||||
-- The generated values expression should be in order of columns;
|
||||
-- `SELECT ("row"::table).* VALUES (1, 'Robert', 23) AS "row"`.
|
||||
mkSelCTEFromColVals
|
||||
:: (MonadError QErr m)
|
||||
=> QualifiedTable -> [ColumnInfo 'Postgres] -> [ColumnValues TxtEncodedPGVal] -> m S.CTE
|
||||
mkSelCTEFromColVals qt allCols colVals =
|
||||
S.CTESelect <$> case colVals of
|
||||
[] -> return selNoRows
|
||||
_ -> do
|
||||
tuples <- mapM mkTupsFromColVal colVals
|
||||
let fromItem = S.FIValues (S.ValuesExp tuples) (S.Alias rowAlias) Nothing
|
||||
return S.mkSelect
|
||||
{ S.selExtr = [extractor]
|
||||
, S.selFrom = Just $ S.FromExp [fromItem]
|
||||
}
|
||||
where
|
||||
rowAlias = Identifier "row"
|
||||
extractor = S.selectStar' $ S.QualifiedIdentifier rowAlias $ Just $ S.TypeAnn $ toSQLTxt qt
|
||||
sortedCols = sortCols allCols
|
||||
mkTupsFromColVal colVal =
|
||||
fmap S.TupleExp $ forM sortedCols $ \ci -> do
|
||||
let pgCol = pgiColumn ci
|
||||
val <- onNothing (Map.lookup pgCol colVal) $
|
||||
throw500 $ "column " <> pgCol <<> " not found in returning values"
|
||||
pure $ txtEncodedToSQLExp (pgiType ci) val
|
||||
|
||||
selNoRows =
|
||||
S.mkSelect { S.selExtr = [S.selectStar]
|
||||
, S.selFrom = Just $ S.mkSimpleFromExp qt
|
||||
, S.selWhere = Just $ S.WhereFrag $ S.BELit False
|
||||
}
|
||||
|
||||
txtEncodedToSQLExp colTy = \case
|
||||
TENull -> S.SENull
|
||||
TELit textValue ->
|
||||
S.withTyAnn (unsafePGColumnToRepresentation colTy) $ S.SELit textValue
|
||||
@ -1,7 +1,5 @@
|
||||
-- | Types and Functions for resolving remote join fields
|
||||
module Hasura.RQL.DML.RemoteJoin
|
||||
( executeQueryWithRemoteJoins
|
||||
, getRemoteJoins
|
||||
module Hasura.Backends.Postgres.Execute.RemoteJoin
|
||||
( getRemoteJoins
|
||||
, getRemoteJoinsAggregateSelect
|
||||
, getRemoteJoinsMutationOutput
|
||||
, getRemoteJoinsConnectionSelect
|
||||
@ -9,27 +7,11 @@ module Hasura.RQL.DML.RemoteJoin
|
||||
-- * These are required in pro:
|
||||
, FieldPath(..)
|
||||
, RemoteJoin(..)
|
||||
, executeQueryWithRemoteJoins
|
||||
) where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import Control.Lens
|
||||
import Data.Validation
|
||||
|
||||
import Data.Text.Extended (commaSeparated, (<<>))
|
||||
import Hasura.EncJSON
|
||||
import Hasura.GraphQL.Parser hiding (field)
|
||||
import Hasura.GraphQL.RemoteServer (execRemoteGQ')
|
||||
import Hasura.GraphQL.Transport.HTTP.Protocol
|
||||
import Hasura.RQL.DML.Internal
|
||||
import Hasura.RQL.DML.Returning.Types
|
||||
import Hasura.RQL.DML.Select.Types
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Session
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import qualified Data.Aeson as A
|
||||
import qualified Data.Aeson.Ordered as AO
|
||||
import qualified Data.Environment as Env
|
||||
@ -40,12 +22,32 @@ import qualified Data.HashSet as HS
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Text as T
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
import qualified Language.GraphQL.Draft.Printer as G
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
import qualified Network.HTTP.Client as HTTP
|
||||
import qualified Network.HTTP.Types as N
|
||||
|
||||
import Control.Lens
|
||||
import Data.Text.Extended (commaSeparated, (<<>))
|
||||
import Data.Validation
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
|
||||
import Hasura.Backends.Postgres.Connection
|
||||
import Hasura.EncJSON
|
||||
import Hasura.GraphQL.Parser hiding (field)
|
||||
import Hasura.GraphQL.RemoteServer (execRemoteGQ')
|
||||
import Hasura.GraphQL.Transport.HTTP.Protocol
|
||||
import Hasura.RQL.DML.Internal
|
||||
import Hasura.RQL.IR.RemoteJoin
|
||||
import Hasura.RQL.IR.Returning
|
||||
import Hasura.RQL.IR.Select
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Session
|
||||
|
||||
|
||||
-- | Executes given query and fetch response JSON from Postgres. Substitutes remote relationship fields.
|
||||
executeQueryWithRemoteJoins
|
||||
:: ( HasVersion
|
||||
@ -109,21 +111,6 @@ pathToAlias path counter = do
|
||||
parseGraphQLName $ T.intercalate "_" (map getFieldNameTxt $ unFieldPath path)
|
||||
<> "__" <> (T.pack . show . unCounter) counter
|
||||
|
||||
-- | A 'RemoteJoin' represents the context of remote relationship to be extracted from 'AnnFieldG's.
|
||||
data RemoteJoin (b :: Backend)
|
||||
= RemoteJoin
|
||||
{ _rjName :: !FieldName -- ^ The remote join field name.
|
||||
, _rjArgs :: ![RemoteFieldArgument] -- ^ User-provided arguments with variables.
|
||||
, _rjSelSet :: !(G.SelectionSet G.NoFragments Variable) -- ^ User-provided selection set of remote field.
|
||||
, _rjHasuraFields :: !(HashSet FieldName) -- ^ Table fields.
|
||||
, _rjFieldCall :: !(NonEmpty FieldCall) -- ^ Remote server fields.
|
||||
, _rjRemoteSchema :: !RemoteSchemaInfo -- ^ The remote schema server info.
|
||||
, _rjPhantomFields :: ![ColumnInfo b]
|
||||
-- ^ Hasura fields which are not in the selection set, but are required as
|
||||
-- parameters to satisfy the remote join.
|
||||
}
|
||||
deriving instance Eq (RemoteJoin 'Postgres)
|
||||
|
||||
type RemoteJoins b = NE.NonEmpty (FieldPath, NE.NonEmpty (RemoteJoin b))
|
||||
type RemoteJoinMap b = Map.HashMap FieldPath (NE.NonEmpty (RemoteJoin b))
|
||||
|
||||
23
server/src-lib/Hasura/Backends/Postgres/Translate/Delete.hs
Normal file
23
server/src-lib/Hasura/Backends/Postgres/Translate/Delete.hs
Normal file
@ -0,0 +1,23 @@
|
||||
module Hasura.Backends.Postgres.Translate.Delete
|
||||
( mkDeleteCTE
|
||||
) where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import Instances.TH.Lift ()
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.RQL.GBoolExp
|
||||
import Hasura.RQL.IR.Delete
|
||||
import Hasura.RQL.Types
|
||||
|
||||
|
||||
mkDeleteCTE
|
||||
:: AnnDel 'Postgres -> S.CTE
|
||||
mkDeleteCTE (AnnDel tn (fltr, wc) _ _) =
|
||||
S.CTEDelete delete
|
||||
where
|
||||
delete = S.SQLDelete tn Nothing tableFltr $ Just S.returningStar
|
||||
tableFltr = Just $ S.WhereFrag $
|
||||
toSQLBoolExp (S.QualTable tn) $ andAnnBoolExps fltr wc
|
||||
191
server/src-lib/Hasura/Backends/Postgres/Translate/Insert.hs
Normal file
191
server/src-lib/Hasura/Backends/Postgres/Translate/Insert.hs
Normal file
@ -0,0 +1,191 @@
|
||||
module Hasura.Backends.Postgres.Translate.Insert
|
||||
( mkInsertCTE
|
||||
, insertCheckExpr
|
||||
, buildConflictClause
|
||||
, toSQLConflict
|
||||
, insertOrUpdateCheckExpr
|
||||
) where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.HashSet as HS
|
||||
|
||||
import Data.Text.Extended
|
||||
import Instances.TH.Lift ()
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.RQL.DML.Internal
|
||||
import Hasura.RQL.GBoolExp
|
||||
import Hasura.RQL.IR.Insert
|
||||
import Hasura.RQL.Types
|
||||
|
||||
|
||||
mkInsertCTE :: InsertQueryP1 'Postgres -> S.CTE
|
||||
mkInsertCTE (InsertQueryP1 tn cols vals conflict (insCheck, updCheck) _ _) =
|
||||
S.CTEInsert insert
|
||||
where
|
||||
tupVals = S.ValuesExp $ map S.TupleExp vals
|
||||
insert =
|
||||
S.SQLInsert tn cols tupVals (toSQLConflict tn <$> conflict)
|
||||
. Just
|
||||
. S.RetExp
|
||||
$ [ S.selectStar
|
||||
, S.Extractor
|
||||
(insertOrUpdateCheckExpr tn conflict
|
||||
(toSQLBool insCheck)
|
||||
(fmap toSQLBool updCheck))
|
||||
Nothing
|
||||
]
|
||||
toSQLBool = toSQLBoolExp $ S.QualTable tn
|
||||
|
||||
|
||||
toSQLConflict :: QualifiedTable -> ConflictClauseP1 'Postgres S.SQLExp -> S.SQLConflict
|
||||
toSQLConflict tableName = \case
|
||||
CP1DoNothing ct -> S.DoNothing $ toSQLCT <$> ct
|
||||
CP1Update ct inpCols preSet filtr -> S.Update
|
||||
(toSQLCT ct) (S.buildUpsertSetExp inpCols preSet) $
|
||||
Just $ S.WhereFrag $ toSQLBoolExp (S.QualTable tableName) filtr
|
||||
where
|
||||
toSQLCT ct = case ct of
|
||||
CTColumn pgCols -> S.SQLColumn pgCols
|
||||
CTConstraint cn -> S.SQLConstraint cn
|
||||
|
||||
|
||||
validateInpCols :: (MonadError QErr m) => [PGCol] -> [PGCol] -> m ()
|
||||
validateInpCols inpCols updColsPerm = forM_ inpCols $ \inpCol ->
|
||||
unless (inpCol `elem` updColsPerm) $ throw400 ValidationFailed $
|
||||
"column " <> inpCol <<> " is not updatable"
|
||||
|
||||
buildConflictClause
|
||||
:: (UserInfoM m, QErrM m)
|
||||
=> SessVarBldr 'Postgres m
|
||||
-> TableInfo 'Postgres
|
||||
-> [PGCol]
|
||||
-> OnConflict
|
||||
-> m (ConflictClauseP1 'Postgres S.SQLExp)
|
||||
buildConflictClause sessVarBldr tableInfo inpCols (OnConflict mTCol mTCons act) =
|
||||
case (mTCol, mTCons, act) of
|
||||
(Nothing, Nothing, CAIgnore) -> return $ CP1DoNothing Nothing
|
||||
(Just col, Nothing, CAIgnore) -> do
|
||||
validateCols col
|
||||
return $ CP1DoNothing $ Just $ CTColumn $ getPGCols col
|
||||
(Nothing, Just cons, CAIgnore) -> do
|
||||
validateConstraint cons
|
||||
return $ CP1DoNothing $ Just $ CTConstraint cons
|
||||
(Nothing, Nothing, CAUpdate) -> throw400 UnexpectedPayload
|
||||
"Expecting 'constraint' or 'constraint_on' when the 'action' is 'update'"
|
||||
(Just col, Nothing, CAUpdate) -> do
|
||||
validateCols col
|
||||
(updFltr, preSet) <- getUpdPerm
|
||||
resolvedUpdFltr <- convAnnBoolExpPartialSQL sessVarBldr updFltr
|
||||
resolvedPreSet <- mapM (convPartialSQLExp sessVarBldr) preSet
|
||||
return $ CP1Update (CTColumn $ getPGCols col) inpCols resolvedPreSet resolvedUpdFltr
|
||||
(Nothing, Just cons, CAUpdate) -> do
|
||||
validateConstraint cons
|
||||
(updFltr, preSet) <- getUpdPerm
|
||||
resolvedUpdFltr <- convAnnBoolExpPartialSQL sessVarBldr updFltr
|
||||
resolvedPreSet <- mapM (convPartialSQLExp sessVarBldr) preSet
|
||||
return $ CP1Update (CTConstraint cons) inpCols resolvedPreSet resolvedUpdFltr
|
||||
(Just _, Just _, _) -> throw400 UnexpectedPayload
|
||||
"'constraint' and 'constraint_on' cannot be set at a time"
|
||||
where
|
||||
coreInfo = _tiCoreInfo tableInfo
|
||||
fieldInfoMap = _tciFieldInfoMap coreInfo
|
||||
-- toSQLBool = toSQLBoolExp (S.mkQual $ _tciName coreInfo)
|
||||
|
||||
validateCols c = do
|
||||
let targetcols = getPGCols c
|
||||
void $ withPathK "constraint_on" $ indexedForM targetcols $
|
||||
\pgCol -> askPGType fieldInfoMap pgCol ""
|
||||
|
||||
validateConstraint c = do
|
||||
let tableConsNames = maybe [] toList $
|
||||
fmap _cName <$> tciUniqueOrPrimaryKeyConstraints coreInfo
|
||||
withPathK "constraint" $
|
||||
unless (c `elem` tableConsNames) $
|
||||
throw400 Unexpected $ "constraint " <> getConstraintTxt c
|
||||
<<> " for table " <> _tciName coreInfo
|
||||
<<> " does not exist"
|
||||
|
||||
getUpdPerm = do
|
||||
upi <- askUpdPermInfo tableInfo
|
||||
let updFiltr = upiFilter upi
|
||||
preSet = upiSet upi
|
||||
updCols = HS.toList $ upiCols upi
|
||||
validateInpCols inpCols updCols
|
||||
return (updFiltr, preSet)
|
||||
|
||||
-- | Create an expression which will fail with a check constraint violation error
|
||||
-- if the condition is not met on any of the inserted rows.
|
||||
--
|
||||
-- The resulting SQL will look something like this:
|
||||
--
|
||||
-- > INSERT INTO
|
||||
-- > ...
|
||||
-- > RETURNING
|
||||
-- > *,
|
||||
-- > CASE WHEN {cond}
|
||||
-- > THEN NULL
|
||||
-- > ELSE hdb_catalog.check_violation('insert check constraint failed')
|
||||
-- > END
|
||||
insertCheckExpr :: Text -> S.BoolExp -> S.SQLExp
|
||||
insertCheckExpr errorMessage condExpr =
|
||||
S.SECond condExpr S.SENull
|
||||
(S.SEFunction
|
||||
(S.FunctionExp
|
||||
(QualifiedObject (SchemaName "hdb_catalog") (FunctionName "check_violation"))
|
||||
(S.FunctionArgs [S.SELit errorMessage] mempty)
|
||||
Nothing)
|
||||
)
|
||||
|
||||
-- | When inserting data, we might need to also enforce the update
|
||||
-- check condition, because we might fall back to an update via an
|
||||
-- @ON CONFLICT@ clause.
|
||||
--
|
||||
-- We generate something which looks like
|
||||
--
|
||||
-- > INSERT INTO
|
||||
-- > ...
|
||||
-- > ON CONFLICT DO UPDATE SET
|
||||
-- > ...
|
||||
-- > RETURNING
|
||||
-- > *,
|
||||
-- > CASE WHEN xmax = 0
|
||||
-- > THEN CASE WHEN {insert_cond}
|
||||
-- > THEN NULL
|
||||
-- > ELSE hdb_catalog.check_violation('insert check constraint failed')
|
||||
-- > END
|
||||
-- > ELSE CASE WHEN {update_cond}
|
||||
-- > THEN NULL
|
||||
-- > ELSE hdb_catalog.check_violation('update check constraint failed')
|
||||
-- > END
|
||||
-- > END
|
||||
--
|
||||
-- See @https://stackoverflow.com/q/34762732@ for more information on the use of
|
||||
-- the @xmax@ system column.
|
||||
insertOrUpdateCheckExpr
|
||||
:: QualifiedTable
|
||||
-> Maybe (ConflictClauseP1 'Postgres S.SQLExp)
|
||||
-> S.BoolExp
|
||||
-> Maybe S.BoolExp
|
||||
-> S.SQLExp
|
||||
insertOrUpdateCheckExpr qt (Just _conflict) insCheck (Just updCheck) =
|
||||
S.SECond
|
||||
(S.BECompare
|
||||
S.SEQ
|
||||
(S.SEQIdentifier (S.QIdentifier (S.mkQual qt) (Identifier "xmax")))
|
||||
(S.SEUnsafe "0"))
|
||||
(insertCheckExpr "insert check constraint failed" insCheck)
|
||||
(insertCheckExpr "update check constraint failed" updCheck)
|
||||
insertOrUpdateCheckExpr _ _ insCheck _ =
|
||||
-- If we won't generate an ON CONFLICT clause, there is no point
|
||||
-- in testing xmax. In particular, views don't provide the xmax
|
||||
-- system column, but we don't provide ON CONFLICT for views,
|
||||
-- even if they are auto-updatable, so we can fortunately avoid
|
||||
-- having to test the non-existent xmax value.
|
||||
--
|
||||
-- Alternatively, if there is no update check constraint, we should
|
||||
-- use the insert check constraint, for backwards compatibility.
|
||||
insertCheckExpr "insert check constraint failed" insCheck
|
||||
@ -0,0 +1,58 @@
|
||||
module Hasura.Backends.Postgres.Translate.Mutation
|
||||
( mkSelCTEFromColVals
|
||||
)
|
||||
where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
|
||||
import Data.Text.Extended
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.Backends.Postgres.SQL.Value
|
||||
import Hasura.RQL.Instances ()
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.SQL.Types
|
||||
|
||||
|
||||
-- | Note:- Using sorted columns is necessary to enable casting the rows returned by VALUES expression to table type.
|
||||
-- For example, let's consider the table, `CREATE TABLE test (id serial primary key, name text not null, age int)`.
|
||||
-- The generated values expression should be in order of columns;
|
||||
-- `SELECT ("row"::table).* VALUES (1, 'Robert', 23) AS "row"`.
|
||||
mkSelCTEFromColVals
|
||||
:: (MonadError QErr m)
|
||||
=> QualifiedTable -> [ColumnInfo 'Postgres] -> [ColumnValues TxtEncodedPGVal] -> m S.CTE
|
||||
mkSelCTEFromColVals qt allCols colVals =
|
||||
S.CTESelect <$> case colVals of
|
||||
[] -> return selNoRows
|
||||
_ -> do
|
||||
tuples <- mapM mkTupsFromColVal colVals
|
||||
let fromItem = S.FIValues (S.ValuesExp tuples) (S.Alias rowAlias) Nothing
|
||||
return S.mkSelect
|
||||
{ S.selExtr = [extractor]
|
||||
, S.selFrom = Just $ S.FromExp [fromItem]
|
||||
}
|
||||
where
|
||||
rowAlias = Identifier "row"
|
||||
extractor = S.selectStar' $ S.QualifiedIdentifier rowAlias $ Just $ S.TypeAnn $ toSQLTxt qt
|
||||
sortedCols = sortCols allCols
|
||||
mkTupsFromColVal colVal =
|
||||
fmap S.TupleExp $ forM sortedCols $ \ci -> do
|
||||
let pgCol = pgiColumn ci
|
||||
val <- onNothing (Map.lookup pgCol colVal) $
|
||||
throw500 $ "column " <> pgCol <<> " not found in returning values"
|
||||
pure $ txtEncodedToSQLExp (pgiType ci) val
|
||||
|
||||
selNoRows =
|
||||
S.mkSelect { S.selExtr = [S.selectStar]
|
||||
, S.selFrom = Just $ S.mkSimpleFromExp qt
|
||||
, S.selWhere = Just $ S.WhereFrag $ S.BELit False
|
||||
}
|
||||
|
||||
txtEncodedToSQLExp colTy = \case
|
||||
TENull -> S.SENull
|
||||
TELit textValue ->
|
||||
S.withTyAnn (unsafePGColumnToRepresentation colTy) $ S.SELit textValue
|
||||
@ -1,69 +1,23 @@
|
||||
module Hasura.RQL.DML.Returning where
|
||||
module Hasura.Backends.Postgres.Translate.Returning
|
||||
( mkMutFldExp
|
||||
, mkDefaultMutFlds
|
||||
, mkMutationOutputExp
|
||||
, checkRetCols
|
||||
) where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text as T
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.Backends.Postgres.Translate.Select
|
||||
import Hasura.RQL.DML.Internal
|
||||
import Hasura.RQL.DML.Returning.Types
|
||||
import Hasura.RQL.DML.Select
|
||||
import Hasura.RQL.IR.Returning
|
||||
import Hasura.RQL.IR.Select
|
||||
import Hasura.RQL.Types
|
||||
|
||||
traverseMutFld
|
||||
:: (Applicative f)
|
||||
=> (a -> f b)
|
||||
-> MutFldG backend a
|
||||
-> f (MutFldG backend b)
|
||||
traverseMutFld f = \case
|
||||
MCount -> pure MCount
|
||||
MExp t -> pure $ MExp t
|
||||
MRet flds -> MRet <$> traverse (traverse (traverseAnnField f)) flds
|
||||
|
||||
traverseMutationOutput
|
||||
:: (Applicative f)
|
||||
=> (a -> f b)
|
||||
-> MutationOutputG backend a -> f (MutationOutputG backend b)
|
||||
traverseMutationOutput f = \case
|
||||
MOutMultirowFields mutationFields ->
|
||||
MOutMultirowFields <$> traverse (traverse (traverseMutFld f)) mutationFields
|
||||
MOutSinglerowObject annFields ->
|
||||
MOutSinglerowObject <$> traverseAnnFields f annFields
|
||||
|
||||
traverseMutFlds
|
||||
:: (Applicative f)
|
||||
=> (a -> f b)
|
||||
-> MutFldsG backend a
|
||||
-> f (MutFldsG backend b)
|
||||
traverseMutFlds f =
|
||||
traverse (traverse (traverseMutFld f))
|
||||
|
||||
hasNestedFld :: MutationOutputG backend a -> Bool
|
||||
hasNestedFld = \case
|
||||
MOutMultirowFields flds -> any isNestedMutFld flds
|
||||
MOutSinglerowObject annFlds -> any isNestedAnnField annFlds
|
||||
where
|
||||
isNestedMutFld (_, mutFld) = case mutFld of
|
||||
MRet annFlds -> any isNestedAnnField annFlds
|
||||
_ -> False
|
||||
isNestedAnnField (_, annFld) = case annFld of
|
||||
AFObjectRelation _ -> True
|
||||
AFArrayRelation _ -> True
|
||||
_ -> False
|
||||
|
||||
pgColsFromMutFld :: MutFld 'Postgres -> [(PGCol, ColumnType 'Postgres)]
|
||||
pgColsFromMutFld = \case
|
||||
MCount -> []
|
||||
MExp _ -> []
|
||||
MRet selFlds ->
|
||||
flip mapMaybe selFlds $ \(_, annFld) -> case annFld of
|
||||
AFColumn (AnnColumnField (ColumnInfo col _ _ colTy _ _) _ _) -> Just (col, colTy)
|
||||
_ -> Nothing
|
||||
|
||||
pgColsFromMutFlds :: MutFlds 'Postgres -> [(PGCol, PGColumnType)]
|
||||
pgColsFromMutFlds = concatMap (pgColsFromMutFld . snd)
|
||||
|
||||
pgColsToSelFlds :: [ColumnInfo 'Postgres] -> [(FieldName, AnnField 'Postgres)]
|
||||
pgColsToSelFlds cols =
|
||||
@ -1,16 +1,19 @@
|
||||
module Hasura.RQL.DML.Select.Internal
|
||||
( mkSQLSelect
|
||||
module Hasura.Backends.Postgres.Translate.Select
|
||||
( selectQuerySQL
|
||||
, selectAggregateQuerySQL
|
||||
, connectionSelectQuerySQL
|
||||
, asSingleRowJsonResp
|
||||
, mkSQLSelect
|
||||
, mkAggregateSelect
|
||||
, mkConnectionSelect
|
||||
, module Hasura.RQL.DML.Select.Types
|
||||
)
|
||||
where
|
||||
) where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Text as T
|
||||
import qualified Database.PG.Query as Q
|
||||
|
||||
import Control.Lens hiding (op)
|
||||
import Control.Monad.Writer.Strict
|
||||
@ -21,11 +24,31 @@ import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Rewrite
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.EncJSON
|
||||
import Hasura.GraphQL.Schema.Common
|
||||
import Hasura.RQL.DML.Internal
|
||||
import Hasura.RQL.DML.Select.Types
|
||||
import Hasura.RQL.GBoolExp
|
||||
import Hasura.RQL.IR.Select
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.SQL.Types
|
||||
|
||||
|
||||
selectQuerySQL :: JsonAggSelect -> AnnSimpleSel 'Postgres -> Q.Query
|
||||
selectQuerySQL jsonAggSelect sel =
|
||||
Q.fromBuilder $ toSQL $ mkSQLSelect jsonAggSelect sel
|
||||
|
||||
selectAggregateQuerySQL :: AnnAggregateSelect 'Postgres -> Q.Query
|
||||
selectAggregateQuerySQL =
|
||||
Q.fromBuilder . toSQL . mkAggregateSelect
|
||||
|
||||
connectionSelectQuerySQL :: ConnectionSelect 'Postgres S.SQLExp -> Q.Query
|
||||
connectionSelectQuerySQL =
|
||||
Q.fromBuilder . toSQL . mkConnectionSelect
|
||||
|
||||
asSingleRowJsonResp :: Q.Query -> [Q.PrepArg] -> Q.TxE QErr EncJSON
|
||||
asSingleRowJsonResp query args =
|
||||
encJFromBS . runIdentity . Q.getRow
|
||||
<$> Q.rawQE dmlTxErrorHandler query args True
|
||||
|
||||
|
||||
-- Conversion of SelectQ happens in 2 Stages.
|
||||
54
server/src-lib/Hasura/Backends/Postgres/Translate/Update.hs
Normal file
54
server/src-lib/Hasura/Backends/Postgres/Translate/Update.hs
Normal file
@ -0,0 +1,54 @@
|
||||
module Hasura.Backends.Postgres.Translate.Update
|
||||
( mkUpdateCTE
|
||||
) where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import Instances.TH.Lift ()
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.Backends.Postgres.Translate.Insert
|
||||
import Hasura.RQL.GBoolExp
|
||||
import Hasura.RQL.IR.Update
|
||||
import Hasura.RQL.Instances ()
|
||||
import Hasura.RQL.Types
|
||||
|
||||
|
||||
mkUpdateCTE
|
||||
:: AnnUpd 'Postgres -> S.CTE
|
||||
mkUpdateCTE (AnnUpd tn opExps (permFltr, wc) chk _ columnsInfo) =
|
||||
S.CTEUpdate update
|
||||
where
|
||||
update =
|
||||
S.SQLUpdate tn setExp Nothing tableFltr
|
||||
. Just
|
||||
. S.RetExp
|
||||
$ [ S.selectStar
|
||||
, S.Extractor (insertCheckExpr "update check constraint failed" checkExpr) Nothing
|
||||
]
|
||||
setExp = S.SetExp $ map (expandOperator columnsInfo) opExps
|
||||
tableFltr = Just $ S.WhereFrag tableFltrExpr
|
||||
tableFltrExpr = toSQLBoolExp (S.QualTable tn) $ andAnnBoolExps permFltr wc
|
||||
checkExpr = toSQLBoolExp (S.QualTable tn) chk
|
||||
|
||||
expandOperator :: [ColumnInfo 'Postgres] -> (PGCol, UpdOpExpG S.SQLExp) -> S.SetExpItem
|
||||
expandOperator infos (column, op) = S.SetExpItem $ (column,) $ case op of
|
||||
UpdSet e -> e
|
||||
UpdInc e -> S.mkSQLOpExp S.incOp identifier (asNum e)
|
||||
UpdAppend e -> S.mkSQLOpExp S.jsonbConcatOp identifier (asJSON e)
|
||||
UpdPrepend e -> S.mkSQLOpExp S.jsonbConcatOp (asJSON e) identifier
|
||||
UpdDeleteKey e -> S.mkSQLOpExp S.jsonbDeleteOp identifier (asText e)
|
||||
UpdDeleteElem e -> S.mkSQLOpExp S.jsonbDeleteOp identifier (asInt e)
|
||||
UpdDeleteAtPath a -> S.mkSQLOpExp S.jsonbDeleteAtPathOp identifier (asArray a)
|
||||
where
|
||||
identifier = S.SEIdentifier $ toIdentifier column
|
||||
asInt e = S.SETyAnn e S.intTypeAnn
|
||||
asText e = S.SETyAnn e S.textTypeAnn
|
||||
asJSON e = S.SETyAnn e S.jsonbTypeAnn
|
||||
asArray a = S.SETyAnn (S.SEArray a) S.textArrTypeAnn
|
||||
asNum e = S.SETyAnn e $
|
||||
case find (\info -> pgiColumn info == column) infos <&> pgiType of
|
||||
Just (PGColumnScalar s) -> S.mkTypeAnn $ PGTypeScalar s
|
||||
_ -> S.numericTypeAnn
|
||||
@ -27,9 +27,9 @@ import Data.Aeson.Casing
|
||||
import Data.Aeson.TH
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.RQL.DML.Delete.Types as RQL
|
||||
import qualified Hasura.RQL.DML.Select.Types as RQL
|
||||
import qualified Hasura.RQL.DML.Update.Types as RQL
|
||||
import qualified Hasura.RQL.IR.Delete as RQL
|
||||
import qualified Hasura.RQL.IR.Select as RQL
|
||||
import qualified Hasura.RQL.IR.Update as RQL
|
||||
import qualified Hasura.RQL.Types.Action as RQL
|
||||
import qualified Hasura.RQL.Types.RemoteSchema as RQL
|
||||
|
||||
|
||||
@ -9,54 +9,54 @@ module Hasura.GraphQL.Execute.Action
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Aeson.Casing as J
|
||||
import qualified Data.Aeson.TH as J
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.HashSet as Set
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.UUID as UUID
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
import qualified Network.HTTP.Client as HTTP
|
||||
import qualified Network.HTTP.Types as HTTP
|
||||
import qualified Network.Wreq as Wreq
|
||||
import qualified Control.Concurrent.Async.Lifted.Safe as LA
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Aeson.Casing as J
|
||||
import qualified Data.Aeson.TH as J
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Environment as Env
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.HashSet as Set
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.UUID as UUID
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
import qualified Network.HTTP.Client as HTTP
|
||||
import qualified Network.HTTP.Types as HTTP
|
||||
import qualified Network.Wreq as Wreq
|
||||
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Exception (try)
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Exception (try)
|
||||
import Control.Lens
|
||||
import Control.Monad.Trans.Control (MonadBaseControl)
|
||||
import Data.Has
|
||||
import Data.IORef
|
||||
import Data.Int (Int64)
|
||||
import Data.Int (Int64)
|
||||
import Data.Text.Extended
|
||||
|
||||
import qualified Hasura.RQL.DML.RemoteJoin as RJ
|
||||
import qualified Hasura.RQL.DML.Select as RS
|
||||
-- import qualified Hasura.GraphQL.Resolve.Select as GRS
|
||||
import Control.Monad.Trans.Control (MonadBaseControl)
|
||||
|
||||
import qualified Control.Concurrent.Async.Lifted.Safe as LA
|
||||
import qualified Data.Environment as Env
|
||||
import qualified Hasura.Logging as L
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
import qualified Hasura.Backends.Postgres.Execute.RemoteJoin as RJ
|
||||
import qualified Hasura.Backends.Postgres.Translate.Select as RS
|
||||
import qualified Hasura.Logging as L
|
||||
import qualified Hasura.RQL.IR.Select as RS
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.Backends.Postgres.SQL.Value (PGScalarValue (..), toTxtValue)
|
||||
import Hasura.Backends.Postgres.SQL.Value (PGScalarValue (..), toTxtValue)
|
||||
import Hasura.Backends.Postgres.Translate.Select (asSingleRowJsonResp)
|
||||
import Hasura.EncJSON
|
||||
import Hasura.GraphQL.Execute.Prepare
|
||||
import Hasura.GraphQL.Parser hiding (column)
|
||||
import Hasura.GraphQL.Utils (showNames)
|
||||
import Hasura.GraphQL.Parser hiding (column)
|
||||
import Hasura.GraphQL.Utils (showNames)
|
||||
import Hasura.HTTP
|
||||
import Hasura.RQL.DDL.Headers
|
||||
import Hasura.RQL.DDL.Schema.Cache
|
||||
import Hasura.RQL.DML.Select (asSingleRowJsonResp)
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.RQL.Types.Run
|
||||
import Hasura.SQL.Types
|
||||
import Hasura.Server.Utils (mkClientHeadersForward, mkSetCookieHeaders)
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Server.Utils (mkClientHeadersForward,
|
||||
mkSetCookieHeaders)
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Session
|
||||
|
||||
|
||||
|
||||
@ -5,24 +5,25 @@ module Hasura.GraphQL.Execute.Insert
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Environment as Env
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Data.Text as T
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Environment as Env
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Data.Text as T
|
||||
import qualified Database.PG.Query as Q
|
||||
|
||||
import Data.Text.Extended
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.RQL.DML.Insert as RQL
|
||||
import qualified Hasura.RQL.DML.Insert.Types as RQL
|
||||
import qualified Hasura.RQL.DML.Mutation as RQL
|
||||
import qualified Hasura.RQL.DML.RemoteJoin as RQL
|
||||
import qualified Hasura.RQL.DML.Returning as RQL
|
||||
import qualified Hasura.RQL.DML.Returning.Types as RQL
|
||||
import qualified Hasura.RQL.GBoolExp as RQL
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
import qualified Hasura.Backends.Postgres.Execute.Mutation as RQL
|
||||
import qualified Hasura.Backends.Postgres.Execute.RemoteJoin as RQL
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Backends.Postgres.Translate.Insert as RQL
|
||||
import qualified Hasura.Backends.Postgres.Translate.Mutation as RQL
|
||||
import qualified Hasura.Backends.Postgres.Translate.Returning as RQL
|
||||
import qualified Hasura.RQL.GBoolExp as RQL
|
||||
import qualified Hasura.RQL.IR.Insert as RQL
|
||||
import qualified Hasura.RQL.IR.Returning as RQL
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
|
||||
import Hasura.Backends.Postgres.Connection
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
@ -31,7 +32,7 @@ import Hasura.EncJSON
|
||||
import Hasura.GraphQL.Schema.Insert
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.SQL.Types
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
|
||||
|
||||
traverseAnnInsert
|
||||
|
||||
@ -26,27 +26,28 @@ module Hasura.GraphQL.Execute.LiveQuery.Plan
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.Aeson.Casing as J
|
||||
import qualified Data.Aeson.Extended as J
|
||||
import qualified Data.Aeson.TH as J
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.UUID.V4 as UUID
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Database.PG.Query.PTI as PTI
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
import qualified PostgreSQL.Binary.Encoding as PE
|
||||
import qualified Data.Aeson.Casing as J
|
||||
import qualified Data.Aeson.Extended as J
|
||||
import qualified Data.Aeson.TH as J
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.UUID.V4 as UUID
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Database.PG.Query.PTI as PTI
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
import qualified PostgreSQL.Binary.Encoding as PE
|
||||
|
||||
import Control.Lens
|
||||
import Data.UUID (UUID)
|
||||
import Data.UUID (UUID)
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.GraphQL.Parser.Schema as PS
|
||||
import qualified Hasura.RQL.DML.RemoteJoin as RR
|
||||
import qualified Hasura.RQL.DML.Select as DS
|
||||
import qualified Hasura.Backends.Postgres.Execute.RemoteJoin as RR
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Backends.Postgres.Translate.Select as DS
|
||||
import qualified Hasura.GraphQL.Parser.Schema as PS
|
||||
import qualified Hasura.RQL.IR.Select as DS
|
||||
|
||||
import Hasura.Backends.Postgres.Connection
|
||||
import Hasura.Backends.Postgres.SQL.Error
|
||||
|
||||
@ -4,24 +4,23 @@ module Hasura.GraphQL.Execute.Mutation
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.Environment as Env
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||||
import qualified Data.HashSet as Set
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Data.Sequence.NonEmpty as NE
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
import qualified Network.HTTP.Client as HTTP
|
||||
import qualified Network.HTTP.Types as HTTP
|
||||
|
||||
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
|
||||
import qualified Hasura.Logging as L
|
||||
import qualified Hasura.RQL.DML.Delete as RQL
|
||||
import qualified Hasura.RQL.DML.Mutation as RQL
|
||||
import qualified Hasura.RQL.DML.Returning.Types as RQL
|
||||
import qualified Hasura.RQL.DML.Update as RQL
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
import qualified Data.Environment as Env
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||||
import qualified Data.HashSet as Set
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Data.Sequence.NonEmpty as NE
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
import qualified Network.HTTP.Client as HTTP
|
||||
import qualified Network.HTTP.Types as HTTP
|
||||
|
||||
import qualified Hasura.Backends.Postgres.Execute.Mutation as RQL
|
||||
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
|
||||
import qualified Hasura.Logging as L
|
||||
import qualified Hasura.RQL.IR.Delete as RQL
|
||||
import qualified Hasura.RQL.IR.Returning as RQL
|
||||
import qualified Hasura.RQL.IR.Update as RQL
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
|
||||
import Hasura.Backends.Postgres.Connection
|
||||
import Hasura.EncJSON
|
||||
@ -34,7 +33,7 @@ import Hasura.GraphQL.Execute.Resolve
|
||||
import Hasura.GraphQL.Parser
|
||||
import Hasura.GraphQL.Schema.Insert
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Session
|
||||
|
||||
convertDelete
|
||||
|
||||
@ -14,25 +14,28 @@ module Hasura.GraphQL.Execute.Query
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Environment as Env
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||||
import qualified Data.IntMap as IntMap
|
||||
import qualified Data.Sequence.NonEmpty as NESeq
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
import qualified Network.HTTP.Client as HTTP
|
||||
import qualified Network.HTTP.Types as HTTP
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Environment as Env
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||||
import qualified Data.IntMap as IntMap
|
||||
import qualified Data.Sequence.NonEmpty as NESeq
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
import qualified Network.HTTP.Client as HTTP
|
||||
import qualified Network.HTTP.Types as HTTP
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
|
||||
import qualified Hasura.Logging as L
|
||||
import qualified Hasura.RQL.DML.Select as DS
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Backends.Postgres.Translate.Select as DS
|
||||
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
|
||||
import qualified Hasura.Logging as L
|
||||
import qualified Hasura.RQL.IR.Select as DS
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
|
||||
import Hasura.Backends.Postgres.Connection
|
||||
import Hasura.Backends.Postgres.Execute.RemoteJoin
|
||||
import Hasura.Backends.Postgres.SQL.Value
|
||||
import Hasura.Backends.Postgres.Translate.Select (asSingleRowJsonResp)
|
||||
import Hasura.EncJSON
|
||||
import Hasura.GraphQL.Context
|
||||
import Hasura.GraphQL.Execute.Action
|
||||
@ -40,12 +43,11 @@ import Hasura.GraphQL.Execute.Prepare
|
||||
import Hasura.GraphQL.Execute.Remote
|
||||
import Hasura.GraphQL.Execute.Resolve
|
||||
import Hasura.GraphQL.Parser
|
||||
import Hasura.RQL.DML.RemoteJoin
|
||||
import Hasura.RQL.DML.Select (asSingleRowJsonResp)
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Session
|
||||
|
||||
|
||||
data PreparedSql
|
||||
= PreparedSql
|
||||
{ _psQuery :: !Q.Query
|
||||
|
||||
@ -3,33 +3,37 @@ module Hasura.GraphQL.Explain
|
||||
, GQLExplain
|
||||
) where
|
||||
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Aeson.Casing as J
|
||||
import qualified Data.Aeson.TH as J
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Aeson.Casing as J
|
||||
import qualified Data.Aeson.TH as J
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
|
||||
import Data.Text.Extended
|
||||
|
||||
import qualified Hasura.Backends.Postgres.Execute.RemoteJoin as RR
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Backends.Postgres.Translate.Select as DS
|
||||
import qualified Hasura.GraphQL.Execute as E
|
||||
import qualified Hasura.GraphQL.Execute.Inline as E
|
||||
import qualified Hasura.GraphQL.Execute.LiveQuery as E
|
||||
import qualified Hasura.GraphQL.Execute.Query as E
|
||||
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
|
||||
import qualified Hasura.RQL.IR.Select as DS
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.Backends.Postgres.SQL.Value
|
||||
import Hasura.EncJSON
|
||||
import Hasura.GraphQL.Context
|
||||
import Hasura.GraphQL.Parser
|
||||
import Hasura.Prelude
|
||||
import Hasura.RQL.DML.Internal
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Session
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.GraphQL.Execute as E
|
||||
import qualified Hasura.GraphQL.Execute.Inline as E
|
||||
import qualified Hasura.GraphQL.Execute.LiveQuery as E
|
||||
import qualified Hasura.GraphQL.Execute.Query as E
|
||||
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
|
||||
import qualified Hasura.RQL.DML.RemoteJoin as RR
|
||||
import qualified Hasura.RQL.DML.Select as DS
|
||||
|
||||
data GQLExplain
|
||||
= GQLExplain
|
||||
|
||||
@ -269,8 +269,8 @@ There's a delicate balance between GraphQL types and Postgres types.
|
||||
|
||||
The mapping is done in the 'column' parser. But we want to only have
|
||||
one source of truth for parsing postgres values, which happens to be
|
||||
the JSON parsing code in Backends.Postgres.SQL.Value. So here we reuse some of that code
|
||||
despite not having a JSON value.
|
||||
the JSON parsing code in Backends.Postgres.SQL.Value. So here we reuse
|
||||
some of that code despite not having a JSON value.
|
||||
|
||||
-}
|
||||
|
||||
|
||||
@ -14,7 +14,7 @@ import qualified Language.GraphQL.Draft.Syntax as G
|
||||
import qualified Hasura.GraphQL.Parser as P
|
||||
import qualified Hasura.GraphQL.Parser.Internal.Parser as P
|
||||
import qualified Hasura.RQL.DML.Internal as RQL
|
||||
import qualified Hasura.RQL.DML.Select.Types as RQL
|
||||
import qualified Hasura.RQL.IR.Select as RQL
|
||||
|
||||
import Data.Text.Extended
|
||||
import Data.Text.NonEmpty
|
||||
|
||||
@ -11,7 +11,7 @@ import Language.GraphQL.Draft.Syntax as G
|
||||
import qualified Data.Text as T
|
||||
import qualified Hasura.GraphQL.Execute.Types as ET (GraphQLQueryType)
|
||||
import qualified Hasura.GraphQL.Parser as P
|
||||
import qualified Hasura.RQL.DML.Select.Types as RQL (Fields)
|
||||
import qualified Hasura.RQL.IR.Select as RQL (Fields)
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.RQL.Types
|
||||
|
||||
@ -2,8 +2,8 @@ module Hasura.GraphQL.Schema.Insert where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Hasura.RQL.DML.Insert.Types as RQL
|
||||
import qualified Hasura.RQL.DML.Returning.Types as RQL
|
||||
import qualified Hasura.RQL.IR.Insert as RQL
|
||||
import qualified Hasura.RQL.IR.Returning as RQL
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.RQL.Types.BoolExp
|
||||
|
||||
@ -21,11 +21,10 @@ import qualified Language.GraphQL.Draft.Syntax as G
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.GraphQL.Parser as P
|
||||
import qualified Hasura.RQL.DML.Delete.Types as RQL
|
||||
import qualified Hasura.RQL.DML.Insert.Types as RQL
|
||||
import qualified Hasura.RQL.DML.Returning.Types as RQL
|
||||
import qualified Hasura.RQL.DML.Update as RQL
|
||||
import qualified Hasura.RQL.DML.Update.Types as RQL
|
||||
import qualified Hasura.RQL.IR.Delete as RQL
|
||||
import qualified Hasura.RQL.IR.Insert as RQL
|
||||
import qualified Hasura.RQL.IR.Returning as RQL
|
||||
import qualified Hasura.RQL.IR.Update as RQL
|
||||
|
||||
import Data.Text.Extended
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
|
||||
@ -9,7 +9,7 @@ import qualified Language.GraphQL.Draft.Syntax as G
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.DML as SQL
|
||||
import qualified Hasura.GraphQL.Parser as P
|
||||
import qualified Hasura.RQL.DML.Select as RQL
|
||||
import qualified Hasura.RQL.IR.Select as RQL
|
||||
import Hasura.RQL.Types as RQL
|
||||
|
||||
import Data.Text.Extended
|
||||
|
||||
@ -41,7 +41,7 @@ import qualified Hasura.Backends.Postgres.SQL.DML as SQL
|
||||
import qualified Hasura.GraphQL.Execute.Types as ET
|
||||
import qualified Hasura.GraphQL.Parser as P
|
||||
import qualified Hasura.GraphQL.Parser.Internal.Parser as P
|
||||
import qualified Hasura.RQL.DML.Select as RQL
|
||||
import qualified Hasura.RQL.IR.Select as RQL
|
||||
import qualified Hasura.RQL.Types.BoolExp as RQL
|
||||
|
||||
import Data.Text.Extended
|
||||
|
||||
@ -10,48 +10,26 @@ module Hasura.RQL.DML.Delete
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.Environment as Env
|
||||
import qualified Data.Sequence as DS
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Data.Environment as Env
|
||||
import qualified Data.Sequence as DS
|
||||
import qualified Database.PG.Query as Q
|
||||
|
||||
import Data.Aeson
|
||||
import Instances.TH.Lift ()
|
||||
import Instances.TH.Lift ()
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
|
||||
import Hasura.Backends.Postgres.Connection
|
||||
import Hasura.Backends.Postgres.Execute.Mutation
|
||||
import Hasura.Backends.Postgres.Translate.Returning
|
||||
import Hasura.EncJSON
|
||||
import Hasura.RQL.DML.Delete.Types
|
||||
import Hasura.RQL.DML.Internal
|
||||
import Hasura.RQL.DML.Mutation
|
||||
import Hasura.RQL.DML.Returning
|
||||
import Hasura.RQL.GBoolExp
|
||||
import Hasura.RQL.IR.Delete
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
|
||||
|
||||
traverseAnnDel
|
||||
:: (Applicative f)
|
||||
=> (a -> f b)
|
||||
-> AnnDelG backend a
|
||||
-> f (AnnDelG backend b)
|
||||
traverseAnnDel f annUpd =
|
||||
AnnDel tn
|
||||
<$> ((,) <$> traverseAnnBoolExp f whr <*> traverseAnnBoolExp f fltr)
|
||||
<*> traverseMutationOutput f mutOutput
|
||||
<*> pure allCols
|
||||
where
|
||||
AnnDel tn (whr, fltr) mutOutput allCols = annUpd
|
||||
|
||||
mkDeleteCTE
|
||||
:: AnnDel 'Postgres -> S.CTE
|
||||
mkDeleteCTE (AnnDel tn (fltr, wc) _ _) =
|
||||
S.CTEDelete delete
|
||||
where
|
||||
delete = S.SQLDelete tn Nothing tableFltr $ Just S.returningStar
|
||||
tableFltr = Just $ S.WhereFrag $
|
||||
toSQLBoolExp (S.QualTable tn) $ andAnnBoolExps fltr wc
|
||||
|
||||
validateDeleteQWith
|
||||
:: (UserInfoM m, QErrM m, CacheRM m)
|
||||
=> SessVarBldr 'Postgres m
|
||||
@ -107,24 +85,6 @@ validateDeleteQ
|
||||
validateDeleteQ =
|
||||
runDMLP1T . validateDeleteQWith sessVarFromCurrentSetting binRHSBuilder
|
||||
|
||||
execDeleteQuery
|
||||
::
|
||||
( HasVersion
|
||||
, MonadTx m
|
||||
, MonadIO m
|
||||
, Tracing.MonadTrace m
|
||||
)
|
||||
=> Env.Environment
|
||||
-> Bool
|
||||
-> Maybe MutationRemoteJoinCtx
|
||||
-> (AnnDel 'Postgres, DS.Seq Q.PrepArg)
|
||||
-> m EncJSON
|
||||
execDeleteQuery env strfyNum remoteJoinCtx (u, p) =
|
||||
runMutation env $ mkMutation remoteJoinCtx (dqp1Table u) (deleteCTE, p)
|
||||
(dqp1Output u) (dqp1AllCols u) strfyNum
|
||||
where
|
||||
deleteCTE = mkDeleteCTE u
|
||||
|
||||
runDelete
|
||||
:: ( HasVersion, QErrM m, UserInfoM m, CacheRM m
|
||||
, MonadTx m, HasSQLGenCtx m, MonadIO m
|
||||
|
||||
@ -1,69 +1,35 @@
|
||||
module Hasura.RQL.DML.Insert
|
||||
( insertCheckExpr
|
||||
, insertOrUpdateCheckExpr
|
||||
, mkInsertCTE
|
||||
, runInsert
|
||||
, execInsertQuery
|
||||
, toSQLConflict
|
||||
( runInsert
|
||||
) where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.HashSet as HS
|
||||
import qualified Data.Sequence as DS
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.HashSet as HS
|
||||
import qualified Data.Sequence as DS
|
||||
import qualified Database.PG.Query as Q
|
||||
|
||||
import Data.Aeson.Types
|
||||
import Data.Text.Extended
|
||||
import Instances.TH.Lift ()
|
||||
import Instances.TH.Lift ()
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.Connection
|
||||
import Hasura.Backends.Postgres.Execute.Mutation
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.Backends.Postgres.Translate.Insert
|
||||
import Hasura.Backends.Postgres.Translate.Returning
|
||||
import Hasura.EncJSON
|
||||
import Hasura.RQL.DML.Insert.Types
|
||||
import Hasura.RQL.DML.Internal
|
||||
import Hasura.RQL.DML.Mutation
|
||||
import Hasura.RQL.DML.Returning
|
||||
import Hasura.RQL.GBoolExp
|
||||
import Hasura.RQL.IR.Insert
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Session
|
||||
|
||||
|
||||
import qualified Data.Environment as Env
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
|
||||
mkInsertCTE :: InsertQueryP1 'Postgres -> S.CTE
|
||||
mkInsertCTE (InsertQueryP1 tn cols vals conflict (insCheck, updCheck) _ _) =
|
||||
S.CTEInsert insert
|
||||
where
|
||||
tupVals = S.ValuesExp $ map S.TupleExp vals
|
||||
insert =
|
||||
S.SQLInsert tn cols tupVals (toSQLConflict tn <$> conflict)
|
||||
. Just
|
||||
. S.RetExp
|
||||
$ [ S.selectStar
|
||||
, S.Extractor
|
||||
(insertOrUpdateCheckExpr tn conflict
|
||||
(toSQLBool insCheck)
|
||||
(fmap toSQLBool updCheck))
|
||||
Nothing
|
||||
]
|
||||
toSQLBool = toSQLBoolExp $ S.QualTable tn
|
||||
|
||||
|
||||
toSQLConflict :: QualifiedTable -> ConflictClauseP1 'Postgres S.SQLExp -> S.SQLConflict
|
||||
toSQLConflict tableName = \case
|
||||
CP1DoNothing ct -> S.DoNothing $ toSQLCT <$> ct
|
||||
CP1Update ct inpCols preSet filtr -> S.Update
|
||||
(toSQLCT ct) (S.buildUpsertSetExp inpCols preSet) $
|
||||
Just $ S.WhereFrag $ toSQLBoolExp (S.QualTable tableName) filtr
|
||||
where
|
||||
toSQLCT ct = case ct of
|
||||
CTColumn pgCols -> S.SQLColumn pgCols
|
||||
CTConstraint cn -> S.SQLConstraint cn
|
||||
import qualified Data.Environment as Env
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
|
||||
convObj
|
||||
:: (UserInfoM m, QErrM m)
|
||||
@ -94,70 +60,6 @@ convObj prepFn defInsVals setInsVals fieldInfoMap insObj = do
|
||||
throw400 NotSupported $ "column " <> c <<> " is not insertable"
|
||||
<> " for role " <>> roleName
|
||||
|
||||
validateInpCols :: (MonadError QErr m) => [PGCol] -> [PGCol] -> m ()
|
||||
validateInpCols inpCols updColsPerm = forM_ inpCols $ \inpCol ->
|
||||
unless (inpCol `elem` updColsPerm) $ throw400 ValidationFailed $
|
||||
"column " <> inpCol <<> " is not updatable"
|
||||
|
||||
buildConflictClause
|
||||
:: (UserInfoM m, QErrM m)
|
||||
=> SessVarBldr 'Postgres m
|
||||
-> TableInfo 'Postgres
|
||||
-> [PGCol]
|
||||
-> OnConflict
|
||||
-> m (ConflictClauseP1 'Postgres S.SQLExp)
|
||||
buildConflictClause sessVarBldr tableInfo inpCols (OnConflict mTCol mTCons act) =
|
||||
case (mTCol, mTCons, act) of
|
||||
(Nothing, Nothing, CAIgnore) -> return $ CP1DoNothing Nothing
|
||||
(Just col, Nothing, CAIgnore) -> do
|
||||
validateCols col
|
||||
return $ CP1DoNothing $ Just $ CTColumn $ getPGCols col
|
||||
(Nothing, Just cons, CAIgnore) -> do
|
||||
validateConstraint cons
|
||||
return $ CP1DoNothing $ Just $ CTConstraint cons
|
||||
(Nothing, Nothing, CAUpdate) -> throw400 UnexpectedPayload
|
||||
"Expecting 'constraint' or 'constraint_on' when the 'action' is 'update'"
|
||||
(Just col, Nothing, CAUpdate) -> do
|
||||
validateCols col
|
||||
(updFltr, preSet) <- getUpdPerm
|
||||
resolvedUpdFltr <- convAnnBoolExpPartialSQL sessVarBldr updFltr
|
||||
resolvedPreSet <- mapM (convPartialSQLExp sessVarBldr) preSet
|
||||
return $ CP1Update (CTColumn $ getPGCols col) inpCols resolvedPreSet resolvedUpdFltr
|
||||
(Nothing, Just cons, CAUpdate) -> do
|
||||
validateConstraint cons
|
||||
(updFltr, preSet) <- getUpdPerm
|
||||
resolvedUpdFltr <- convAnnBoolExpPartialSQL sessVarBldr updFltr
|
||||
resolvedPreSet <- mapM (convPartialSQLExp sessVarBldr) preSet
|
||||
return $ CP1Update (CTConstraint cons) inpCols resolvedPreSet resolvedUpdFltr
|
||||
(Just _, Just _, _) -> throw400 UnexpectedPayload
|
||||
"'constraint' and 'constraint_on' cannot be set at a time"
|
||||
where
|
||||
coreInfo = _tiCoreInfo tableInfo
|
||||
fieldInfoMap = _tciFieldInfoMap coreInfo
|
||||
-- toSQLBool = toSQLBoolExp (S.mkQual $ _tciName coreInfo)
|
||||
|
||||
validateCols c = do
|
||||
let targetcols = getPGCols c
|
||||
void $ withPathK "constraint_on" $ indexedForM targetcols $
|
||||
\pgCol -> askPGType fieldInfoMap pgCol ""
|
||||
|
||||
validateConstraint c = do
|
||||
let tableConsNames = maybe [] toList $
|
||||
fmap _cName <$> tciUniqueOrPrimaryKeyConstraints coreInfo
|
||||
withPathK "constraint" $
|
||||
unless (c `elem` tableConsNames) $
|
||||
throw400 Unexpected $ "constraint " <> getConstraintTxt c
|
||||
<<> " for table " <> _tciName coreInfo
|
||||
<<> " does not exist"
|
||||
|
||||
getUpdPerm = do
|
||||
upi <- askUpdPermInfo tableInfo
|
||||
let updFiltr = upiFilter upi
|
||||
preSet = upiSet upi
|
||||
updCols = HS.toList $ upiCols upi
|
||||
validateInpCols inpCols updCols
|
||||
return (updFiltr, preSet)
|
||||
|
||||
|
||||
convInsertQuery
|
||||
:: (UserInfoM m, QErrM m, CacheRM m)
|
||||
@ -227,12 +129,6 @@ convInsertQuery objsParser sessVarBldr prepFn (InsertQuery tableName val oC mRet
|
||||
"; \"returning\" can only be used if the role has "
|
||||
<> "\"select\" permission on the table"
|
||||
|
||||
decodeInsObjs :: (UserInfoM m, QErrM m) => Value -> m [InsObj]
|
||||
decodeInsObjs v = do
|
||||
objs <- decodeValue v
|
||||
when (null objs) $ throw400 UnexpectedPayload "objects should not be empty"
|
||||
return objs
|
||||
|
||||
convInsQ
|
||||
:: (QErrM m, UserInfoM m, CacheRM m)
|
||||
=> InsertQuery
|
||||
@ -243,97 +139,6 @@ convInsQ =
|
||||
sessVarFromCurrentSetting
|
||||
binRHSBuilder
|
||||
|
||||
execInsertQuery
|
||||
:: ( HasVersion
|
||||
, MonadTx m
|
||||
, MonadIO m
|
||||
, Tracing.MonadTrace m
|
||||
)
|
||||
=> Env.Environment
|
||||
-> Bool
|
||||
-> Maybe MutationRemoteJoinCtx
|
||||
-> (InsertQueryP1 'Postgres, DS.Seq Q.PrepArg)
|
||||
-> m EncJSON
|
||||
execInsertQuery env strfyNum remoteJoinCtx (u, p) =
|
||||
runMutation env
|
||||
$ mkMutation remoteJoinCtx (iqp1Table u) (insertCTE, p)
|
||||
(iqp1Output u) (iqp1AllCols u) strfyNum
|
||||
where
|
||||
insertCTE = mkInsertCTE u
|
||||
|
||||
-- | Create an expression which will fail with a check constraint violation error
|
||||
-- if the condition is not met on any of the inserted rows.
|
||||
--
|
||||
-- The resulting SQL will look something like this:
|
||||
--
|
||||
-- > INSERT INTO
|
||||
-- > ...
|
||||
-- > RETURNING
|
||||
-- > *,
|
||||
-- > CASE WHEN {cond}
|
||||
-- > THEN NULL
|
||||
-- > ELSE hdb_catalog.check_violation('insert check constraint failed')
|
||||
-- > END
|
||||
insertCheckExpr :: Text -> S.BoolExp -> S.SQLExp
|
||||
insertCheckExpr errorMessage condExpr =
|
||||
S.SECond condExpr S.SENull
|
||||
(S.SEFunction
|
||||
(S.FunctionExp
|
||||
(QualifiedObject (SchemaName "hdb_catalog") (FunctionName "check_violation"))
|
||||
(S.FunctionArgs [S.SELit errorMessage] mempty)
|
||||
Nothing)
|
||||
)
|
||||
|
||||
-- | When inserting data, we might need to also enforce the update
|
||||
-- check condition, because we might fall back to an update via an
|
||||
-- @ON CONFLICT@ clause.
|
||||
--
|
||||
-- We generate something which looks like
|
||||
--
|
||||
-- > INSERT INTO
|
||||
-- > ...
|
||||
-- > ON CONFLICT DO UPDATE SET
|
||||
-- > ...
|
||||
-- > RETURNING
|
||||
-- > *,
|
||||
-- > CASE WHEN xmax = 0
|
||||
-- > THEN CASE WHEN {insert_cond}
|
||||
-- > THEN NULL
|
||||
-- > ELSE hdb_catalog.check_violation('insert check constraint failed')
|
||||
-- > END
|
||||
-- > ELSE CASE WHEN {update_cond}
|
||||
-- > THEN NULL
|
||||
-- > ELSE hdb_catalog.check_violation('update check constraint failed')
|
||||
-- > END
|
||||
-- > END
|
||||
--
|
||||
-- See @https://stackoverflow.com/q/34762732@ for more information on the use of
|
||||
-- the @xmax@ system column.
|
||||
insertOrUpdateCheckExpr
|
||||
:: QualifiedTable
|
||||
-> Maybe (ConflictClauseP1 'Postgres S.SQLExp)
|
||||
-> S.BoolExp
|
||||
-> Maybe S.BoolExp
|
||||
-> S.SQLExp
|
||||
insertOrUpdateCheckExpr qt (Just _conflict) insCheck (Just updCheck) =
|
||||
S.SECond
|
||||
(S.BECompare
|
||||
S.SEQ
|
||||
(S.SEQIdentifier (S.QIdentifier (S.mkQual qt) (Identifier "xmax")))
|
||||
(S.SEUnsafe "0"))
|
||||
(insertCheckExpr "insert check constraint failed" insCheck)
|
||||
(insertCheckExpr "update check constraint failed" updCheck)
|
||||
insertOrUpdateCheckExpr _ _ insCheck _ =
|
||||
-- If we won't generate an ON CONFLICT clause, there is no point
|
||||
-- in testing xmax. In particular, views don't provide the xmax
|
||||
-- system column, but we don't provide ON CONFLICT for views,
|
||||
-- even if they are auto-updatable, so we can fortunately avoid
|
||||
-- having to test the non-existent xmax value.
|
||||
--
|
||||
-- Alternatively, if there is no update check constraint, we should
|
||||
-- use the insert check constraint, for backwards compatibility.
|
||||
insertCheckExpr "insert check constraint failed" insCheck
|
||||
|
||||
runInsert
|
||||
:: ( HasVersion, QErrM m, UserInfoM m
|
||||
, CacheRM m, MonadTx m, HasSQLGenCtx m, MonadIO m
|
||||
@ -344,3 +149,9 @@ runInsert env q = do
|
||||
res <- convInsQ q
|
||||
strfyNum <- stringifyNum <$> askSQLGenCtx
|
||||
execInsertQuery env strfyNum Nothing res
|
||||
|
||||
decodeInsObjs :: (UserInfoM m, QErrM m) => Value -> m [InsObj]
|
||||
decodeInsObjs v = do
|
||||
objs <- decodeValue v
|
||||
when (null objs) $ throw400 UnexpectedPayload "objects should not be empty"
|
||||
return objs
|
||||
|
||||
@ -1,4 +1,7 @@
|
||||
module Hasura.RQL.DML.Internal where
|
||||
-- ( mkAdminRolePermInfo
|
||||
-- , SessVarBldr
|
||||
-- ) where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
|
||||
@ -1,40 +0,0 @@
|
||||
module Hasura.RQL.DML.Returning.Types where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.EncJSON
|
||||
import Hasura.RQL.DML.Select.Types
|
||||
import Hasura.SQL.Backend
|
||||
|
||||
|
||||
data MutFldG (b :: Backend) v
|
||||
= MCount
|
||||
| MExp !Text
|
||||
| MRet !(AnnFieldsG b v)
|
||||
|
||||
type MutFld b = MutFldG b S.SQLExp
|
||||
|
||||
type MutFldsG b v = Fields (MutFldG b v)
|
||||
|
||||
data MutationOutputG (b :: Backend) v
|
||||
= MOutMultirowFields !(MutFldsG b v)
|
||||
| MOutSinglerowObject !(AnnFieldsG b v)
|
||||
|
||||
type MutationOutput b = MutationOutputG b S.SQLExp
|
||||
|
||||
type MutFlds b = MutFldsG b S.SQLExp
|
||||
|
||||
buildEmptyMutResp :: MutationOutput backend -> EncJSON
|
||||
buildEmptyMutResp = \case
|
||||
MOutMultirowFields mutFlds -> encJFromJValue $ OMap.fromList $ map (second convMutFld) mutFlds
|
||||
MOutSinglerowObject _ -> encJFromJValue $ J.Object mempty
|
||||
where
|
||||
convMutFld = \case
|
||||
MCount -> J.toJSON (0 :: Int)
|
||||
MExp e -> J.toJSON e
|
||||
MRet _ -> J.toJSON ([] :: [J.Value])
|
||||
@ -1,36 +1,66 @@
|
||||
module Hasura.RQL.DML.Select
|
||||
( selectP2
|
||||
, convSelectQuery
|
||||
, asSingleRowJsonResp
|
||||
, runSelect
|
||||
, selectQuerySQL
|
||||
, selectAggregateQuerySQL
|
||||
, connectionSelectQuerySQL
|
||||
, module Hasura.RQL.DML.Select.Internal
|
||||
)
|
||||
where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.HashSet as HS
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Sequence as DS
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Data.HashSet as HS
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Sequence as DS
|
||||
import qualified Database.PG.Query as Q
|
||||
|
||||
import Data.Aeson.Types
|
||||
import Data.Text.Extended
|
||||
import Instances.TH.Lift ()
|
||||
import Instances.TH.Lift ()
|
||||
import Language.Haskell.TH.Syntax (Lift)
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.Backends.Postgres.Translate.Select
|
||||
import Hasura.EncJSON
|
||||
import Hasura.RQL.DML.Internal
|
||||
import Hasura.RQL.DML.Select.Internal
|
||||
import Hasura.RQL.IR.Select
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.SQL.Types
|
||||
|
||||
|
||||
type SelectQExt b = SelectG (ExtCol b) BoolExp Int
|
||||
|
||||
-- Columns in RQL
|
||||
-- This technically doesn't need to be generalized to all backends as
|
||||
-- it is specific to this module; however the generalization work was
|
||||
-- already done, and there's no particular reason to force this to be
|
||||
-- specific.
|
||||
data ExtCol (b :: Backend)
|
||||
= ECSimple !(Column b)
|
||||
| ECRel !RelName !(Maybe RelName) !(SelectQExt b)
|
||||
deriving instance Lift (ExtCol 'Postgres)
|
||||
|
||||
instance ToJSON (ExtCol 'Postgres) where
|
||||
toJSON (ECSimple s) = toJSON s
|
||||
toJSON (ECRel rn mrn selq) =
|
||||
object $ [ "name" .= rn
|
||||
, "alias" .= mrn
|
||||
] ++ selectGToPairs selq
|
||||
|
||||
instance FromJSON (ExtCol 'Postgres) where
|
||||
parseJSON v@(Object o) =
|
||||
ECRel
|
||||
<$> o .: "name"
|
||||
<*> o .:? "alias"
|
||||
<*> parseJSON v
|
||||
parseJSON v@(String _) =
|
||||
ECSimple <$> parseJSON v
|
||||
parseJSON _ =
|
||||
fail $ mconcat
|
||||
[ "A column should either be a string or an "
|
||||
, "object (relationship)"
|
||||
]
|
||||
|
||||
convSelCol :: (UserInfoM m, QErrM m, CacheRM m)
|
||||
=> FieldInfoMap (FieldInfo 'Postgres)
|
||||
-> SelPermInfo 'Postgres
|
||||
@ -284,23 +314,6 @@ selectP2 jsonAggSelect (sel, p) =
|
||||
where
|
||||
selectSQL = toSQL $ mkSQLSelect jsonAggSelect sel
|
||||
|
||||
selectQuerySQL :: JsonAggSelect -> AnnSimpleSel 'Postgres -> Q.Query
|
||||
selectQuerySQL jsonAggSelect sel =
|
||||
Q.fromBuilder $ toSQL $ mkSQLSelect jsonAggSelect sel
|
||||
|
||||
selectAggregateQuerySQL :: AnnAggregateSelect 'Postgres -> Q.Query
|
||||
selectAggregateQuerySQL =
|
||||
Q.fromBuilder . toSQL . mkAggregateSelect
|
||||
|
||||
connectionSelectQuerySQL :: ConnectionSelect 'Postgres S.SQLExp -> Q.Query
|
||||
connectionSelectQuerySQL =
|
||||
Q.fromBuilder . toSQL . mkConnectionSelect
|
||||
|
||||
asSingleRowJsonResp :: Q.Query -> [Q.PrepArg] -> Q.TxE QErr EncJSON
|
||||
asSingleRowJsonResp query args =
|
||||
encJFromBS . runIdentity . Q.getRow
|
||||
<$> Q.rawQE dmlTxErrorHandler query args True
|
||||
|
||||
phaseOne
|
||||
:: (QErrM m, UserInfoM m, CacheRM m, HasSQLGenCtx m)
|
||||
=> SelectQuery -> m (AnnSimpleSel 'Postgres, DS.Seq Q.PrepArg)
|
||||
|
||||
@ -1,105 +1,34 @@
|
||||
module Hasura.RQL.DML.Update
|
||||
( AnnUpdG(..)
|
||||
, traverseAnnUpd
|
||||
, execUpdateQuery
|
||||
, updateOperatorText
|
||||
, runUpdate
|
||||
( runUpdate
|
||||
) where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.Environment as Env
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.Sequence as DS
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Data.Environment as Env
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.Sequence as DS
|
||||
import qualified Database.PG.Query as Q
|
||||
|
||||
import Data.Aeson.Types
|
||||
import Data.Text.Extended
|
||||
import Instances.TH.Lift ()
|
||||
import Instances.TH.Lift ()
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
import qualified Hasura.Tracing as Tracing
|
||||
|
||||
import Hasura.Backends.Postgres.Connection
|
||||
import Hasura.Backends.Postgres.Execute.Mutation
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.Backends.Postgres.Translate.Returning
|
||||
import Hasura.EncJSON
|
||||
import Hasura.RQL.DML.Insert (insertCheckExpr)
|
||||
import Hasura.RQL.DML.Internal
|
||||
import Hasura.RQL.DML.Mutation
|
||||
import Hasura.RQL.DML.Returning
|
||||
import Hasura.RQL.DML.Update.Types
|
||||
import Hasura.RQL.GBoolExp
|
||||
import Hasura.RQL.Instances ()
|
||||
import Hasura.RQL.IR.Update
|
||||
import Hasura.RQL.Instances ()
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Session
|
||||
|
||||
|
||||
-- NOTE: This function can be improved, because we use
|
||||
-- the literal values defined below in the 'updateOperators'
|
||||
-- function in 'Hasura.GraphQL.Schema.Mutation'. It would
|
||||
-- be nice if we could avoid duplicating the string literal
|
||||
-- values
|
||||
updateOperatorText :: UpdOpExpG a -> Text
|
||||
updateOperatorText (UpdSet _) = "_set"
|
||||
updateOperatorText (UpdInc _) = "_inc"
|
||||
updateOperatorText (UpdAppend _) = "_append"
|
||||
updateOperatorText (UpdPrepend _) = "_prepend"
|
||||
updateOperatorText (UpdDeleteKey _) = "_delete_key"
|
||||
updateOperatorText (UpdDeleteElem _) = "_delete_elem"
|
||||
updateOperatorText (UpdDeleteAtPath _) = "_delete_at_path"
|
||||
|
||||
traverseAnnUpd
|
||||
:: (Applicative f)
|
||||
=> (a -> f b)
|
||||
-> AnnUpdG backend a
|
||||
-> f (AnnUpdG backend b)
|
||||
traverseAnnUpd f annUpd =
|
||||
AnnUpd tn
|
||||
<$> traverse (traverse $ traverse f) opExps
|
||||
<*> ((,) <$> traverseAnnBoolExp f whr <*> traverseAnnBoolExp f fltr)
|
||||
<*> traverseAnnBoolExp f chk
|
||||
<*> traverseMutationOutput f mutOutput
|
||||
<*> pure allCols
|
||||
where
|
||||
AnnUpd tn opExps (whr, fltr) chk mutOutput allCols = annUpd
|
||||
|
||||
mkUpdateCTE
|
||||
:: AnnUpd 'Postgres -> S.CTE
|
||||
mkUpdateCTE (AnnUpd tn opExps (permFltr, wc) chk _ columnsInfo) =
|
||||
S.CTEUpdate update
|
||||
where
|
||||
update =
|
||||
S.SQLUpdate tn setExp Nothing tableFltr
|
||||
. Just
|
||||
. S.RetExp
|
||||
$ [ S.selectStar
|
||||
, S.Extractor (insertCheckExpr "update check constraint failed" checkExpr) Nothing
|
||||
]
|
||||
setExp = S.SetExp $ map (expandOperator columnsInfo) opExps
|
||||
tableFltr = Just $ S.WhereFrag tableFltrExpr
|
||||
tableFltrExpr = toSQLBoolExp (S.QualTable tn) $ andAnnBoolExps permFltr wc
|
||||
checkExpr = toSQLBoolExp (S.QualTable tn) chk
|
||||
|
||||
expandOperator :: [ColumnInfo 'Postgres] -> (PGCol, UpdOpExpG S.SQLExp) -> S.SetExpItem
|
||||
expandOperator infos (column, op) = S.SetExpItem $ (column,) $ case op of
|
||||
UpdSet e -> e
|
||||
UpdInc e -> S.mkSQLOpExp S.incOp identifier (asNum e)
|
||||
UpdAppend e -> S.mkSQLOpExp S.jsonbConcatOp identifier (asJSON e)
|
||||
UpdPrepend e -> S.mkSQLOpExp S.jsonbConcatOp (asJSON e) identifier
|
||||
UpdDeleteKey e -> S.mkSQLOpExp S.jsonbDeleteOp identifier (asText e)
|
||||
UpdDeleteElem e -> S.mkSQLOpExp S.jsonbDeleteOp identifier (asInt e)
|
||||
UpdDeleteAtPath a -> S.mkSQLOpExp S.jsonbDeleteAtPathOp identifier (asArray a)
|
||||
where
|
||||
identifier = S.SEIdentifier $ toIdentifier column
|
||||
asInt e = S.SETyAnn e S.intTypeAnn
|
||||
asText e = S.SETyAnn e S.textTypeAnn
|
||||
asJSON e = S.SETyAnn e S.jsonbTypeAnn
|
||||
asArray a = S.SETyAnn (S.SEArray a) S.textArrTypeAnn
|
||||
asNum e = S.SETyAnn e $
|
||||
case find (\info -> pgiColumn info == column) infos <&> pgiType of
|
||||
Just (PGColumnScalar s) -> S.mkTypeAnn $ PGTypeScalar s
|
||||
_ -> S.numericTypeAnn
|
||||
|
||||
convInc
|
||||
:: (QErrM m)
|
||||
=> (PGColumnType -> Value -> m S.SQLExp)
|
||||
@ -250,24 +179,6 @@ validateUpdateQuery
|
||||
validateUpdateQuery =
|
||||
runDMLP1T . validateUpdateQueryWith sessVarFromCurrentSetting binRHSBuilder
|
||||
|
||||
execUpdateQuery
|
||||
::
|
||||
( HasVersion
|
||||
, MonadTx m
|
||||
, MonadIO m
|
||||
, Tracing.MonadTrace m
|
||||
)
|
||||
=> Env.Environment
|
||||
-> Bool
|
||||
-> Maybe MutationRemoteJoinCtx
|
||||
-> (AnnUpd 'Postgres, DS.Seq Q.PrepArg)
|
||||
-> m EncJSON
|
||||
execUpdateQuery env strfyNum remoteJoinCtx (u, p) =
|
||||
runMutation env $ mkMutation remoteJoinCtx (uqp1Table u) (updateCTE, p)
|
||||
(uqp1Output u) (uqp1AllCols u) strfyNum
|
||||
where
|
||||
updateCTE = mkUpdateCTE u
|
||||
|
||||
runUpdate
|
||||
:: ( HasVersion, QErrM m, UserInfoM m, CacheRM m
|
||||
, MonadTx m, HasSQLGenCtx m, MonadIO m
|
||||
|
||||
@ -1,38 +0,0 @@
|
||||
module Hasura.RQL.DML.Update.Types where
|
||||
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.RQL.DML.Returning.Types
|
||||
import Hasura.RQL.Types.BoolExp
|
||||
import Hasura.RQL.Types.Column
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.SQL.Backend
|
||||
|
||||
|
||||
data AnnUpdG (b :: Backend) v
|
||||
= AnnUpd
|
||||
{ uqp1Table :: !QualifiedTable
|
||||
, uqp1OpExps :: ![(Column b, UpdOpExpG v)]
|
||||
, uqp1Where :: !(AnnBoolExp b v, AnnBoolExp b v)
|
||||
, uqp1Check :: !(AnnBoolExp b v)
|
||||
-- we don't prepare the arguments for returning
|
||||
-- however the session variable can still be
|
||||
-- converted as desired
|
||||
, uqp1Output :: !(MutationOutputG b v)
|
||||
, uqp1AllCols :: ![ColumnInfo b]
|
||||
}
|
||||
|
||||
type AnnUpd b = AnnUpdG b S.SQLExp
|
||||
|
||||
data UpdOpExpG v = UpdSet !v
|
||||
| UpdInc !v
|
||||
| UpdAppend !v
|
||||
| UpdPrepend !v
|
||||
| UpdDeleteKey !v
|
||||
| UpdDeleteElem !v
|
||||
| UpdDeleteAtPath ![v]
|
||||
deriving (Functor, Foldable, Traversable, Generic, Data)
|
||||
@ -1,13 +1,16 @@
|
||||
module Hasura.RQL.DML.Delete.Types where
|
||||
module Hasura.RQL.IR.Delete where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.RQL.DML.Returning.Types
|
||||
import Hasura.RQL.IR.Returning
|
||||
import Hasura.RQL.Types.BoolExp
|
||||
import Hasura.RQL.Types.Column
|
||||
import Hasura.SQL.Backend
|
||||
|
||||
|
||||
data AnnDelG (b :: Backend) v
|
||||
= AnnDel
|
||||
{ dqp1Table :: !QualifiedTable
|
||||
@ -17,3 +20,16 @@ data AnnDelG (b :: Backend) v
|
||||
}
|
||||
|
||||
type AnnDel b = AnnDelG b S.SQLExp
|
||||
|
||||
traverseAnnDel
|
||||
:: (Applicative f)
|
||||
=> (a -> f b)
|
||||
-> AnnDelG backend a
|
||||
-> f (AnnDelG backend b)
|
||||
traverseAnnDel f annUpd =
|
||||
AnnDel tn
|
||||
<$> ((,) <$> traverseAnnBoolExp f whr <*> traverseAnnBoolExp f fltr)
|
||||
<*> traverseMutationOutput f mutOutput
|
||||
<*> pure allCols
|
||||
where
|
||||
AnnDel tn (whr, fltr) mutOutput allCols = annUpd
|
||||
@ -1,4 +1,4 @@
|
||||
module Hasura.RQL.DML.Insert.Types where
|
||||
module Hasura.RQL.IR.Insert where
|
||||
|
||||
|
||||
import Hasura.Prelude
|
||||
@ -6,7 +6,7 @@ import Hasura.Prelude
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.RQL.DML.Returning.Types
|
||||
import Hasura.RQL.IR.Returning
|
||||
import Hasura.RQL.Types.BoolExp
|
||||
import Hasura.RQL.Types.Column
|
||||
import Hasura.RQL.Types.Common
|
||||
27
server/src-lib/Hasura/RQL/IR/RemoteJoin.hs
Normal file
27
server/src-lib/Hasura/RQL/IR/RemoteJoin.hs
Normal file
@ -0,0 +1,27 @@
|
||||
module Hasura.RQL.IR.RemoteJoin
|
||||
( RemoteJoin(..)
|
||||
) where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
|
||||
import Hasura.GraphQL.Parser hiding (field)
|
||||
import Hasura.RQL.IR.Select
|
||||
import Hasura.RQL.Types
|
||||
|
||||
|
||||
-- | A 'RemoteJoin' represents the context of remote relationship to be extracted from 'AnnFieldG's.
|
||||
data RemoteJoin (b :: Backend)
|
||||
= RemoteJoin
|
||||
{ _rjName :: !FieldName -- ^ The remote join field name.
|
||||
, _rjArgs :: ![RemoteFieldArgument] -- ^ User-provided arguments with variables.
|
||||
, _rjSelSet :: !(G.SelectionSet G.NoFragments Variable) -- ^ User-provided selection set of remote field.
|
||||
, _rjHasuraFields :: !(HashSet FieldName) -- ^ Table fields.
|
||||
, _rjFieldCall :: !(NonEmpty FieldCall) -- ^ Remote server fields.
|
||||
, _rjRemoteSchema :: !RemoteSchemaInfo -- ^ The remote schema server info.
|
||||
, _rjPhantomFields :: ![ColumnInfo b]
|
||||
-- ^ Hasura fields which are not in the selection set, but are required as
|
||||
-- parameters to satisfy the remote join.
|
||||
}
|
||||
deriving instance Eq (RemoteJoin 'Postgres)
|
||||
81
server/src-lib/Hasura/RQL/IR/Returning.hs
Normal file
81
server/src-lib/Hasura/RQL/IR/Returning.hs
Normal file
@ -0,0 +1,81 @@
|
||||
module Hasura.RQL.IR.Returning where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.EncJSON
|
||||
import Hasura.RQL.IR.Select
|
||||
import Hasura.SQL.Backend
|
||||
|
||||
|
||||
data MutFldG (b :: Backend) v
|
||||
= MCount
|
||||
| MExp !Text
|
||||
| MRet !(AnnFieldsG b v)
|
||||
|
||||
type MutFld b = MutFldG b S.SQLExp
|
||||
|
||||
type MutFldsG b v = Fields (MutFldG b v)
|
||||
|
||||
data MutationOutputG (b :: Backend) v
|
||||
= MOutMultirowFields !(MutFldsG b v)
|
||||
| MOutSinglerowObject !(AnnFieldsG b v)
|
||||
|
||||
type MutationOutput b = MutationOutputG b S.SQLExp
|
||||
|
||||
type MutFlds b = MutFldsG b S.SQLExp
|
||||
|
||||
buildEmptyMutResp :: MutationOutput backend -> EncJSON
|
||||
buildEmptyMutResp = \case
|
||||
MOutMultirowFields mutFlds -> encJFromJValue $ OMap.fromList $ map (second convMutFld) mutFlds
|
||||
MOutSinglerowObject _ -> encJFromJValue $ J.Object mempty
|
||||
where
|
||||
convMutFld = \case
|
||||
MCount -> J.toJSON (0 :: Int)
|
||||
MExp e -> J.toJSON e
|
||||
MRet _ -> J.toJSON ([] :: [J.Value])
|
||||
|
||||
traverseMutFld
|
||||
:: (Applicative f)
|
||||
=> (a -> f b)
|
||||
-> MutFldG backend a
|
||||
-> f (MutFldG backend b)
|
||||
traverseMutFld f = \case
|
||||
MCount -> pure MCount
|
||||
MExp t -> pure $ MExp t
|
||||
MRet flds -> MRet <$> traverse (traverse (traverseAnnField f)) flds
|
||||
|
||||
traverseMutationOutput
|
||||
:: (Applicative f)
|
||||
=> (a -> f b)
|
||||
-> MutationOutputG backend a -> f (MutationOutputG backend b)
|
||||
traverseMutationOutput f = \case
|
||||
MOutMultirowFields mutationFields ->
|
||||
MOutMultirowFields <$> traverse (traverse (traverseMutFld f)) mutationFields
|
||||
MOutSinglerowObject annFields ->
|
||||
MOutSinglerowObject <$> traverseAnnFields f annFields
|
||||
|
||||
traverseMutFlds
|
||||
:: (Applicative f)
|
||||
=> (a -> f b)
|
||||
-> MutFldsG backend a
|
||||
-> f (MutFldsG backend b)
|
||||
traverseMutFlds f =
|
||||
traverse (traverse (traverseMutFld f))
|
||||
|
||||
hasNestedFld :: MutationOutputG backend a -> Bool
|
||||
hasNestedFld = \case
|
||||
MOutMultirowFields flds -> any isNestedMutFld flds
|
||||
MOutSinglerowObject annFlds -> any isNestedAnnField annFlds
|
||||
where
|
||||
isNestedMutFld (_, mutFld) = case mutFld of
|
||||
MRet annFlds -> any isNestedAnnField annFlds
|
||||
_ -> False
|
||||
isNestedAnnField (_, annFld) = case annFld of
|
||||
AFObjectRelation _ -> True
|
||||
AFArrayRelation _ -> True
|
||||
_ -> False
|
||||
@ -2,7 +2,7 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Hasura.RQL.DML.Select.Types where
|
||||
module Hasura.RQL.IR.Select where
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
@ -12,8 +12,6 @@ import qualified Data.Sequence as Seq
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
|
||||
import Control.Lens.TH (makeLenses, makePrisms)
|
||||
import Data.Aeson.Types
|
||||
import Language.Haskell.TH.Syntax (Lift)
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
@ -28,41 +26,12 @@ import Hasura.RQL.Types.RemoteRelationship
|
||||
import Hasura.RQL.Types.RemoteSchema
|
||||
import Hasura.SQL.Backend
|
||||
|
||||
type SelectQExt b = SelectG (ExtCol b) BoolExp Int
|
||||
|
||||
data JsonAggSelect
|
||||
= JASMultipleRows
|
||||
| JASSingleObject
|
||||
deriving (Show, Eq, Generic)
|
||||
instance Hashable JsonAggSelect
|
||||
|
||||
-- Columns in RQL
|
||||
data ExtCol (b :: Backend)
|
||||
= ECSimple !(Column b)
|
||||
| ECRel !RelName !(Maybe RelName) !(SelectQExt b)
|
||||
deriving instance Lift (ExtCol 'Postgres)
|
||||
|
||||
instance ToJSON (ExtCol 'Postgres) where
|
||||
toJSON (ECSimple s) = toJSON s
|
||||
toJSON (ECRel rn mrn selq) =
|
||||
object $ [ "name" .= rn
|
||||
, "alias" .= mrn
|
||||
] ++ selectGToPairs selq
|
||||
|
||||
instance FromJSON (ExtCol 'Postgres) where
|
||||
parseJSON v@(Object o) =
|
||||
ECRel
|
||||
<$> o .: "name"
|
||||
<*> o .:? "alias"
|
||||
<*> parseJSON v
|
||||
parseJSON v@(String _) =
|
||||
ECSimple <$> parseJSON v
|
||||
parseJSON _ =
|
||||
fail $ mconcat
|
||||
[ "A column should either be a string or an "
|
||||
, "object (relationship)"
|
||||
]
|
||||
|
||||
data AnnAggregateOrderBy (b :: Backend)
|
||||
= AAOCount
|
||||
| AAOOp !Text !(ColumnInfo b)
|
||||
68
server/src-lib/Hasura/RQL/IR/Update.hs
Normal file
68
server/src-lib/Hasura/RQL/IR/Update.hs
Normal file
@ -0,0 +1,68 @@
|
||||
module Hasura.RQL.IR.Update where
|
||||
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Hasura.Backends.Postgres.SQL.DML as S
|
||||
|
||||
import Hasura.Backends.Postgres.SQL.Types
|
||||
import Hasura.RQL.IR.Returning
|
||||
import Hasura.RQL.Types.BoolExp
|
||||
import Hasura.RQL.Types.Column
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.SQL.Backend
|
||||
|
||||
|
||||
data AnnUpdG (b :: Backend) v
|
||||
= AnnUpd
|
||||
{ uqp1Table :: !QualifiedTable
|
||||
, uqp1OpExps :: ![(Column b, UpdOpExpG v)]
|
||||
, uqp1Where :: !(AnnBoolExp b v, AnnBoolExp b v)
|
||||
, uqp1Check :: !(AnnBoolExp b v)
|
||||
-- we don't prepare the arguments for returning
|
||||
-- however the session variable can still be
|
||||
-- converted as desired
|
||||
, uqp1Output :: !(MutationOutputG b v)
|
||||
, uqp1AllCols :: ![ColumnInfo b]
|
||||
}
|
||||
|
||||
type AnnUpd b = AnnUpdG b S.SQLExp
|
||||
|
||||
data UpdOpExpG v = UpdSet !v
|
||||
| UpdInc !v
|
||||
| UpdAppend !v
|
||||
| UpdPrepend !v
|
||||
| UpdDeleteKey !v
|
||||
| UpdDeleteElem !v
|
||||
| UpdDeleteAtPath ![v]
|
||||
deriving (Functor, Foldable, Traversable, Generic, Data)
|
||||
|
||||
|
||||
-- NOTE: This function can be improved, because we use
|
||||
-- the literal values defined below in the 'updateOperators'
|
||||
-- function in 'Hasura.GraphQL.Schema.Mutation'. It would
|
||||
-- be nice if we could avoid duplicating the string literal
|
||||
-- values
|
||||
updateOperatorText :: UpdOpExpG a -> Text
|
||||
updateOperatorText (UpdSet _) = "_set"
|
||||
updateOperatorText (UpdInc _) = "_inc"
|
||||
updateOperatorText (UpdAppend _) = "_append"
|
||||
updateOperatorText (UpdPrepend _) = "_prepend"
|
||||
updateOperatorText (UpdDeleteKey _) = "_delete_key"
|
||||
updateOperatorText (UpdDeleteElem _) = "_delete_elem"
|
||||
updateOperatorText (UpdDeleteAtPath _) = "_delete_at_path"
|
||||
|
||||
traverseAnnUpd
|
||||
:: (Applicative f)
|
||||
=> (a -> f b)
|
||||
-> AnnUpdG backend a
|
||||
-> f (AnnUpdG backend b)
|
||||
traverseAnnUpd f annUpd =
|
||||
AnnUpd tn
|
||||
<$> traverse (traverse $ traverse f) opExps
|
||||
<*> ((,) <$> traverseAnnBoolExp f whr <*> traverseAnnBoolExp f fltr)
|
||||
<*> traverseAnnBoolExp f chk
|
||||
<*> traverseMutationOutput f mutOutput
|
||||
<*> pure allCols
|
||||
where
|
||||
AnnUpd tn opExps (whr, fltr) chk mutOutput allCols = annUpd
|
||||
@ -66,7 +66,7 @@ import Language.Haskell.TH.Syntax (Lift)
|
||||
|
||||
import Hasura.Incremental (Cacheable)
|
||||
import Hasura.RQL.DDL.Headers
|
||||
import Hasura.RQL.DML.Select.Types
|
||||
import Hasura.RQL.IR.Select
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.RQL.Types.CustomTypes
|
||||
import Hasura.SQL.Backend
|
||||
|
||||
Loading…
Reference in New Issue
Block a user