hasura · lexi-lambda · Aug 16, 2019 · Aug 7, 2019 · Aug 7, 2019 · Aug 7, 2019
@@ -299,6 +299,7 @@ library
                       QuasiQuotes
                       TypeFamilies
                       NoImplicitPrelude
+                      DeriveDataTypeable
 
 
   if flag(profile)

@@ -16,6 +16,7 @@ import           Control.Monad.Identity     as M
 import           Control.Monad.Reader       as M
 import           Control.Monad.State.Strict as M
 import           Data.Bool                  as M (bool)
+import           Data.Data                  as M (Data (..))
 import           Data.Either                as M (lefts, partitionEithers,
                                                   rights)
 import           Data.Foldable              as M (foldrM, toList)

@@ -258,7 +258,7 @@ subTableP2Setup qt (EventTriggerConf name def webhook webhookFromEnv rconf mhead
   webhookInfo <- getWebhookInfoFromConf webhookConf
   headerInfos <- getHeaderInfosFromConf headerConfs
   let eTrigInfo = EventTriggerInfo name def rconf webhookInfo headerInfos
-      tabDep = SchemaDependency (SOTable qt) "parent"
+      tabDep = SchemaDependency (SOTable qt) DRParent
   addEventTriggerToCache qt eTrigInfo (tabDep:getTrigDefDeps qt def)
 
 getTrigDefDeps :: QualifiedTable -> TriggerOpsDef -> [SchemaDependency]
@@ -272,10 +272,10 @@ getTrigDefDeps qt (TriggerOpsDef mIns mUpd mDel _) =
     subsOpSpecDeps os =
       let cols = getColsFromSub $ sosColumns os
           colDeps = flip map cols $ \col ->
-            SchemaDependency (SOTableObj qt (TOCol col)) "column"
+            SchemaDependency (SOTableObj qt (TOCol col)) DRColumn
           payload = maybe [] getColsFromSub (sosPayload os)
           payloadDeps = flip map payload $ \col ->
-            SchemaDependency (SOTableObj qt (TOCol col)) "payload"
+            SchemaDependency (SOTableObj qt (TOCol col)) DRPayload
         in colDeps <> payloadDeps
     getColsFromSub sc = case sc of
       SubCStar         -> []

@@ -44,6 +44,9 @@ module Hasura.RQL.DDL.Permission
 
     , SetPermComment(..)
     , runSetPermComment
+
+    , rebuildPermInfo
+    , fetchPermDef
     ) where
 
 import           Hasura.EncJSON
@@ -108,21 +111,23 @@ procSetObj
   => TableInfo -> Maybe ColVals
   -> m (PreSetColsPartial, [Text], [SchemaDependency])
 procSetObj ti mObj = do
-  setColsSQL <- withPathK "set" $
-    fmap HM.fromList $ forM (HM.toList setObj) $ \(pgCol, val) -> do
+  (setColTups, deps) <- withPathK "set" $
+    fmap unzip $ forM (HM.toList setObj) $ \(pgCol, val) -> do
       ty <- askPGType fieldInfoMap pgCol $
         "column " <> pgCol <<> " not found in table " <>> tn
       sqlExp <- valueParser (PgTypeSimple ty) val
-      return (pgCol, sqlExp)
-  let deps = map (mkColDep "on_type" tn . fst) $ HM.toList setColsSQL
-  return (setColsSQL, depHeaders, deps)
+      let dep = mkColDep (getDepReason sqlExp) tn pgCol
+      return ((pgCol, sqlExp), dep)
+  return (HM.fromList setColTups, depHeaders, deps)
   where
     fieldInfoMap = tiFieldInfoMap ti
     tn = tiName ti
     setObj = fromMaybe mempty mObj
     depHeaders = getDepHeadersFromVal $ Object $
       HM.fromList $ map (first getPGColTxt) $ HM.toList setObj
 
+    getDepReason = bool DRSessionVariable DROnType . isStaticValue
+
 buildInsPermInfo
   :: (QErrM m, CacheRM m)
   => TableInfo
@@ -138,7 +143,7 @@ buildInsPermInfo tabInfo (PermDef rn (InsPerm chk set mCols) _) =
          askPGType fieldInfoMap col ""
   let fltrHeaders = getDependentHeaders chk
       reqHdrs = fltrHeaders `union` setHdrs
