generate mutation types for views only if they are updatable, fix has…

…ura#232

server/src-lib/Hasura/GraphQL/Schema.hs

@@ -831,8 +831,9 @@ mkGCtxRole'
   -> [PGColInfo]
   -- constraints
   -> [TableConstraint]
+  -> Maybe ViewInfo
   -> TyAgg
-mkGCtxRole' tn insColsM selFldsM updColsM delPermM pkeyCols constraints =
+mkGCtxRole' tn insColsM selFldsM updColsM delPermM pkeyCols constraints viM =
   TyAgg (mkTyInfoMap allTypes) fieldMap ordByEnums
 
   where
@@ -841,16 +842,23 @@ mkGCtxRole' tn insColsM selFldsM updColsM delPermM pkeyCols constraints =
     onConflictTypes = mkOnConflictTypes tn constraints
     jsonOpTys = fromMaybe [] updJSONOpInpObjTysM
 
-    allTypes = onConflictTypes <> jsonOpTys <> catMaybes
-      [ TIInpObj <$> insInpObjM
-      , TIInpObj <$> updSetInpObjM
-      , TIInpObj <$> updIncInpObjM
-      , TIInpObj <$> boolExpInpObjM
-      , TIObj <$> mutRespObjM
+    allTypes = onConflictTypes <> jsonOpTys
+               <> queryTypes <> mutationTypes
+
+    queryTypes = catMaybes
+      [ TIInpObj <$> boolExpInpObjM
       , TIObj <$> selObjM
       , TIEnum <$> ordByTyInfoM
       ]
 
+    mutationTypes = catMaybes
+      [ TIInpObj <$> mutHelper viIsInsertable insInpObjM
+      , TIInpObj <$> mutHelper viIsUpdatable updSetInpObjM
+      , TIInpObj <$> mutHelper viIsUpdatable updIncInpObjM
+      , TIObj <$> mutRespObjM
+      ]
+    mutHelper f objM = bool Nothing objM $ isMutable f viM
+
     fieldMap = Map.unions $ catMaybes
                [ insInpObjFldsM, updSetInpObjFldsM, boolExpInpObjFldsM
                , selObjFldsM, Just selByPKeyObjFlds
@@ -895,10 +903,13 @@ mkGCtxRole' tn insColsM selFldsM updColsM delPermM pkeyCols constraints =
 
     -- mut resp obj
     mutRespObjM =
-      if isJust insColsM || isJust updColsM || isJust delPermM
+      if isMut
       then Just $ mkMutRespObj tn
       else Nothing
 
+    isMut = (isJust insColsM || isJust updColsM || isJust delPermM)
+            && any (`isMutable` viM) [viIsInsertable, viIsUpdatable, viIsDeletable]
+
     -- table obj
     selObjM = mkTableObj tn <$> selFldsM
     -- the fields used in table object
@@ -922,15 +933,20 @@ getRootFldsRole'
   -> Maybe (S.BoolExp, Maybe Int, [T.Text]) -- select filter
   -> Maybe ([PGCol], S.BoolExp, [T.Text]) -- update filter
   -> Maybe (S.BoolExp, [T.Text]) -- delete filter
+  -> Maybe ViewInfo
   -> RootFlds
-getRootFldsRole' tn primCols constraints fields insM selM updM delM =
+getRootFldsRole' tn primCols constraints fields insM selM updM delM viM =
   RootFlds mFlds
   where
     mFlds = mapFromL (either _fiName _fiName . snd) $ catMaybes
-            [ getInsDet <$> insM, getSelDet <$> selM
-            , getUpdDet <$> updM, getDelDet <$> delM
+            [ mutHelper viIsInsertable getInsDet insM
+            , mutHelper viIsUpdatable getUpdDet updM
+            , mutHelper viIsDeletable getDelDet delM
+            , getSelDet <$> selM
             , getPKeySelDet selM $ getColInfos primCols colInfos
             ]
+    mutHelper f getDet mutM =
+      bool Nothing (getDet <$> mutM) $ isMutable f viM
     colInfos = fst $ validPartitionFieldInfoMap fields
     getInsDet (vn, hdrs) =
       (OCInsert tn vn (map pgiName colInfos) hdrs, Right $ mkInsMutFld tn constraints)
@@ -994,16 +1010,17 @@ mkGCtxRole
   -> FieldInfoMap
   -> [PGCol]
   -> [TableConstraint]
+  -> Maybe ViewInfo
   -> RoleName
   -> RolePermInfo
   -> m (TyAgg, RootFlds)
-mkGCtxRole tableCache tn fields pCols constraints role permInfo = do
+mkGCtxRole tableCache tn fields pCols constraints viM role permInfo = do
   selFldsM <- mapM (getSelFlds tableCache fields role) $ _permSel permInfo
   let insColsM = const colInfos <$> _permIns permInfo
       updColsM = filterColInfos . upiCols <$> _permUpd permInfo
       tyAgg = mkGCtxRole' tn insColsM selFldsM updColsM
-              (void $ _permDel permInfo) pColInfos constraints
-      rootFlds = getRootFldsRole tn pCols constraints fields permInfo
+              (void $ _permDel permInfo) pColInfos constraints viM
+      rootFlds = getRootFldsRole tn pCols constraints fields viM permInfo
   return (tyAgg, rootFlds)
   where
     colInfos = fst $ validPartitionFieldInfoMap fields
@@ -1016,12 +1033,14 @@ getRootFldsRole
   -> [PGCol]
   -> [TableConstraint]
   -> FieldInfoMap
+  -> Maybe ViewInfo
   -> RolePermInfo
   -> RootFlds
-getRootFldsRole tn pCols constraints fields (RolePermInfo insM selM updM delM) =
+getRootFldsRole tn pCols constraints fields viM (RolePermInfo insM selM updM delM) =
   getRootFldsRole' tn pCols constraints fields
   (mkIns <$> insM) (mkSel <$> selM)
   (mkUpd <$> updM) (mkDel <$> delM)
+  viM
   where
     mkIns i = (ipiView i, ipiRequiredHeaders i)
     mkSel s = (spiFilter s, spiLimit s, spiRequiredHeaders s)
@@ -1036,12 +1055,12 @@ mkGCtxMapTable
   => TableCache
   -> TableInfo
   -> m (Map.HashMap RoleName (TyAgg, RootFlds))
-mkGCtxMapTable tableCache (TableInfo tn _ fields rolePerms constraints pkeyCols) = do
+mkGCtxMapTable tableCache (TableInfo tn _ fields rolePerms constraints pkeyCols viewInfo) = do
   m <- Map.traverseWithKey
-    (mkGCtxRole tableCache tn fields pkeyCols validConstraints) rolePerms
+    (mkGCtxRole tableCache tn fields pkeyCols validConstraints viewInfo) rolePerms
   let adminCtx = mkGCtxRole' tn (Just colInfos)
                  (Just selFlds) (Just colInfos) (Just ())
-                 pkeyColInfos validConstraints
+                 pkeyColInfos validConstraints viewInfo
   return $ Map.insert adminRole (adminCtx, adminRootFlds) m
   where
     validConstraints = mkValidConstraints constraints
@@ -1056,6 +1075,7 @@ mkGCtxMapTable tableCache (TableInfo tn _ fields rolePerms constraints pkeyCols)
       getRootFldsRole' tn pkeyCols constraints fields
       (Just (tn, [])) (Just (noFilter, Nothing, []))
       (Just (allCols, noFilter, [])) (Just (noFilter, []))
+      viewInfo
 
 mkScalarTyInfo :: PGColType -> ScalarTyInfo
 mkScalarTyInfo = ScalarTyInfo Nothing

server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs

@@ -290,6 +290,19 @@ class (ToJSON a) => IsPerm a where
     :: DropPerm a -> PermAccessor (PermInfo a)
   getPermAcc2 _ = permAccessor
 
+validateViewPerm
+  :: (IsPerm a, QErrM m) => PermDef a -> TableInfo -> m ()
+validateViewPerm permDef tableInfo =
+  case permAcc of
+    PASelect -> return ()
+    PAInsert -> mutableView tn viIsInsertable viewInfo "insertable"
+    PAUpdate -> mutableView tn viIsUpdatable viewInfo "updatable"
+    PADelete -> mutableView tn viIsDeletable viewInfo "deletable"
+  where
+    tn = tiName tableInfo
+    viewInfo = tiViewInfo tableInfo
+    permAcc = getPermAcc1 permDef
+
 addPermP1 :: (QErrM m, CacheRM m, IsPerm a) => TableInfo -> PermDef a -> m (PermInfo a)
 addPermP1 tabInfo pd = do
   assertPermNotDefined (pdRole pd) (getPermAcc1 pd) tabInfo
@@ -311,6 +324,7 @@ instance (IsPerm a) => HDBQuery (CreatePerm a) where
 
   phaseOne (WithTable tn pd) = do
     tabInfo <- createPermP1 tn
+    validateViewPerm pd tabInfo
     addPermP1 tabInfo pd
 
   phaseTwo (WithTable tn pd) permInfo = do

server/src-lib/Hasura/RQL/DDL/Schema/Table.hs

@@ -47,6 +47,35 @@ saveTableToCatalog (QualifiedTable sn tn) =
             INSERT INTO "hdb_catalog"."hdb_table" VALUES ($1, $2)
                 |] (sn, tn) False
 
+getViewInfo :: QualifiedTable -> Q.TxE QErr (Maybe ViewInfo)
+getViewInfo (QualifiedTable sn tn) = do
+  tableTy <- runIdentity . Q.getRow <$> Q.withQE defaultTxErrorHandler
+             [Q.sql|
+              SELECT table_type FROM information_schema.tables
+              WHERE table_schema = $1
+                AND table_name = $2
+                   |] (sn, tn) False
+
+  bool (return Nothing) buildViewInfo $ isView tableTy
+  where
+    buildViewInfo = do
+      (is_upd, is_ins, is_trig_upd, is_trig_del, is_trig_ins)
+        <- Q.getRow <$> Q.withQE defaultTxErrorHandler
+             [Q.sql|
+              SELECT is_updatable :: boolean,
+                     is_insertable_into::boolean,
+                     is_trigger_updatable::boolean,
+                     is_trigger_deletable::boolean,
+                     is_trigger_insertable_into::boolean
+               FROM information_schema.views
+              WHERE table_schema = $1
+                AND table_name = $2
+                    |] (sn, tn) False
+      return $ Just $ ViewInfo
+               (is_upd || is_trig_upd)
+               (is_upd || is_trig_del)
+               (is_ins || is_trig_ins)
+
 -- Build the TableInfo with all its columns
 getTableInfo :: QualifiedTable -> Bool -> Q.TxE QErr TableInfo
 getTableInfo qt@(QualifiedTable sn tn) isSystemDefined = do
@@ -60,6 +89,9 @@ getTableInfo qt@(QualifiedTable sn tn) isSystemDefined = do
   unless (tableExists == [Identity True]) $
     throw400 NotExists $ "no such table/view exists in postgres : " <>> qt
 
+  -- Fetch View information
+  viewInfo <- getViewInfo qt
+
   -- Fetch the column details
   colData <- Q.catchE defaultTxErrorHandler $ Q.listQ [Q.sql|
             SELECT column_name, to_json(udt_name), is_nullable::boolean
@@ -86,7 +118,7 @@ getTableInfo qt@(QualifiedTable sn tn) isSystemDefined = do
                            |] (sn, tn) False
   let colDetails = flip map colData $ \(colName, Q.AltJ colTy, isNull)
                    -> (colName, colTy, isNull)
-  return $ mkTableInfo qt isSystemDefined rawConstraints colDetails pkeyCols
+  return $ mkTableInfo qt isSystemDefined rawConstraints colDetails pkeyCols viewInfo
   where
     mkPKeyCols [] = return []
     mkPKeyCols [Identity (Q.AltJ pkeyCols)] = return pkeyCols

server/src-lib/Hasura/RQL/DML/Delete.hs

@@ -52,6 +52,10 @@ convDeleteQuery
 convDeleteQuery prepValBuilder (DeleteQuery tableName rqlBE mRetCols) = do
   tableInfo <- askTabInfo tableName
 
+  -- If table is view then check if it deletable
+  mutableView tableName viIsDeletable
+    (tiViewInfo tableInfo) "deletable"
+
   -- Check if the role has delete permissions
   delPerm <- askDelPermInfo tableInfo
 

server/src-lib/Hasura/RQL/DML/Insert.hs

@@ -144,6 +144,10 @@ convInsertQuery objsParser prepFn (InsertQuery tableName val oC mRetCols) = do
   -- Get the current table information
   tableInfo <- askTabInfo tableName
 
+  -- If table is view then check if it is insertable
+  mutableView tableName viIsInsertable
+    (tiViewInfo tableInfo) "insertable"
+
   -- Check if the role has insert permissions
   insPerm   <- askInsPermInfo tableInfo
 

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

@@ -113,6 +113,10 @@ convUpdateQuery f uq = do
   let tableName = uqTable uq
   tableInfo <- withPathK "table" $ askTabInfo tableName
 
+  -- If it is view then check if it is updatable
+  mutableView tableName viIsUpdatable
+    (tiViewInfo tableInfo) "updatable"
+
   -- Check if the role has update permissions
   updPerm <- askUpdPermInfo tableInfo
 

server/src-lib/Hasura/RQL/Types/SchemaCache.hs

@@ -14,6 +14,9 @@ module Hasura.RQL.Types.SchemaCache
        , TableInfo(..)
        , TableConstraint(..)
        , ConstraintType(..)
+       , ViewInfo(..)
+       , isMutable
+       , mutableView
        , onlyIntCols
        , onlyJSONBCols
        , isUniqueOrPrimary
@@ -365,6 +368,26 @@ isUniqueOrPrimary (TableConstraint ty _) = case ty of
   CTPRIMARYKEY -> True
   CTUNIQUE     -> True
 
+data ViewInfo
+  = ViewInfo
+  { viIsUpdatable  :: !Bool
+  , viIsDeletable  :: !Bool
+  , viIsInsertable :: !Bool
+  } deriving (Show, Eq)
+
+$(deriveToJSON (aesonDrop 2 snakeCase) ''ViewInfo)
+
+isMutable :: (ViewInfo -> Bool) -> Maybe ViewInfo -> Bool
+isMutable _ Nothing = True
+isMutable f (Just vi) = f vi
+
+mutableView :: (MonadError QErr m) => QualifiedTable
+            -> (ViewInfo -> Bool) -> Maybe ViewInfo
+            -> T.Text -> m ()
+mutableView qt f mVI operation =
+  unless (isMutable f mVI) $ throw400 NotSupported $
+  "view " <> qt <<> " is not " <> operation
+
 data TableInfo
   = TableInfo
   { tiName            :: !QualifiedTable
@@ -373,12 +396,14 @@ data TableInfo
   , tiRolePermInfoMap :: !RolePermInfoMap
   , tiConstraints     :: ![TableConstraint]
   , tiPrimaryKeyCols  :: ![PGCol]
+  , tiViewInfo        :: !(Maybe ViewInfo)
   } deriving (Show, Eq)
 
 $(deriveToJSON (aesonDrop 2 snakeCase) ''TableInfo)
 
 mkTableInfo :: QualifiedTable -> Bool -> [(ConstraintType, ConstraintName)]
-            -> [(PGCol, PGColType, Bool)] -> [PGCol] -> TableInfo
+            -> [(PGCol, PGColType, Bool)] -> [PGCol]
+            -> Maybe ViewInfo -> TableInfo
 mkTableInfo tn isSystemDefined rawCons cols =
   TableInfo tn isSystemDefined colMap (M.fromList []) constraints
   where
@@ -515,6 +540,7 @@ delFldFromCache fn =
         Just _  -> return $
           ti { tiFieldInfoMap = M.delete fn fim }
         Nothing -> throw500 "field does not exist"
+
 data PermAccessor a where
   PAInsert :: PermAccessor InsPermInfo
   PASelect :: PermAccessor SelPermInfo
@@ -636,13 +662,13 @@ getDependentObjsOfTableWith f objId ti =
 
 getDependentRelsOfTable :: (T.Text -> Bool) -> SchemaObjId
                         -> TableInfo -> [SchemaObjId]
-getDependentRelsOfTable rsnFn objId (TableInfo tn _ fim _ _ _) =
+getDependentRelsOfTable rsnFn objId (TableInfo tn _ fim _ _ _ _) =
     map (SOTableObj tn . TORel . riName) $
     filter (isDependentOn rsnFn objId) $ getRels fim
 
 getDependentPermsOfTable :: (T.Text -> Bool) -> SchemaObjId
                          -> TableInfo -> [SchemaObjId]
-getDependentPermsOfTable rsnFn objId (TableInfo tn _ _ rpim _ _) =
+getDependentPermsOfTable rsnFn objId (TableInfo tn _ _ rpim _ _ _) =
   concat $ flip M.mapWithKey rpim $
   \rn rpi -> map (SOTableObj tn . TOPerm rn) $ getDependentPerms' rsnFn objId rpi
 

server/src-lib/Hasura/SQL/Types.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DeriveLift                 #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase                 #-}
 {-# LANGUAGE OverloadedStrings          #-}
 
 module Hasura.SQL.Types where
@@ -19,6 +20,7 @@ import qualified Data.ByteString.Builder    as BB
 import qualified Data.Text.Encoding         as TE
 import qualified Data.Text.Extended         as T
 import qualified Database.PostgreSQL.LibPQ  as PQ
+import qualified PostgreSQL.Binary.Decoding as PD
 
 class ToSQL a where
   toSQL :: a -> BB.Builder
@@ -100,6 +102,34 @@ instance DQuote TableName where
 instance ToSQL TableName where
   toSQL = toSQL . toIden
 
+data TableType
+  = TTBaseTable
+  | TTView
+  | TTForeignTable
+  | TTLocalTemporary
+  deriving (Eq)
+
+tableTyToTxt :: TableType -> T.Text
+tableTyToTxt TTBaseTable      = "BASE TABLE"
+tableTyToTxt TTView           = "VIEW"
+tableTyToTxt TTForeignTable   = "FOREIGN TABLE"
+tableTyToTxt TTLocalTemporary = "LOCAL TEMPORARY"
+
+instance Show TableType where
+  show = T.unpack . tableTyToTxt
+
+instance Q.FromCol TableType where
+  fromCol bs = flip Q.fromColHelper bs $ PD.enum $ \case
+    "BASE TABLE"      -> Just TTBaseTable
+    "VIEW"            -> Just TTView
+    "FOREIGN TABLE"   -> Just TTForeignTable
+    "LOCAL TEMPORARY" -> Just TTLocalTemporary
+    _                 -> Nothing
+
+isView :: TableType -> Bool
+isView TTView = True
+isView _      = False
+
 newtype ConstraintName
   = ConstraintName { getConstraintTxt :: T.Text }
   deriving (Show, Eq, FromJSON, ToJSON, Q.ToPrepArg, Q.FromCol, Hashable, Lift)