2018-12-13 10:26:15 +03:00
|
|
|
module Hasura.RQL.DML.Update
|
|
|
|
( validateUpdateQueryWith
|
|
|
|
, validateUpdateQuery
|
2019-04-17 12:48:41 +03:00
|
|
|
, AnnUpdG(..)
|
|
|
|
, traverseAnnUpd
|
|
|
|
, AnnUpd
|
2018-12-13 10:26:15 +03:00
|
|
|
, updateQueryToTx
|
|
|
|
, runUpdate
|
|
|
|
) where
|
2018-06-27 16:11:32 +03:00
|
|
|
|
|
|
|
import Data.Aeson.Types
|
|
|
|
import Instances.TH.Lift ()
|
|
|
|
|
|
|
|
import qualified Data.HashMap.Strict as M
|
|
|
|
import qualified Data.Sequence as DS
|
|
|
|
|
2019-03-18 19:22:21 +03:00
|
|
|
import Hasura.EncJSON
|
2018-06-27 16:11:32 +03:00
|
|
|
import Hasura.Prelude
|
|
|
|
import Hasura.RQL.DML.Internal
|
2019-03-07 13:24:07 +03:00
|
|
|
import Hasura.RQL.DML.Mutation
|
2018-06-27 16:11:32 +03:00
|
|
|
import Hasura.RQL.DML.Returning
|
|
|
|
import Hasura.RQL.GBoolExp
|
|
|
|
import Hasura.RQL.Instances ()
|
|
|
|
import Hasura.RQL.Types
|
|
|
|
import Hasura.SQL.Types
|
|
|
|
|
|
|
|
import qualified Database.PG.Query as Q
|
|
|
|
import qualified Hasura.SQL.DML as S
|
|
|
|
|
2019-04-17 12:48:41 +03:00
|
|
|
data AnnUpdG v
|
|
|
|
= AnnUpd
|
2019-03-22 10:08:42 +03:00
|
|
|
{ uqp1Table :: !QualifiedTable
|
2019-04-17 12:48:41 +03:00
|
|
|
, uqp1SetExps :: ![(PGCol, v)]
|
|
|
|
, uqp1Where :: !(AnnBoolExp v, AnnBoolExp v)
|
|
|
|
-- we don't prepare the arguments for returning
|
|
|
|
-- however the session variable can still be
|
|
|
|
-- converted as desired
|
|
|
|
, uqp1MutFlds :: !(MutFldsG v)
|
2019-08-11 18:34:38 +03:00
|
|
|
, uqp1AllCols :: ![PGColumnInfo]
|
2018-06-27 16:11:32 +03:00
|
|
|
} deriving (Show, Eq)
|
|
|
|
|
2019-04-17 12:48:41 +03:00
|
|
|
traverseAnnUpd
|
|
|
|
:: (Applicative f)
|
|
|
|
=> (a -> f b)
|
|
|
|
-> AnnUpdG a
|
|
|
|
-> f (AnnUpdG b)
|
|
|
|
traverseAnnUpd f annUpd =
|
|
|
|
AnnUpd tn
|
|
|
|
<$> traverse (traverse f) setExps
|
|
|
|
<*> ((,) <$> traverseAnnBoolExp f whr <*> traverseAnnBoolExp f fltr)
|
|
|
|
<*> traverseMutFlds f mutFlds
|
|
|
|
<*> pure allCols
|
|
|
|
where
|
|
|
|
AnnUpd tn setExps (whr, fltr) mutFlds allCols = annUpd
|
|
|
|
|
|
|
|
type AnnUpd = AnnUpdG S.SQLExp
|
|
|
|
|
2019-03-07 13:24:07 +03:00
|
|
|
mkUpdateCTE
|
2019-04-17 12:48:41 +03:00
|
|
|
:: AnnUpd -> S.CTE
|
|
|
|
mkUpdateCTE (AnnUpd tn setExps (permFltr, wc) _ _) =
|
2019-03-07 13:24:07 +03:00
|
|
|
S.CTEUpdate update
|
2018-06-27 16:11:32 +03:00
|
|
|
where
|
|
|
|
update = S.SQLUpdate tn setExp Nothing tableFltr $ Just S.returningStar
|
|
|
|
setExp = S.SetExp $ map S.SetExpItem setExps
|
2018-11-16 15:40:23 +03:00
|
|
|
tableFltr = Just $ S.WhereFrag $
|
|
|
|
toSQLBoolExp (S.QualTable tn) $ andAnnBoolExps permFltr wc
|
2018-06-27 16:11:32 +03:00
|
|
|
|
|
|
|
convInc
|
|
|
|
:: (QErrM m)
|
2019-07-22 15:47:13 +03:00
|
|
|
=> (PGColumnType -> Value -> m S.SQLExp)
|
2018-06-27 16:11:32 +03:00
|
|
|
-> PGCol
|
2019-07-22 15:47:13 +03:00
|
|
|
-> PGColumnType
|
2018-06-27 16:11:32 +03:00
|
|
|
-> Value
|
|
|
|
-> m (PGCol, S.SQLExp)
|
|
|
|
convInc f col colType val = do
|
|
|
|
prepExp <- f colType val
|
2018-07-20 13:51:20 +03:00
|
|
|
return (col, S.SEOpApp S.incOp [S.mkSIdenExp col, prepExp])
|
2018-06-27 16:11:32 +03:00
|
|
|
|
|
|
|
convMul
|
|
|
|
:: (QErrM m)
|
2019-07-22 15:47:13 +03:00
|
|
|
=> (PGColumnType -> Value -> m S.SQLExp)
|
2018-06-27 16:11:32 +03:00
|
|
|
-> PGCol
|
2019-07-22 15:47:13 +03:00
|
|
|
-> PGColumnType
|
2018-06-27 16:11:32 +03:00
|
|
|
-> Value
|
|
|
|
-> m (PGCol, S.SQLExp)
|
|
|
|
convMul f col colType val = do
|
|
|
|
prepExp <- f colType val
|
2018-07-20 13:51:20 +03:00
|
|
|
return (col, S.SEOpApp S.mulOp [S.mkSIdenExp col, prepExp])
|
2018-06-27 16:11:32 +03:00
|
|
|
|
|
|
|
convSet
|
|
|
|
:: (QErrM m)
|
2019-07-22 15:47:13 +03:00
|
|
|
=> (PGColumnType -> Value -> m S.SQLExp)
|
2018-06-27 16:11:32 +03:00
|
|
|
-> PGCol
|
2019-07-22 15:47:13 +03:00
|
|
|
-> PGColumnType
|
2018-06-27 16:11:32 +03:00
|
|
|
-> Value
|
|
|
|
-> m (PGCol, S.SQLExp)
|
|
|
|
convSet f col colType val = do
|
|
|
|
prepExp <- f colType val
|
|
|
|
return (col, prepExp)
|
|
|
|
|
2019-07-22 15:47:13 +03:00
|
|
|
convDefault :: (Monad m) => PGCol -> PGColumnType -> () -> m (PGCol, S.SQLExp)
|
2018-06-27 16:11:32 +03:00
|
|
|
convDefault col _ _ = return (col, S.SEUnsafe "DEFAULT")
|
|
|
|
|
|
|
|
convOp
|
|
|
|
:: (UserInfoM m, QErrM m)
|
2019-11-20 21:21:30 +03:00
|
|
|
=> FieldInfoMap FieldInfo
|
2019-02-11 15:45:30 +03:00
|
|
|
-> [PGCol]
|
2018-06-27 16:11:32 +03:00
|
|
|
-> UpdPermInfo
|
|
|
|
-> [(PGCol, a)]
|
2019-07-22 15:47:13 +03:00
|
|
|
-> (PGCol -> PGColumnType -> a -> m (PGCol, S.SQLExp))
|
2018-06-27 16:11:32 +03:00
|
|
|
-> m [(PGCol, S.SQLExp)]
|
2019-02-11 15:45:30 +03:00
|
|
|
convOp fieldInfoMap preSetCols updPerm objs conv =
|
2018-06-27 16:11:32 +03:00
|
|
|
forM objs $ \(pgCol, a) -> do
|
2019-02-11 15:45:30 +03:00
|
|
|
-- if column has predefined value then throw error
|
|
|
|
when (pgCol `elem` preSetCols) $ throwNotUpdErr pgCol
|
2018-06-27 16:11:32 +03:00
|
|
|
checkPermOnCol PTUpdate allowedCols pgCol
|
|
|
|
colType <- askPGType fieldInfoMap pgCol relWhenPgErr
|
|
|
|
res <- conv pgCol colType a
|
|
|
|
-- build a set expression's entry
|
|
|
|
withPathK (getPGColTxt pgCol) $ return res
|
|
|
|
where
|
|
|
|
allowedCols = upiCols updPerm
|
|
|
|
relWhenPgErr = "relationships can't be updated"
|
2019-02-11 15:45:30 +03:00
|
|
|
throwNotUpdErr c = do
|
|
|
|
role <- userRole <$> askUserInfo
|
|
|
|
throw400 NotSupported $ "column " <> c <<> " is not updatable"
|
|
|
|
<> " for role " <> role <<> "; its value is predefined in permission"
|
2018-06-27 16:11:32 +03:00
|
|
|
|
2018-12-13 10:26:15 +03:00
|
|
|
validateUpdateQueryWith
|
|
|
|
:: (UserInfoM m, QErrM m, CacheRM m)
|
2019-04-17 12:48:41 +03:00
|
|
|
=> SessVarBldr m
|
2019-07-22 15:47:13 +03:00
|
|
|
-> (PGColumnType -> Value -> m S.SQLExp)
|
2018-06-27 16:11:32 +03:00
|
|
|
-> UpdateQuery
|
2019-04-17 12:48:41 +03:00
|
|
|
-> m AnnUpd
|
|
|
|
validateUpdateQueryWith sessVarBldr prepValBldr uq = do
|
2018-06-27 16:11:32 +03:00
|
|
|
let tableName = uqTable uq
|
|
|
|
tableInfo <- withPathK "table" $ askTabInfo tableName
|
2019-11-20 21:21:30 +03:00
|
|
|
let coreInfo = _tiCoreInfo tableInfo
|
2018-06-27 16:11:32 +03:00
|
|
|
|
2018-10-12 15:06:12 +03:00
|
|
|
-- If it is view then check if it is updatable
|
|
|
|
mutableView tableName viIsUpdatable
|
2019-11-20 21:21:30 +03:00
|
|
|
(_tciViewInfo coreInfo) "updatable"
|
2018-10-12 15:06:12 +03:00
|
|
|
|
2018-06-27 16:11:32 +03:00
|
|
|
-- Check if the role has update permissions
|
|
|
|
updPerm <- askUpdPermInfo tableInfo
|
|
|
|
|
|
|
|
-- Check if all dependent headers are present
|
|
|
|
validateHeaders $ upiRequiredHeaders updPerm
|
|
|
|
|
|
|
|
-- Check if select is allowed
|
|
|
|
selPerm <- modifyErr (<> selNecessaryMsg) $
|
|
|
|
askSelPermInfo tableInfo
|
|
|
|
|
2019-11-20 21:21:30 +03:00
|
|
|
let fieldInfoMap = _tciFieldInfoMap coreInfo
|
2019-03-22 10:08:42 +03:00
|
|
|
allCols = getCols fieldInfoMap
|
2019-02-11 15:45:30 +03:00
|
|
|
preSetObj = upiSet updPerm
|
|
|
|
preSetCols = M.keys preSetObj
|
2018-06-27 16:11:32 +03:00
|
|
|
|
|
|
|
-- convert the object to SQL set expression
|
|
|
|
setItems <- withPathK "$set" $
|
2019-04-17 12:48:41 +03:00
|
|
|
convOp fieldInfoMap preSetCols updPerm (M.toList $ uqSet uq) $ convSet prepValBldr
|
2018-06-27 16:11:32 +03:00
|
|
|
|
|
|
|
incItems <- withPathK "$inc" $
|
2019-04-17 12:48:41 +03:00
|
|
|
convOp fieldInfoMap preSetCols updPerm (M.toList $ uqInc uq) $ convInc prepValBldr
|
2018-06-27 16:11:32 +03:00
|
|
|
|
|
|
|
mulItems <- withPathK "$mul" $
|
2019-04-17 12:48:41 +03:00
|
|
|
convOp fieldInfoMap preSetCols updPerm (M.toList $ uqMul uq) $ convMul prepValBldr
|
2018-06-27 16:11:32 +03:00
|
|
|
|
|
|
|
defItems <- withPathK "$default" $
|
2019-02-11 15:45:30 +03:00
|
|
|
convOp fieldInfoMap preSetCols updPerm (zip (uqDefault uq) [()..]) convDefault
|
2018-06-27 16:11:32 +03:00
|
|
|
|
|
|
|
-- convert the returning cols into sql returing exp
|
|
|
|
mAnnRetCols <- forM mRetCols $ \retCols ->
|
2018-10-05 11:56:47 +03:00
|
|
|
withPathK "returning" $ checkRetCols fieldInfoMap selPerm retCols
|
2018-06-27 16:11:32 +03:00
|
|
|
|
2019-04-17 12:48:41 +03:00
|
|
|
resolvedPreSetItems <- M.toList <$>
|
|
|
|
mapM (convPartialSQLExp sessVarBldr) preSetObj
|
|
|
|
|
|
|
|
let setExpItems = resolvedPreSetItems ++ setItems ++ incItems ++
|
|
|
|
mulItems ++ defItems
|
2018-06-27 16:11:32 +03:00
|
|
|
|
|
|
|
when (null setExpItems) $
|
|
|
|
throw400 UnexpectedPayload "atleast one of $set, $inc, $mul has to be present"
|
|
|
|
|
|
|
|
-- convert the where clause
|
|
|
|
annSQLBoolExp <- withPathK "where" $
|
2019-04-17 12:48:41 +03:00
|
|
|
convBoolExp fieldInfoMap selPerm (uqWhere uq) sessVarBldr prepValBldr
|
|
|
|
|
|
|
|
resolvedUpdFltr <- convAnnBoolExpPartialSQL sessVarBldr $
|
|
|
|
upiFilter updPerm
|
2018-06-27 16:11:32 +03:00
|
|
|
|
2019-04-17 12:48:41 +03:00
|
|
|
return $ AnnUpd
|
2018-06-27 16:11:32 +03:00
|
|
|
tableName
|
|
|
|
setExpItems
|
2019-04-17 12:48:41 +03:00
|
|
|
(resolvedUpdFltr, annSQLBoolExp)
|
2018-11-02 17:01:01 +03:00
|
|
|
(mkDefaultMutFlds mAnnRetCols)
|
2019-03-22 10:08:42 +03:00
|
|
|
allCols
|
2018-06-27 16:11:32 +03:00
|
|
|
where
|
|
|
|
mRetCols = uqReturning uq
|
|
|
|
selNecessaryMsg =
|
|
|
|
"; \"update\" is only allowed if the role "
|
|
|
|
<> "has \"select\" permission as \"where\" can't be used "
|
|
|
|
<> "without \"select\" permission on the table"
|
|
|
|
|
2018-12-13 10:26:15 +03:00
|
|
|
validateUpdateQuery
|
2019-11-20 21:21:30 +03:00
|
|
|
:: (QErrM m, UserInfoM m, CacheRM m)
|
2019-04-17 12:48:41 +03:00
|
|
|
=> UpdateQuery -> m (AnnUpd, DS.Seq Q.PrepArg)
|
2018-12-13 10:26:15 +03:00
|
|
|
validateUpdateQuery =
|
2019-11-20 21:21:30 +03:00
|
|
|
runDMLP1T . validateUpdateQueryWith sessVarFromCurrentSetting binRHSBuilder
|
2018-06-27 16:11:32 +03:00
|
|
|
|
2019-03-07 13:24:07 +03:00
|
|
|
updateQueryToTx
|
2019-04-17 12:48:41 +03:00
|
|
|
:: Bool -> (AnnUpd, DS.Seq Q.PrepArg) -> Q.TxE QErr EncJSON
|
2019-03-01 14:45:04 +03:00
|
|
|
updateQueryToTx strfyNum (u, p) =
|
2019-03-07 13:24:07 +03:00
|
|
|
runMutation $ Mutation (uqp1Table u) (updateCTE, p)
|
2019-03-22 10:08:42 +03:00
|
|
|
(uqp1MutFlds u) (uqp1AllCols u) strfyNum
|
2018-06-27 16:11:32 +03:00
|
|
|
where
|
2019-03-07 13:24:07 +03:00
|
|
|
updateCTE = mkUpdateCTE u
|
2018-06-27 16:11:32 +03:00
|
|
|
|
2018-12-13 10:26:15 +03:00
|
|
|
runUpdate
|
2019-11-20 21:21:30 +03:00
|
|
|
:: (QErrM m, UserInfoM m, CacheRM m, MonadTx m, HasSQLGenCtx m)
|
2019-03-18 19:22:21 +03:00
|
|
|
=> UpdateQuery -> m EncJSON
|
2019-03-01 14:45:04 +03:00
|
|
|
runUpdate q = do
|
|
|
|
strfyNum <- stringifyNum <$> askSQLGenCtx
|
|
|
|
validateUpdateQuery q >>= liftTx . updateQueryToTx strfyNum
|