-      insColDeps = map (mkColDep "untyped" tn) insCols
+      insColDeps = map (mkColDep DRUntyped tn) insCols
       deps = mkParentDep tn : beDeps ++ setColDeps ++ insColDeps
       insColsWithoutPresets = insCols \\ HM.keys setColsSQL
   return (InsPermInfo (HS.fromList insColsWithoutPresets) vn be setColsSQL reqHdrs, deps)
@@ -221,7 +226,7 @@ buildSelPermInfo tabInfo sp = do
   void $ withPathK "columns" $ indexedForM pgCols $ \pgCol ->
     askPGType fieldInfoMap pgCol autoInferredErr
 
-  let deps = mkParentDep tn : beDeps ++ map (mkColDep "untyped" tn) pgCols
+  let deps = mkParentDep tn : beDeps ++ map (mkColDep DRUntyped tn) pgCols
       depHeaders = getDependentHeaders $ spFilter sp
       mLimit = spLimit sp
 
@@ -291,7 +296,7 @@ buildUpdPermInfo tabInfo (UpdPerm colSpec set fltr) = do
   void $ withPathK "columns" $ indexedForM updCols $ \updCol ->
        askPGType fieldInfoMap updCol relInUpdErr
 
-  let updColDeps = map (mkColDep "untyped" tn) updCols
+  let updColDeps = map (mkColDep DRUntyped tn) updCols
       deps = mkParentDep tn : beDeps ++ updColDeps ++ setColDeps
       depHeaders = getDependentHeaders fltr
       reqHeaders = depHeaders `union` setHeaders
@@ -437,3 +442,47 @@ purgePerm qt rn pt =
   where
     dp :: DropPerm a
     dp = DropPerm qt rn
+
+rebuildPermInfo
+  :: (QErrM m, CacheRWM m, MonadTx m)
+  => QualifiedTable -> RoleName -> PermType -> m ()
+rebuildPermInfo qt rn pt = do
+  (pDef, comment) <- liftTx $ fetchPermDef qt rn pt
+  case pt of
+    PTInsert -> do
+      perm <- decodeValue pDef
+      updatePerm PAInsert $ PermDef rn perm comment
+    PTSelect -> do
+      perm <- decodeValue pDef
+      updatePerm PASelect $ PermDef rn perm comment
+    PTUpdate -> do
+      perm <- decodeValue pDef
+      updatePerm PAUpdate $ PermDef rn perm comment
+    PTDelete -> do
+      perm <- decodeValue pDef
+      updatePerm PADelete $ PermDef rn perm comment
+
+  where
+    updatePerm :: (QErrM m, CacheRWM m, IsPerm a)
+               => PermAccessor (PermInfo a) -> PermDef a -> m ()
+    updatePerm pa perm = do
+      delPermFromCache pa rn qt
+      tabInfo <- askTabInfo qt
+      (permInfo, deps) <- addPermP1 tabInfo perm
+      addPermToCache qt rn pa permInfo deps
+
+fetchPermDef
+  :: QualifiedTable
+  -> RoleName
+  -> PermType
+  -> Q.TxE QErr (Value, Maybe T.Text)
+fetchPermDef (QualifiedObject sn tn) rn pt =
+ (first Q.getAltJ .  Q.getRow) <$> Q.withQE defaultTxErrorHandler
+      [Q.sql|
+            SELECT perm_def::json, comment
+              FROM hdb_catalog.hdb_permission
+             WHERE table_schema = $1
+               AND table_name = $2
+               AND role_name = $3
+               AND perm_type = $4
+            |] (sn, tn, rn, permTypeToCode pt) True
@@ -111,20 +111,20 @@ objRelP2Setup qt fkeys (RelDef rn ru _) = do
     RUManual (ObjRelManualConfig rm) -> do
       let refqt = rmTable rm
           (lCols, rCols) = unzip $ M.toList $ rmColumns rm
-          deps  = map (\c -> SchemaDependency (SOTableObj qt $ TOCol c) "lcol") lCols
-                  <> map (\c -> SchemaDependency (SOTableObj refqt $ TOCol c) "rcol") rCols
+          deps  = map (\c -> SchemaDependency (SOTableObj qt $ TOCol c) DRLeftColumn) lCols
+                  <> map (\c -> SchemaDependency (SOTableObj refqt $ TOCol c) DRRightColumn) rCols
       return (RelInfo rn ObjRel (zip lCols rCols) refqt True, deps)
     RUFKeyOn cn -> do
       -- TODO: validation should account for this too
       ForeignKey _ refqt _ consName colMap <-
         getRequiredFkey cn fkeys $ \fk -> _fkTable fk == qt
 
