graphql-engine/server/src-lib/Hasura/RQL/DML/Update.hs

225 lines
6.7 KiB
Haskell
Raw Normal View History

module Hasura.RQL.DML.Update
( validateUpdateQueryWith
, validateUpdateQuery
2019-04-17 12:48:41 +03:00
, AnnUpdG(..)
, traverseAnnUpd
, AnnUpd
, 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
import Hasura.EncJSON
2018-06-27 16:11:32 +03:00
import Hasura.Prelude
import Hasura.RQL.DML.Internal
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
{ 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)
, 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
mkUpdateCTE
2019-04-17 12:48:41 +03:00
:: AnnUpd -> S.CTE
mkUpdateCTE (AnnUpd tn setExps (permFltr, wc) _ _) =
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
tableFltr = Just $ S.WhereFrag $
toSQLBoolExp (S.QualTable tn) $ andAnnBoolExps permFltr wc
2018-06-27 16:11:32 +03:00
convInc
:: (QErrM m)
=> (PGColumnType -> Value -> m S.SQLExp)
2018-06-27 16:11:32 +03:00
-> PGCol
-> PGColumnType
2018-06-27 16:11:32 +03:00
-> Value
-> m (PGCol, S.SQLExp)
convInc f col colType val = do
prepExp <- f colType val
return (col, S.SEOpApp S.incOp [S.mkSIdenExp col, prepExp])
2018-06-27 16:11:32 +03:00
convMul
:: (QErrM m)
=> (PGColumnType -> Value -> m S.SQLExp)
2018-06-27 16:11:32 +03:00
-> PGCol
-> PGColumnType
2018-06-27 16:11:32 +03:00
-> Value
-> m (PGCol, S.SQLExp)
convMul f col colType val = do
prepExp <- f colType val
return (col, S.SEOpApp S.mulOp [S.mkSIdenExp col, prepExp])
2018-06-27 16:11:32 +03:00
convSet
:: (QErrM m)
=> (PGColumnType -> Value -> m S.SQLExp)
2018-06-27 16:11:32 +03:00
-> PGCol
-> 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)
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)
=> FieldInfoMap FieldInfo
-> [PGCol]
2018-06-27 16:11:32 +03:00
-> UpdPermInfo
-> [(PGCol, a)]
-> (PGCol -> PGColumnType -> a -> m (PGCol, S.SQLExp))
2018-06-27 16:11:32 +03:00
-> m [(PGCol, S.SQLExp)]
convOp fieldInfoMap preSetCols updPerm objs conv =
2018-06-27 16:11:32 +03:00
forM objs $ \(pgCol, a) -> do
-- 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"
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
validateUpdateQueryWith
:: (UserInfoM m, QErrM m, CacheRM m)
2019-04-17 12:48:41 +03:00
=> SessVarBldr m
-> (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
let coreInfo = _tiCoreInfo tableInfo
2018-06-27 16:11:32 +03:00
-- If it is view then check if it is updatable
mutableView tableName viIsUpdatable
(_tciViewInfo coreInfo) "updatable"
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
let fieldInfoMap = _tciFieldInfoMap coreInfo
allCols = getCols fieldInfoMap
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" $
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 ->
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)
(mkDefaultMutFlds mAnnRetCols)
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"
validateUpdateQuery
:: (QErrM m, UserInfoM m, CacheRM m)
2019-04-17 12:48:41 +03:00
=> UpdateQuery -> m (AnnUpd, DS.Seq Q.PrepArg)
validateUpdateQuery =
runDMLP1T . validateUpdateQueryWith sessVarFromCurrentSetting binRHSBuilder
2018-06-27 16:11:32 +03:00
updateQueryToTx
2019-04-17 12:48:41 +03:00
:: Bool -> (AnnUpd, DS.Seq Q.PrepArg) -> Q.TxE QErr EncJSON
updateQueryToTx strfyNum (u, p) =
runMutation $ Mutation (uqp1Table u) (updateCTE, p)
(uqp1MutFlds u) (uqp1AllCols u) strfyNum
2018-06-27 16:11:32 +03:00
where
updateCTE = mkUpdateCTE u
2018-06-27 16:11:32 +03:00
runUpdate
:: (QErrM m, UserInfoM m, CacheRM m, MonadTx m, HasSQLGenCtx m)
=> UpdateQuery -> m EncJSON
runUpdate q = do
strfyNum <- stringifyNum <$> askSQLGenCtx
validateUpdateQuery q >>= liftTx . updateQueryToTx strfyNum