update constraint enum types when a new constraint is added (#1287)

* update metadata when constraints on a table are altered, fix #240

* capture only unique or primary constraints in tableinfo

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

@@ -169,11 +169,9 @@ isValidField = \case
     isRelEligible rn rt = isValidName (G.Name $ getRelTxt rn)
                           && isValidTableName rt
 
-upsertable :: [TableConstraint] -> Bool -> Bool -> Bool
-upsertable constraints isUpsertAllowed view =
+upsertable :: [ConstraintName] -> Bool -> Bool -> Bool
+upsertable uniqueOrPrimaryCons isUpsertAllowed view =
   not (null uniqueOrPrimaryCons) && isUpsertAllowed && not view
-  where
-    uniqueOrPrimaryCons = filter isUniqueOrPrimary constraints
 
 toValidFieldInfos :: FieldInfoMap -> [FieldInfo]
 toValidFieldInfos = filter isValidField . Map.elems
@@ -187,11 +185,9 @@ getValidCols = fst . validPartitionFieldInfoMap
 getValidRels :: FieldInfoMap -> [RelInfo]
 getValidRels = snd . validPartitionFieldInfoMap
 
-mkValidConstraints :: [TableConstraint] -> [TableConstraint]
-mkValidConstraints = filter isValid
-  where
-    isValid (TableConstraint _ n) =
-      isValidName $ G.Name $ getConstraintTxt n
+mkValidConstraints :: [ConstraintName] -> [ConstraintName]
+mkValidConstraints =
+  filter (isValidName . G.Name . getConstraintTxt)
 
 isRelNullable :: FieldInfoMap -> RelInfo -> Bool
 isRelNullable fim ri = isNullable
@@ -1056,11 +1052,11 @@ mkInsMutFld tn isUpsertable =
     onConflictArg =
       InpValInfo (Just onConflictDesc) "on_conflict" $ G.toGT $ mkOnConflictInpTy tn
 
-mkConstriantTy :: QualifiedTable -> [TableConstraint] -> EnumTyInfo
+mkConstriantTy :: QualifiedTable -> [ConstraintName] -> EnumTyInfo
 mkConstriantTy tn cons = enumTyInfo
   where
     enumTyInfo = mkHsraEnumTyInfo (Just desc) (mkConstraintInpTy tn) $
-                 mapFromL _eviVal $ map (mkConstraintEnumVal . tcName ) cons
+                 mapFromL _eviVal $ map mkConstraintEnumVal cons
 
     desc = G.Description $
       "unique or primary key constraints on table " <>> tn
@@ -1258,16 +1254,15 @@ mkOrdByInpObj tn selFlds = (inpObjTy, ordByCtx)
 --   mappend  = (<>)
 
 mkOnConflictTypes
-  :: QualifiedTable -> [TableConstraint] -> [PGCol] -> Bool -> [TypeInfo]
-mkOnConflictTypes tn c cols =
+  :: QualifiedTable -> [ConstraintName] -> [PGCol] -> Bool -> [TypeInfo]
+mkOnConflictTypes tn uniqueOrPrimaryCons cols =
   bool [] tyInfos
   where
     tyInfos = [ TIEnum $ mkConflictActionTy isUpdAllowed
-              , TIEnum $ mkConstriantTy tn constraints
+              , TIEnum $ mkConstriantTy tn uniqueOrPrimaryCons
               , TIEnum $ mkUpdColumnTy tn cols
               , TIInpObj $ mkOnConflictInp tn
               ]
-    constraints = filter isUniqueOrPrimary c
     isUpdAllowed = not $ null cols
 
 mkGCtxRole'
@@ -1283,7 +1278,7 @@ mkGCtxRole'
   -- primary key columns
   -> [PGColInfo]
   -- constraints
-  -> [TableConstraint]
+  -> [ConstraintName]
   -> Maybe ViewInfo
   -> TyAgg
 mkGCtxRole' tn insPermM selPermM updColsM delPermM pkeyCols constraints viM =
@@ -1433,7 +1428,7 @@ mkGCtxRole' tn insPermM selPermM updColsM delPermM pkeyCols constraints viM =
 getRootFldsRole'
   :: QualifiedTable
   -> [PGCol]
-  -> [TableConstraint]
+  -> [ConstraintName]
   -> FieldInfoMap
   -> Maybe ([T.Text], Bool) -- insert perm
   -> Maybe (AnnBoolExpSQL, Maybe Int, [T.Text], Bool) -- select filter
@@ -1576,7 +1571,7 @@ mkGCtxRole
   -> QualifiedTable
   -> FieldInfoMap
   -> [PGCol]
-  -> [TableConstraint]
+  -> [ConstraintName]
   -> Maybe ViewInfo
   -> RoleName
   -> RolePermInfo
@@ -1601,7 +1596,7 @@ mkGCtxRole tableCache tn fields pCols constraints viM role permInfo = do
 getRootFldsRole
   :: QualifiedTable
   -> [PGCol]
-  -> [TableConstraint]
+  -> [ConstraintName]
   -> FieldInfoMap
   -> Maybe ViewInfo
   -> RolePermInfo
@@ -1671,7 +1666,7 @@ checkSchemaConflicts gCtx remoteCtx = do
                     (\k _ -> G.unNamedType k `notElem` builtinTy ++ rmRootNames)
                     $ _gTypes remoteCtx
 
-      isTyInfoSame ty = any (\t -> tyinfoEq t ty) hTypes
+      isTyInfoSame ty = any (`tyinfoEq` ty) hTypes
       -- name is same and structure is not same
       isSame n ty = G.unNamedType n `elem` hTyNames &&
                     not (isTyInfoSame ty)

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

@@ -37,8 +37,9 @@ $(deriveJSON (aesonDrop 3 snakeCase){omitNothingFields=True} ''PGColMeta)
 
 data ConstraintMeta
   = ConstraintMeta
-  { cmConstraintName :: !ConstraintName
-  , cmConstraintOid  :: !Int
+  { cmName :: !ConstraintName
+  , cmOid  :: !Int
+  , cmType :: !ConstraintType
   } deriving (Show, Eq)
 
 $(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''ConstraintMeta)
@@ -84,11 +85,19 @@ fetchTableMeta = do
         ON (t.table_schema = c.table_schema AND t.table_name = c.table_name)
         LEFT OUTER JOIN
         (SELECT
-             table_schema,
-             table_name,
-             json_agg((SELECT r FROM (SELECT constraint_name, constraint_oid) r)) as constraints
+             tc.table_schema,
+             tc.table_name,
+             json_agg(
+              json_build_object(
+                  'name', tc.constraint_name,
+                  'oid', r.oid::integer,
+                  'type', tc.constraint_type
+                  )
+             ) as constraints
          FROM
-             hdb_catalog.hdb_foreign_key_constraint
+             information_schema.table_constraints tc
+             JOIN pg_catalog.pg_constraint r
+             ON tc.constraint_name = r.conname
          GROUP BY
              table_schema, table_name) f
         ON (t.table_schema = f.table_schema AND t.table_name = f.table_name)
@@ -114,21 +123,29 @@ getDifference getKey left right =
 
 data TableDiff
   = TableDiff
-  { _tdNewName     :: !(Maybe QualifiedTable)
-  , _tdDroppedCols :: ![PGCol]
-  , _tdAddedCols   :: ![PGColInfo]
-  , _tdAlteredCols :: ![(PGColInfo, PGColInfo)]
-  , _tdDroppedCons :: ![ConstraintName]
+  { _tdNewName         :: !(Maybe QualifiedTable)
+  , _tdDroppedCols     :: ![PGCol]
+  , _tdAddedCols       :: ![PGColInfo]
+  , _tdAlteredCols     :: ![(PGColInfo, PGColInfo)]
+  , _tdDroppedFKeyCons :: ![ConstraintName]
+  -- The final list of uniq/primary constraint names
+  -- used for generating types on_conflict clauses
+  -- TODO: this ideally should't be part of TableDiff
+  , _tdUniqOrPriCons   :: ![ConstraintName]
   } deriving (Show, Eq)
 
 getTableDiff :: TableMeta -> TableMeta -> TableDiff
 getTableDiff oldtm newtm =
-  TableDiff mNewName droppedCols addedCols alteredCols droppedConstraints
+  TableDiff mNewName droppedCols addedCols alteredCols
+  droppedFKeyConstraints uniqueOrPrimaryCons
   where
     mNewName = bool (Just $ tmTable newtm) Nothing $ tmTable oldtm == tmTable newtm
     oldCols = tmColumns oldtm
     newCols = tmColumns newtm
 
+    uniqueOrPrimaryCons =
+      [cmName cm | cm <- tmConstraints newtm, isUniqueOrPrimary $ cmType cm]
+
     droppedCols =
       map pcmColumnName $ getDifference pcmOrdinalPosition oldCols newCols
 
@@ -144,8 +161,8 @@ getTableDiff oldtm newtm =
       flip map (filter (uncurry (/=)) existingCols) $ \(pcmo, pcmn) ->
       (pcmToPci pcmo, pcmToPci pcmn)
 
-    droppedConstraints =
-      map cmConstraintName $ getDifference cmConstraintOid
+    droppedFKeyConstraints = map cmName $
+      filter (isForeignKey . cmType) $ getDifference cmOid
       (tmConstraints oldtm) (tmConstraints newtm)
 
 getTableChangeDeps
@@ -158,13 +175,13 @@ getTableChangeDeps ti tableDiff = do
     let objId = SOTableObj tn $ TOCol droppedCol
     return $ getDependentObjs sc objId
   -- for all dropped constraints
-  droppedConsDeps <- fmap concat $ forM droppedConstraints $ \droppedCons -> do
+  droppedConsDeps <- fmap concat $ forM droppedFKeyConstraints $ \droppedCons -> do
     let objId = SOTableObj tn $ TOCons droppedCons
     return $ getDependentObjs sc objId
   return $ droppedConsDeps <> droppedColDeps
   where
     tn = tiName ti
-    TableDiff _ droppedCols _ _ droppedConstraints = tableDiff
+    TableDiff _ droppedCols _ _ droppedFKeyConstraints _ = tableDiff
 
 data SchemaDiff
   = SchemaDiff

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

@@ -135,6 +135,9 @@ processTableChanges ti tableDiff = do
   when (isJust mNewName) $
     throw400 NotSupported $ "table renames are not yet supported : " <>> tn
 
+  -- replace constraints
+  replaceConstraints
+
   -- for all the dropped columns
   forM_ droppedCols $ \droppedCol ->
     -- Drop the column from the cache
@@ -168,8 +171,10 @@ processTableChanges ti tableDiff = do
     updateFldInCache cn ci = do
       delColFromCache cn tn
       addColToCache cn ci tn
+    replaceConstraints = flip modTableInCache tn $ \tInfo ->
+      return $ tInfo {tiUniqOrPrimConstraints = constraints}
     tn = tiName ti
-    TableDiff mNewName droppedCols addedCols alteredCols _ = tableDiff
+    TableDiff mNewName droppedCols addedCols alteredCols _ constraints = tableDiff
 
 delTableAndDirectDeps
   :: (QErrM m, CacheRWM m, MonadTx m) => QualifiedTable -> m ()

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

@@ -145,7 +145,7 @@ buildConflictClause tableInfo inpCols (OnConflict mTCol mTCons act) =
         \pgCol -> askPGType fieldInfoMap pgCol ""
 
     validateConstraint c = do
-      let tableConsNames = map tcName $ tiConstraints tableInfo
+      let tableConsNames = tiUniqOrPrimConstraints tableInfo
       withPathK "constraint" $
        unless (c `elem` tableConsNames) $
        throw400 Unexpected $ "constraint " <> getConstraintTxt c

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

@@ -16,6 +16,7 @@ module Hasura.RQL.Types.SchemaCache
        , onlyJSONBCols
        , onlyComparableCols
        , isUniqueOrPrimary
+       , isForeignKey
        , mkTableInfo
        , addTableToCache
        , modTableInCache
@@ -259,8 +260,6 @@ data ConstraintType
   | CTUNIQUE
   deriving Eq
 
-$(deriveToJSON defaultOptions{constructorTagModifier = drop 2} ''ConstraintType)
-
 constraintTyToTxt :: ConstraintType -> T.Text
 constraintTyToTxt ty = case ty of
   CTCHECK      -> "CHECK"
@@ -279,6 +278,20 @@ instance FromJSON ConstraintType where
     "UNIQUE"      -> return CTUNIQUE
     c             -> fail $ "unexpected ConstraintType: " <> T.unpack c
 
+instance ToJSON ConstraintType where
+  toJSON = String . constraintTyToTxt
+
+isUniqueOrPrimary :: ConstraintType -> Bool
+isUniqueOrPrimary = \case
+  CTPRIMARYKEY -> True
+  CTUNIQUE     -> True
+  _            -> False
+
+isForeignKey :: ConstraintType -> Bool
+isForeignKey = \case
+  CTFOREIGNKEY -> True
+  _            -> False
+
 data TableConstraint
   = TableConstraint
   { tcType :: !ConstraintType
@@ -287,13 +300,6 @@ data TableConstraint
 
 $(deriveJSON (aesonDrop 2 snakeCase) ''TableConstraint)
 
-isUniqueOrPrimary :: TableConstraint -> Bool
-isUniqueOrPrimary (TableConstraint ty _) = case ty of
-  CTCHECK      -> False
-  CTFOREIGNKEY -> False
-  CTPRIMARYKEY -> True
-  CTUNIQUE     -> True
-
 data ViewInfo
   = ViewInfo
   { viIsUpdatable  :: !Bool
@@ -316,14 +322,14 @@ mutableView qt f mVI operation =
 
 data TableInfo
   = TableInfo
-  { tiName                :: !QualifiedTable
-  , tiSystemDefined       :: !Bool
-  , tiFieldInfoMap        :: !FieldInfoMap
-  , tiRolePermInfoMap     :: !RolePermInfoMap
-  , tiConstraints         :: ![TableConstraint]
-  , tiPrimaryKeyCols      :: ![PGCol]
-  , tiViewInfo            :: !(Maybe ViewInfo)
-  , tiEventTriggerInfoMap :: !EventTriggerInfoMap
+  { tiName                  :: !QualifiedTable
+  , tiSystemDefined         :: !Bool
+  , tiFieldInfoMap          :: !FieldInfoMap
+  , tiRolePermInfoMap       :: !RolePermInfoMap
+  , tiUniqOrPrimConstraints :: ![ConstraintName]
+  , tiPrimaryKeyCols        :: ![PGCol]
+  , tiViewInfo              :: !(Maybe ViewInfo)
+  , tiEventTriggerInfoMap   :: !EventTriggerInfoMap
   } deriving (Show, Eq)
 
 $(deriveToJSON (aesonDrop 2 snakeCase) ''TableInfo)
@@ -331,13 +337,13 @@ $(deriveToJSON (aesonDrop 2 snakeCase) ''TableInfo)
 mkTableInfo
   :: QualifiedTable
   -> Bool
-  -> [TableConstraint]
+  -> [ConstraintName]
   -> [PGColInfo]
   -> [PGCol]
   -> Maybe ViewInfo -> TableInfo
-mkTableInfo tn isSystemDefined constraints cols pcols mVI =
+mkTableInfo tn isSystemDefined uniqCons cols pcols mVI =
   TableInfo tn isSystemDefined colMap (M.fromList [])
-  constraints pcols mVI (M.fromList [])
+  uniqCons pcols mVI (M.fromList [])
   where
     colMap     = M.fromList $ map f cols
     f colInfo = (fromPGCol $ pgiName colInfo, FIColumn colInfo)

server/src-rsr/table_info.sql

@@ -38,16 +38,12 @@ from
     select
       c.table_schema,
       c.table_name,
-      json_agg(
-        json_build_object(
-          'name',
-          constraint_name,
-          'type',
-          constraint_type
-        )
-      ) as constraints
+      json_agg(constraint_name) as constraints
     from
       information_schema.table_constraints c
+    where
+      c.constraint_type = 'UNIQUE'
+      or c.constraint_type = 'PRIMARY KEY'
     group by
       c.table_schema,
       c.table_name