-      let deps = [ SchemaDependency (SOTableObj qt $ TOCons consName) "fkey"
-                 , SchemaDependency (SOTableObj qt $ TOCol cn) "using_col"
+      let deps = [ SchemaDependency (SOTableObj qt $ TOCons consName) DRFkey
+                 , SchemaDependency (SOTableObj qt $ TOCol cn) DRUsingColumn
                  -- this needs to be added explicitly to handle the remote table
                  -- being untracked. In this case, neither the using_col nor
                  -- the constraint name will help.
-                 , SchemaDependency (SOTable refqt) "remote_table"
+                 , SchemaDependency (SOTable refqt) DRRemoteTable
                  ]
           colMapping = HM.toList colMap
       void $ askTabInfo refqt
@@ -186,19 +186,19 @@ arrRelP2Setup qt fkeys (RelDef rn ru _) = do
     RUManual (ArrRelManualConfig rm) -> do
       let refqt = rmTable rm
           (lCols, rCols) = unzip $ M.toList $ rmColumns rm
-          deps  = map (\c -> SchemaDependency (SOTableObj qt $ TOCol c) "lcol") lCols
-                  <> map (\c -> SchemaDependency (SOTableObj refqt $ TOCol c) "rcol") rCols
+          deps  = map (\c -> SchemaDependency (SOTableObj qt $ TOCol c) DRLeftColumn) lCols
+                  <> map (\c -> SchemaDependency (SOTableObj refqt $ TOCol c) DRRightColumn) rCols
       return (RelInfo rn ArrRel (zip lCols rCols) refqt True, deps)
     RUFKeyOn (ArrRelUsingFKeyOn refqt refCol) -> do
       -- TODO: validation should account for this too
       ForeignKey _ _ _ consName colMap <- getRequiredFkey refCol fkeys $
         \fk -> _fkTable fk == refqt && _fkRefTable fk == qt
-      let deps = [ SchemaDependency (SOTableObj refqt $ TOCons consName) "remote_fkey"
-                 , SchemaDependency (SOTableObj refqt $ TOCol refCol) "using_col"
+      let deps = [ SchemaDependency (SOTableObj refqt $ TOCons consName) DRRemoteFkey
+                 , SchemaDependency (SOTableObj refqt $ TOCol refCol) DRUsingColumn
                  -- we don't need to necessarily track the remote table like we did in
                  -- case of obj relationships as the remote table is indirectly
                  -- tracked by tracking the constraint name and 'using_col'
-                 , SchemaDependency (SOTable refqt) "remote_table"
+                 , SchemaDependency (SOTable refqt) DRRemoteTable
                  ]
           mapping = HM.toList colMap
       return (RelInfo rn ArrRel (map swap mapping) refqt False, deps)

@@ -85,7 +85,7 @@ mkFunctionInfo qf rawFuncInfo = do
   validateFuncArgs funcArgs
 
   let funcArgsSeq = Seq.fromList funcArgs
-      dep = SchemaDependency (SOTable retTable) "table"
+      dep = SchemaDependency (SOTable retTable) DRTable
       retTable = QualifiedObject retSn (TableName retN)
   return $ FunctionInfo qf False funTy funcArgsSeq retTable [dep]
   where

@@ -169,7 +169,7 @@ updateArrRelDef qt rn (oldQT, newQT) = do
 updatePermFlds :: (MonadTx m, CacheRM m)
   => QualifiedTable -> RoleName -> PermType -> RenameField -> m ()
 updatePermFlds refQT rn pt rf = do
-  Q.AltJ pDef <- liftTx fetchPermDef
+  pDef <- fmap fst $ liftTx $ fetchPermDef refQT rn pt
   case pt of
     PTInsert -> do
       perm <- decodeValue pDef
@@ -183,18 +183,6 @@ updatePermFlds refQT rn pt rf = do
     PTDelete -> do
       perm <- decodeValue pDef
       updateDelPermFlds refQT rf rn perm
-  where
-    QualifiedObject sn tn = refQT
-    fetchPermDef =
-      runIdentity . Q.getRow <$>
-        Q.withQE defaultTxErrorHandler [Q.sql|
-                  SELECT perm_def::json
-                    FROM hdb_catalog.hdb_permission
-                   WHERE table_schema = $1
-                     AND table_name = $2
-                     AND role_name = $3
-                     AND perm_type = $4
-                 |] (sn, tn, rn, permTypeToCode pt) True
 
 updateInsPermFlds
   :: (MonadTx m, CacheRM m)

@@ -189,18 +189,36 @@ processTableChanges ti tableDiff = do
         if | oColName /= nColName -> do
                renameColInCatalog oColName nColName tn ti
                return True
+
            | oColTy /= nColTy -> do
                let colId   = SOTableObj tn $ TOCol oColName
-                   depObjs = getDependentObjsWith (== "on_type") sc colId
-               unless (null depObjs) $ throw400 DependencyError $
+                   typeDepObjs = getDependentObjsWith (== DROnType) sc colId
+
+               -- Raise exception if any objects found which are dependant on column type
+               unless (null typeDepObjs) $ throw400 DependencyError $
                  "cannot change type of column " <> oColName <<> " in table "
                  <> tn <<> " because of the following dependencies : " <>
-                 reportSchemaObjs depObjs
+                 reportSchemaObjs typeDepObjs
+
+               -- Update column type in cache
                updColInCache nColName npci tn
+
+               -- If any dependant permissions found with the column whose type
+               -- being altered is provided with a session variable,
+               -- then rebuild permission info and update the cache
+               let sessVarDepObjs =
+                     getDependentObjsWith (== DRSessionVariable) sc colId
+               forM_ sessVarDepObjs $ \objId ->
+                 case objId of
+                   SOTableObj qt (TOPerm rn pt) -> rebuildPermInfo qt rn pt
+                   _                            -> throw500
+                     "unexpected schema dependency found for altering column type"
                return False
+
            | oNullable /= nNullable -> do
                updColInCache nColName npci tn
                return False
+
            | otherwise -> return False
 
 delTableAndDirectDeps

@@ -1,6 +1,5 @@
 module Hasura.RQL.DML.Count
   ( CountQueryP1(..)
-  , getCountDeps
   , validateCountQWith
   , validateCountQ
   , runCount
@@ -30,16 +29,6 @@ data CountQueryP1
   , cqp1Distinct :: !(Maybe [PGCol])
   } deriving (Show, Eq)
 
-getCountDeps
-  :: CountQueryP1 -> [SchemaDependency]
-getCountDeps (CountQueryP1 tn (_, mWc) mDistCols) =
-  mkParentDep tn
-  : fromMaybe [] whereDeps
-  <> fromMaybe [] distDeps
-  where
-    distDeps   = map (mkColDep "untyped" tn) <$> mDistCols
-    whereDeps   = getBoolExpDeps tn <$> mWc
-
 mkSQLCount
   :: CountQueryP1 -> S.Select
 mkSQLCount (CountQueryP1 tn (permFltr, mWc) mDistCols) =

@@ -5,7 +5,6 @@ module Hasura.RQL.DML.Delete
   , traverseAnnDel
   , AnnDel
   , deleteQueryToTx
-  , getDeleteDeps
   , runDelete
   ) where
 
@@ -58,16 +57,6 @@ mkDeleteCTE (AnnDel tn (fltr, wc) _ _) =
     tableFltr = Just $ S.WhereFrag $
                 toSQLBoolExp (S.QualTable tn) $ andAnnBoolExps fltr wc
 
-getDeleteDeps
-  :: AnnDel -> [SchemaDependency]
-getDeleteDeps (AnnDel tn (_, wc) mutFlds allCols) =
-  mkParentDep tn : allColDeps <> whereDeps <> retDeps
-  where
-    whereDeps = getBoolExpDeps tn wc
-    allColDeps = map (mkColDep "on_type" tn . pgiName) allCols
-    retDeps   = map (mkColDep "untyped" tn . fst) $
-                pgColsFromMutFlds mutFlds
-
 validateDeleteQWith
   :: (UserInfoM m, QErrM m, CacheRM m)
   => SessVarBldr m

@@ -62,14 +62,6 @@ toSQLConflict conflict = case conflict of
       Column pgCols -> S.SQLColumn pgCols
       Constraint cn -> S.SQLConstraint cn
 
-getInsertDeps
-  :: InsertQueryP1 -> [SchemaDependency]
-getInsertDeps (InsertQueryP1 tn _ _ _ _ mutFlds _) =
-  mkParentDep tn : retDeps
-  where
-    retDeps = map (mkColDep "untyped" tn . fst) $
-              pgColsFromMutFlds mutFlds
-
 convObj
   :: (UserInfoM m, QErrM m)
   => (PGColType -> Value -> m S.SQLExp)