Make on_conflict schema available abstract of update permissions

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4390
GitOrigin-RevId: 5f3f9da173cad37f9330c5a27fd1edfc2559a4d6

CHANGELOG.md

@@ -101,6 +101,7 @@ is `graphql-default`, the field names generated will be `my_table`, `my_tableByP
 - server: bugfix: insertion of multiple empty objects should result in multiple entries (#8475)
 - console: add support for application/x-www-form-urlencoded in rest connectors (#8097)
 - cli: add support for multiple admin secrets
+- server: restore the ability to do no-op upserts (#8260).
 
 ## v2.7.0
 

server/graphql-engine.cabal

@@ -1123,6 +1123,7 @@ test-suite tests-hspec
     Harness.Test.BackendType
     Harness.Test.Context
     Harness.Test.Schema
+    Harness.Test.Permissions
 
  -- Harness.Quoter
     Harness.Quoter.Graphql
@@ -1135,13 +1136,14 @@ test-suite tests-hspec
     Test.BackendOnlyPermissionsSpec
     Test.ColumnPresetsSpec
     Test.CustomFieldNamesSpec
-    Test.DirectivesSpec
     Test.DC.QuerySpec
+    Test.DirectivesSpec
     Test.EventTriggersRunSQLSpec
     Test.HelloWorldSpec
     Test.InsertCheckPermissionSpec
     Test.InsertDefaultsSpec
     Test.InsertEnumColumnSpec
+    Test.InsertOnConflictSpec
     Test.LimitOffsetSpec
     Test.NestedRelationshipsSpec
     Test.ObjectRelationshipsLimitSpec

server/src-lib/Hasura/Backends/MSSQL/Meta.hs

@@ -159,15 +159,15 @@ transformTable tableInfo =
 transformColumn ::
   SysColumn ->
   (RawColumnInfo 'MSSQL, [ForeignKey 'MSSQL])
-transformColumn columnInfo =
-  let rciName = ColumnName $ scName columnInfo
-      rciPosition = scColumnId columnInfo
+transformColumn sysCol =
+  let rciName = ColumnName $ scName sysCol
+      rciPosition = scColumnId sysCol
 
-      rciIsNullable = scIsNullable columnInfo
+      rciIsNullable = scIsNullable sysCol
       rciDescription = Nothing
-      rciType = parseScalarType $ styName $ scJoinedSysType columnInfo
+      rciType = parseScalarType $ styName $ scJoinedSysType sysCol
       foreignKeys =
-        scJoinedForeignKeyColumns columnInfo <&> \foreignKeyColumn ->
+        scJoinedForeignKeyColumns sysCol <&> \foreignKeyColumn ->
           let _fkConstraint = Constraint "fk_mssql" $ OID $ sfkcConstraintObjectId foreignKeyColumn
 
               schemaName = SchemaName $ ssName $ sfkcJoinedReferencedSysSchema foreignKeyColumn
@@ -175,7 +175,7 @@ transformColumn columnInfo =
               _fkColumnMapping = NEHashMap.singleton rciName $ ColumnName $ sfkcJoinedReferencedColumnName foreignKeyColumn
            in ForeignKey {..}
 
-      colIsImmutable = scIsComputed columnInfo || scIsIdentity columnInfo
+      colIsImmutable = scIsComputed sysCol || scIsIdentity sysCol
       rciMutability = ColumnMutability {_cmIsInsertable = not colIsImmutable, _cmIsUpdatable = not colIsImmutable}
    in (RawColumnInfo {..}, foreignKeys)
 

server/src-lib/Hasura/Backends/MySQL/Meta.hs

@@ -68,9 +68,13 @@ mergeMetadata InformationSchema {..} =
           if isColumnKey == UNI
             then
               HS.singleton
-                ( Constraint
-                    (ConstraintName $ fromMaybe "" isConstraintName)
-                    (OID $ fromIntegral $ fromMaybe 0 isConstraintOrdinalPosition)
+                ( UniqueConstraint
+                    { _ucConstraint =
+                        Constraint
+                          (ConstraintName $ fromMaybe "" isConstraintName)
+                          (OID $ fromIntegral $ fromMaybe 0 isConstraintOrdinalPosition),
+                      _ucColumns = HS.singleton (Column isColumnName)
+                    }
                 )
             else HS.empty,
         _ptmiForeignKeys =

server/src-lib/Hasura/Backends/Postgres/Schema/OnConflict.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE TemplateHaskellQuotes #-}
 
 -- | Postgres Schema OnConflict
@@ -13,7 +14,10 @@ module Hasura.Backends.Postgres.Schema.OnConflict
 where
 
 import Data.Has (getter)
+import Data.HashMap.Strict qualified as HM
+import Data.HashSet qualified as HS
 import Data.Text.Extended
+import Hasura.Backends.Postgres.SQL.Types (showPGCols)
 import Hasura.GraphQL.Parser
   ( InputFieldsParser,
     Kind (..),
@@ -30,7 +34,6 @@ import Hasura.Prelude
 import Hasura.RQL.IR.BoolExp qualified as IR
 import Hasura.RQL.IR.Insert qualified as IR
 import Hasura.RQL.IR.Value qualified as IR
-import Hasura.RQL.Types.Backend
 import Hasura.RQL.Types.SchemaCache
 import Hasura.RQL.Types.Source
 import Hasura.RQL.Types.SourceCustomization (applyFieldNameCaseCust)
@@ -47,8 +50,8 @@ import Language.GraphQL.Draft.Syntax qualified as G
 -- unique or primary keys constraints.
 --
 -- If there are no columns for which the current role has update permissions, we
--- must still accept an empty list for @update_columns@ in the name of
--- backwards compatibility. We do this by adding a placeholder value to the
+-- must still accept an empty list for @update_columns@ to support the "ON
+-- CONFLICT DO NOTHING" case. We do this by adding a placeholder value to the
 -- enum. See <https://github.com/hasura/graphql-engine/issues/6804>.
 onConflictFieldParser ::
   forall pgKind r m n.
@@ -58,9 +61,9 @@ onConflictFieldParser ::
   m (InputFieldsParser n (Maybe (IR.OnConflictClause ('Postgres pgKind) (IR.UnpreparedValue ('Postgres pgKind)))))
 onConflictFieldParser sourceInfo tableInfo = do
   tCase <- asks getter
-  updatePerms <- _permUpd <$> tablePermissions tableInfo
+  permissions <- tablePermissions tableInfo
   let maybeConstraints = tciUniqueOrPrimaryKeyConstraints . _tiCoreInfo $ tableInfo
-      maybeConflictObject = conflictObjectParser sourceInfo tableInfo <$> maybeConstraints <*> updatePerms
+      maybeConflictObject = conflictObjectParser sourceInfo tableInfo (_permUpd permissions) <$> maybeConstraints
   case maybeConflictObject of
     Just conflictObject -> conflictObject <&> P.fieldOptional (applyFieldNameCaseCust tCase G._on_conflict) (Just "upsert condition")
     Nothing -> return $ pure Nothing
@@ -71,35 +74,47 @@ conflictObjectParser ::
   MonadBuildSchema ('Postgres pgKind) r m n =>
   SourceInfo ('Postgres pgKind) ->
   TableInfo ('Postgres pgKind) ->
-  NonEmpty (Constraint ('Postgres pgKind)) ->
-  UpdPermInfo ('Postgres pgKind) ->
+  Maybe (UpdPermInfo ('Postgres pgKind)) ->
+  NonEmpty (UniqueConstraint ('Postgres pgKind)) ->
   m (Parser 'Input n (IR.OnConflictClause ('Postgres pgKind) (IR.UnpreparedValue ('Postgres pgKind))))
-conflictObjectParser sourceInfo tableInfo constraints updatePerms = do
+conflictObjectParser sourceInfo tableInfo maybeUpdatePerms constraints = do
   updateColumnsEnum <- updateColumnsPlaceholderParser tableInfo
   constraintParser <- conflictConstraint constraints sourceInfo tableInfo
   whereExpParser <- boolExp sourceInfo tableInfo
   tableGQLName <- getTableGQLName tableInfo
   objectName <- P.mkTypename $ tableGQLName <> G.__on_conflict
 
-  let presetColumns = partialSQLExpToUnpreparedValue <$> upiSet updatePerms
-      updateFilter = fmap partialSQLExpToUnpreparedValue <$> upiFilter updatePerms
-      objectDesc = G.Description $ "on_conflict condition type for table " <>> tableName
-      constraintName = G._constraint
-      columnsName = G._update_columns
-      whereExpName = G._where
+  let objectDesc = G.Description $ "on_conflict condition type for table " <>> tableName
+      (presetColumns, updateFilter) = fromMaybe (HM.empty, IR.gBoolExpTrue) $ do
+        UpdPermInfo {..} <- maybeUpdatePerms
+        pure
+          ( partialSQLExpToUnpreparedValue <$> upiSet,
+            fmap partialSQLExpToUnpreparedValue <$> upiFilter
+          )
 
   pure $
     P.object objectName (Just objectDesc) $ do
-      constraint <- IR.CTConstraint <$> P.field constraintName Nothing constraintParser
-      whereExp <- P.fieldOptional whereExpName Nothing whereExpParser
+      constraintField <- P.field G._constraint Nothing constraintParser
+      let updateColumnsField = P.fieldWithDefault G._update_columns Nothing (G.VList []) (P.list updateColumnsEnum)
+
+      whereExp <- P.fieldOptional G._where Nothing whereExpParser
+
       updateColumns <-
-        P.fieldWithDefault columnsName Nothing (G.VList []) (P.list updateColumnsEnum) `P.bindFields` \cs ->
-          -- this can only happen if the placeholder was used
-          sequenceA cs `onNothing` parseError "erroneous column name"
+        updateColumnsField `P.bindFields` \updateColumnsMaybe ->
+          onNothing
+            (sequenceA @[] @Maybe updateColumnsMaybe)
+            -- this can only happen if the placeholder was used
+            (parseError "erroneous column name")
+
       pure $
-        case updateColumns of
-          [] -> IR.OCCDoNothing $ Just constraint
-          _ -> IR.OCCUpdate $ IR.OnConflictClauseData constraint updateColumns presetColumns $ IR.BoolAnd $ updateFilter : maybeToList whereExp
+        let UniqueConstraint (Constraint {_cName}) _ = constraintField
+            constraintTarget = IR.CTConstraint _cName
+         in case updateColumns of
+              [] -> IR.OCCDoNothing $ Just constraintTarget
+              _ ->
+                IR.OCCUpdate $
+                  IR.OnConflictClauseData constraintTarget updateColumns presetColumns $
+                    IR.BoolAnd $ updateFilter : maybeToList whereExp
   where
     tableName = tableInfoName tableInfo
 
@@ -115,19 +130,24 @@ conflictObjectParser sourceInfo tableInfo constraints updatePerms = do
 conflictConstraint ::
   forall pgKind r m n.
   MonadBuildSchema ('Postgres pgKind) r m n =>
-  NonEmpty (Constraint ('Postgres pgKind)) ->
+  NonEmpty (UniqueConstraint ('Postgres pgKind)) ->
   SourceInfo ('Postgres pgKind) ->
   TableInfo ('Postgres pgKind) ->
-  m (Parser 'Both n (ConstraintName ('Postgres pgKind)))
+  m (Parser 'Both n (UniqueConstraint ('Postgres pgKind)))
 conflictConstraint constraints sourceInfo tableInfo =
   memoizeOn 'conflictConstraint (_siName sourceInfo, tableName) $ do
     tableGQLName <- getTableGQLName tableInfo
-    constraintEnumValues <- for constraints \constraint -> do
-      name <- textToName $ toTxt $ _cName constraint
-      pure
-        ( P.Definition name (Just "unique or primary key constraint") P.EnumValueInfo,
-          _cName constraint
-        )
+    constraintEnumValues <- for
+      constraints
+      \c@(UniqueConstraint (Constraint {_cName}) cCols) -> do
+        name <- textToName $ toTxt $ _cName
+        pure
+          ( P.Definition
+              name
+              (Just $ "unique or primary key constraint on columns " <> coerce (showPGCols (HS.toList cCols)))
+              P.EnumValueInfo,
+            c
+          )
     enumName <- P.mkTypename $ tableGQLName <> G.__constraint
     let enumDesc = G.Description $ "unique or primary key constraints on table " <>> tableName
     pure $ P.enum enumName (Just enumDesc) constraintEnumValues

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

@@ -120,7 +120,7 @@ getTableDiff oldtm newtm =
     uniqueOrPrimaryCons =
       map _cName $
         maybeToList (_pkConstraint <$> _ptmiPrimaryKey (tmInfo newtm))
-          <> toList (_ptmiUniqueConstraints $ tmInfo newtm)
+          <> (_ucConstraint <$> toList (_ptmiUniqueConstraints (tmInfo newtm)))
 
     mNewDesc = _ptmiDescription $ tmInfo newtm
 

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

@@ -120,7 +120,7 @@ buildConflictClause sessVarBldr tableInfo inpCols (OnConflict mTCol mTCons act)
     validateConstraint c = do
       let tableConsNames =
             maybe [] toList $
-              fmap _cName <$> tciUniqueOrPrimaryKeyConstraints coreInfo
+              fmap (_cName . _ucConstraint) <$> tciUniqueOrPrimaryKeyConstraints coreInfo
       withPathK "constraint" $
         unless (c `elem` tableConsNames) $
           throw400 Unexpected $

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

@@ -25,6 +25,7 @@ module Hasura.RQL.Types.Table
     TableCoreInfoG (..),
     TableCustomRootFields (..),
     TableInfo (..),
+    UniqueConstraint (..),
     UpdPermInfo (..),
     ViewInfo (..),
     askColInfo,
@@ -236,10 +237,10 @@ getAllCustomRootFields (TableCustomRootFields select selectByPk selectAgg insert
   ]
 
 data FieldInfo (b :: BackendType)
-  = FIColumn !(ColumnInfo b)
-  | FIRelationship !(RelInfo b)
-  | FIComputedField !(ComputedFieldInfo b)
-  | FIRemoteRelationship !(RemoteFieldInfo (DBJoinField b))
+  = FIColumn (ColumnInfo b)
+  | FIRelationship (RelInfo b)
+  | FIComputedField (ComputedFieldInfo b)
+  | FIRemoteRelationship (RemoteFieldInfo (DBJoinField b))
   deriving (Generic)
 
 deriving instance Backend b => Eq (FieldInfo b)
@@ -305,11 +306,11 @@ getComputedFieldInfos :: FieldInfoMap (FieldInfo backend) -> [ComputedFieldInfo
 getComputedFieldInfos = mapMaybe (^? _FIComputedField) . M.elems
 
 data InsPermInfo (b :: BackendType) = InsPermInfo
-  { ipiCols :: !(HS.HashSet (Column b)),
-    ipiCheck :: !(AnnBoolExpPartialSQL b),
-    ipiSet :: !(PreSetColsPartial b),
-    ipiBackendOnly :: !Bool,
-    ipiRequiredHeaders :: !(HS.HashSet Text)
+  { ipiCols :: HS.HashSet (Column b),
+    ipiCheck :: AnnBoolExpPartialSQL b,
+    ipiSet :: PreSetColsPartial b,
+    ipiBackendOnly :: Bool,
+    ipiRequiredHeaders :: HS.HashSet Text
   }
   deriving (Generic)
 
@@ -479,13 +480,13 @@ instance
   toJSON = genericToJSON hasuraJSON
 
 data UpdPermInfo (b :: BackendType) = UpdPermInfo
-  { upiCols :: !(HS.HashSet (Column b)),
-    upiTable :: !(TableName b),
-    upiFilter :: !(AnnBoolExpPartialSQL b),
-    upiCheck :: !(Maybe (AnnBoolExpPartialSQL b)),
-    upiSet :: !(PreSetColsPartial b),
-    upiBackendOnly :: !Bool,
-    upiRequiredHeaders :: !(HashSet Text)
+  { upiCols :: HS.HashSet (Column b),
+    upiTable :: TableName b,
+    upiFilter :: AnnBoolExpPartialSQL b,
+    upiCheck :: Maybe (AnnBoolExpPartialSQL b),
+    upiSet :: PreSetColsPartial b,
+    upiBackendOnly :: Bool,
+    upiRequiredHeaders :: HashSet Text
   }
   deriving (Generic)
 
@@ -527,10 +528,10 @@ instance
   toJSON = genericToJSON hasuraJSON
 
 data DelPermInfo (b :: BackendType) = DelPermInfo
-  { dpiTable :: !(TableName b),
-    dpiFilter :: !(AnnBoolExpPartialSQL b),
+  { dpiTable :: TableName b,
+    dpiFilter :: AnnBoolExpPartialSQL b,
     dpiBackendOnly :: !Bool,
-    dpiRequiredHeaders :: !(HashSet Text)
+    dpiRequiredHeaders :: HashSet Text
   }
   deriving (Generic)
 
@@ -572,10 +573,10 @@ instance
   toJSON = genericToJSON hasuraJSON
 
 data RolePermInfo (b :: BackendType) = RolePermInfo
-  { _permIns :: !(Maybe (InsPermInfo b)),
-    _permSel :: !(Maybe (SelPermInfo b)),
-    _permUpd :: !(Maybe (UpdPermInfo b)),
-    _permDel :: !(Maybe (DelPermInfo b))
+  { _permIns :: Maybe (InsPermInfo b),
+    _permSel :: Maybe (SelPermInfo b),
+    _permUpd :: Maybe (UpdPermInfo b),
+    _permDel :: Maybe (DelPermInfo b)
   }
   deriving (Generic)
 
@@ -629,16 +630,16 @@ type RolePermInfoMap b = M.HashMap RoleName (RolePermInfo b)
 
 -- data TableConstraint
 --   = TableConstraint
---   { tcType :: !ConstraintType
---   , tcName :: !ConstraintName
+--   { tcType :: ConstraintType
+--   , tcName :: ConstraintName
 --   } deriving (Show, Eq)
 
 -- $(deriveJSON hasuraJSON ''TableConstraint)
 
 data ViewInfo = ViewInfo
-  { viIsUpdatable :: !Bool,
-    viIsDeletable :: !Bool,
-    viIsInsertable :: !Bool
+  { viIsUpdatable :: Bool,
+    viIsDeletable :: Bool,
+    viIsInsertable :: Bool
   }
   deriving (Show, Eq, Generic)
 
@@ -706,7 +707,7 @@ instance (Backend b) => Cacheable (TableConfig b)
 
 $(makeLenses ''TableConfig)
 
-emptyTableConfig :: (TableConfig b)
+emptyTableConfig :: TableConfig b
 emptyTableConfig =
   TableConfig emptyCustomRootFields M.empty Nothing Automatic
 
@@ -745,8 +746,8 @@ instance (Backend b) => ToJSON (TableConfig b) where
         ]
 
 data Constraint (b :: BackendType) = Constraint
-  { _cName :: !(ConstraintName b),
-    _cOid :: !OID
+  { _cName :: ConstraintName b,
+    _cOid :: OID
   }
   deriving (Generic)
 
@@ -767,8 +768,8 @@ instance Backend b => FromJSON (Constraint b) where
   parseJSON = genericParseJSON hasuraJSON
 
 data PrimaryKey (b :: BackendType) a = PrimaryKey
-  { _pkConstraint :: !(Constraint b),
-    _pkColumns :: !(NESeq a)
+  { _pkConstraint :: Constraint b,
+    _pkColumns :: NESeq a
   }
   deriving (Generic, Foldable)
 
@@ -790,10 +791,40 @@ instance (Backend b, FromJSON a) => FromJSON (PrimaryKey b a) where
 
 $(makeLenses ''PrimaryKey)
 
+-- | Data type modelling uniqueness constraints. Occasionally this will include
+-- primary keys, although those are tracked separately in `TableCoreInfoG`.
+--
+-- For more information about unique constraints, visit the postgresql documentation:
+-- <https://www.postgresql.org/docs/current/ddl-constraints.html#DDL-CONSTRAINTS-UNIQUE-CONSTRAINTS>.
+data UniqueConstraint (b :: BackendType) = UniqueConstraint
+  { -- | The postgresql name and object id of a unique constraint.
+    _ucConstraint :: Constraint b,
+    -- | The set of columns which should be unique for this particular constraint.
+    --   Used for permissions calculation.
+    _ucColumns :: HashSet (Column b)
+  }
+  deriving (Generic)
+
+deriving instance Backend b => Eq (UniqueConstraint b)
+
+deriving instance Backend b => Show (UniqueConstraint b)
+
+instance Backend b => NFData (UniqueConstraint b)
+
+instance Backend b => Hashable (UniqueConstraint b)
+
+instance Backend b => Cacheable (UniqueConstraint b)
+
+instance Backend b => ToJSON (UniqueConstraint b) where
+  toJSON = genericToJSON hasuraJSON
+
+instance Backend b => FromJSON (UniqueConstraint b) where
+  parseJSON = genericParseJSON hasuraJSON
+
 data ForeignKey (b :: BackendType) = ForeignKey
-  { _fkConstraint :: !(Constraint b),
-    _fkForeignTable :: !(TableName b),
-    _fkColumnMapping :: !(NEHashMap (Column b) (Column b))
+  { _fkConstraint :: Constraint b,
+    _fkForeignTable :: TableName b,
+    _fkColumnMapping :: NEHashMap (Column b) (Column b)
   }
   deriving (Generic)
 
@@ -816,18 +847,18 @@ instance Backend b => FromJSON (ForeignKey b) where
 -- | The @field@ and @primaryKeyColumn@ type parameters vary as the schema cache is built and more
 -- information is accumulated. See also 'TableCoreInfo'.
 data TableCoreInfoG (b :: BackendType) field primaryKeyColumn = TableCoreInfo
-  { _tciName :: !(TableName b),
-    _tciDescription :: !(Maybe PG.PGDescription), -- TODO make into type family?
-    _tciSystemDefined :: !SystemDefined,
-    _tciFieldInfoMap :: !(FieldInfoMap field),
-    _tciPrimaryKey :: !(Maybe (PrimaryKey b primaryKeyColumn)),
+  { _tciName :: TableName b,
+    _tciDescription :: Maybe PG.PGDescription, -- TODO make into type family?
+    _tciSystemDefined :: SystemDefined,
+    _tciFieldInfoMap :: FieldInfoMap field,
+    _tciPrimaryKey :: Maybe (PrimaryKey b primaryKeyColumn),
     -- | Does /not/ include the primary key; use 'tciUniqueOrPrimaryKeyConstraints' if you need both.
-    _tciUniqueConstraints :: !(HashSet (Constraint b)),
-    _tciForeignKeys :: !(HashSet (ForeignKey b)),
-    _tciViewInfo :: !(Maybe ViewInfo),
-    _tciEnumValues :: !(Maybe EnumValues),
-    _tciCustomConfig :: !(TableConfig b),
-    _tciExtraTableMetadata :: !(ExtraTableMetadata b)
+    _tciUniqueConstraints :: HashSet (UniqueConstraint b),
+    _tciForeignKeys :: HashSet (ForeignKey b),
+    _tciViewInfo :: Maybe ViewInfo,
+    _tciEnumValues :: Maybe EnumValues,
+    _tciCustomConfig :: TableConfig b,
+    _tciExtraTableMetadata :: ExtraTableMetadata b
   }
   deriving (Generic)
 
@@ -844,16 +875,22 @@ $(makeLenses ''TableCoreInfoG)
 type TableCoreInfo b = TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
 
 tciUniqueOrPrimaryKeyConstraints ::
-  TableCoreInfoG b f pkCol -> Maybe (NonEmpty (Constraint b))
+  forall b f.
+  (Eq (Column b), Hashable (Column b)) =>
+  TableCoreInfoG b f (ColumnInfo b) ->
+  Maybe (NonEmpty (UniqueConstraint b))
 tciUniqueOrPrimaryKeyConstraints info =
   NE.nonEmpty $
-    maybeToList (_pkConstraint <$> _tciPrimaryKey info)
-      <> toList (_tciUniqueConstraints info)
+    maybeToList (primaryToUnique <$> _tciPrimaryKey info)
+      <> (toList (_tciUniqueConstraints info))
+  where
+    primaryToUnique :: PrimaryKey b (ColumnInfo b) -> UniqueConstraint b
+    primaryToUnique pk = UniqueConstraint (_pkConstraint pk) (HS.fromList . fmap ciColumn . toList $ _pkColumns pk)
 
 data TableInfo (b :: BackendType) = TableInfo
   { _tiCoreInfo :: TableCoreInfo b,
-    _tiRolePermInfoMap :: !(RolePermInfoMap b),
-    _tiEventTriggerInfoMap :: !(EventTriggerInfoMap b),
+    _tiRolePermInfoMap :: RolePermInfoMap b,
+    _tiEventTriggerInfoMap :: EventTriggerInfoMap b,
     _tiAdminRolePermInfo :: RolePermInfo b
   }
   deriving (Generic)
@@ -918,15 +955,15 @@ instance Backend b => FromJSON (ForeignKeyMetadata b) where
 
 -- | Metadata of any Backend table which is being extracted from source database
 data DBTableMetadata (b :: BackendType) = DBTableMetadata
-  { _ptmiOid :: !OID,
-    _ptmiColumns :: ![RawColumnInfo b],
-    _ptmiPrimaryKey :: !(Maybe (PrimaryKey b (Column b))),
-    -- | Does /not/ include the primary key!
-    _ptmiUniqueConstraints :: !(HashSet (Constraint b)),
-    _ptmiForeignKeys :: !(HashSet (ForeignKeyMetadata b)),
-    _ptmiViewInfo :: !(Maybe ViewInfo),
-    _ptmiDescription :: !(Maybe PG.PGDescription),
-    _ptmiExtraTableMetadata :: !(ExtraTableMetadata b)
+  { _ptmiOid :: OID,
+    _ptmiColumns :: [RawColumnInfo b],
+    _ptmiPrimaryKey :: Maybe (PrimaryKey b (Column b)),
+    -- | Does /not/ include the primary key
+    _ptmiUniqueConstraints :: HashSet (UniqueConstraint b),
+    _ptmiForeignKeys :: HashSet (ForeignKeyMetadata b),
+    _ptmiViewInfo :: Maybe ViewInfo,
+    _ptmiDescription :: Maybe PG.PGDescription,
+    _ptmiExtraTableMetadata :: ExtraTableMetadata b
   }
   deriving (Generic)
 

server/src-rsr/citus_table_metadata.sql

@@ -117,7 +117,9 @@ LEFT JOIN LATERAL
 -- primary key
 LEFT JOIN LATERAL
   ( SELECT jsonb_build_object(
-      'constraint', jsonb_build_object('name', class.relname, 'oid', class.oid :: integer),
+      'constraint', jsonb_build_object(
+        'name', class.relname,
+        'oid', class.oid :: integer),
       'columns', coalesce(columns.info, '[]')
     ) AS info
     FROM pg_catalog.pg_index index
@@ -135,10 +137,24 @@ LEFT JOIN LATERAL
 
 -- unique constraints
 LEFT JOIN LATERAL
-  ( SELECT jsonb_agg(jsonb_build_object('name', class.relname, 'oid', class.oid :: integer)) AS info
+  ( SELECT jsonb_agg(
+      jsonb_build_object(
+        'constraint', jsonb_build_object(
+          'name', class.relname,
+          'oid', class.oid :: integer
+          ),
+        'columns', columns.info
+        )
+      ) AS info
     FROM pg_catalog.pg_index index
     JOIN pg_catalog.pg_class class
       ON class.oid = index.indexrelid
+    LEFT JOIN LATERAL
+      ( SELECT jsonb_agg("column".attname) AS info
+        FROM pg_catalog.pg_attribute "column"
+        WHERE "column".attrelid = "table".oid
+          AND "column".attnum = ANY (index.indkey)
+      ) AS columns ON true
     WHERE index.indrelid = "table".oid
       AND index.indisunique
       AND NOT index.indisprimary

server/src-rsr/pg_table_metadata.sql

@@ -110,7 +110,9 @@ LEFT JOIN LATERAL
 -- primary key
 LEFT JOIN LATERAL
   ( SELECT jsonb_build_object(
-      'constraint', jsonb_build_object('name', class.relname, 'oid', class.oid :: integer),
+      'constraint', jsonb_build_object(
+        'name', class.relname,
+        'oid', class.oid :: integer),
       'columns', coalesce(columns.info, '[]')
     ) AS info
     FROM pg_catalog.pg_index idx
@@ -128,10 +130,24 @@ LEFT JOIN LATERAL
 
 -- unique constraints
 LEFT JOIN LATERAL
-  ( SELECT jsonb_agg(jsonb_build_object('name', class.relname, 'oid', class.oid :: integer)) AS info
+  ( SELECT jsonb_agg(
+      jsonb_build_object(
+        'constraint', jsonb_build_object(
+          'name', class.relname,
+          'oid', class.oid :: integer
+          ),
+        'columns', columns.info
+        )
+      ) AS info
     FROM pg_catalog.pg_index idx
     JOIN pg_catalog.pg_class class
       ON class.oid = idx.indexrelid
+    LEFT JOIN LATERAL
+      ( SELECT jsonb_agg("column".attname) AS info
+        FROM pg_catalog.pg_attribute "column"
+        WHERE "column".attrelid = "table".oid
+          AND "column".attnum = ANY (idx.indkey)
+      ) AS columns ON true
     WHERE idx.indrelid = "table".oid
       AND idx.indisunique
       AND NOT idx.indisprimary

server/tests-hspec/Harness/Backend/Citus.hs

@@ -16,6 +16,8 @@ module Harness.Backend.Citus
     untrackTable,
     setup,
     teardown,
+    setupPermissions,
+    teardownPermissions,
   )
 where
 
@@ -36,6 +38,7 @@ import Harness.Exceptions
 import Harness.GraphqlEngine qualified as GraphqlEngine
 import Harness.Quoter.Yaml (yaml)
 import Harness.Test.Context (BackendType (Citus), defaultSource)
+import Harness.Test.Permissions qualified as Permissions
 import Harness.Test.Schema (BackendScalarType (..), BackendScalarValue (..), ScalarValue (..))
 import Harness.Test.Schema qualified as Schema
 import Harness.TestEnvironment (TestEnvironment)
@@ -245,3 +248,11 @@ teardown tables (testEnvironment, _) = do
           (untrackTable testEnvironment table)
           (dropTable table)
       )
+
+-- | Setup the given permissions to the graphql engine in a TestEnvironment.
+setupPermissions :: [Permissions.Permission] -> TestEnvironment -> IO ()
+setupPermissions permissions env = Permissions.setup "citus" permissions env
+
+-- | Remove the given permissions from the graphql engine in a TestEnvironment.
+teardownPermissions :: [Permissions.Permission] -> TestEnvironment -> IO ()
+teardownPermissions permissions env = Permissions.teardown "citus" permissions env

server/tests-hspec/Harness/Backend/Postgres.hs

@@ -16,6 +16,8 @@ module Harness.Backend.Postgres
     untrackTable,
     setup,
     teardown,
+    setupPermissions,
+    teardownPermissions,
   )
 where
 
@@ -36,6 +38,7 @@ import Harness.Exceptions
 import Harness.GraphqlEngine qualified as GraphqlEngine
 import Harness.Quoter.Yaml (yaml)
 import Harness.Test.Context (BackendType (Postgres), defaultBackendTypeString, defaultSource)
+import Harness.Test.Permissions qualified as Permissions
 import Harness.Test.Schema (BackendScalarType (..), BackendScalarValue (..), ScalarValue (..))
 import Harness.Test.Schema qualified as Schema
 import Harness.TestEnvironment (TestEnvironment)
@@ -255,3 +258,11 @@ teardown tables (testEnvironment, _) = do
           (untrackTable testEnvironment table)
           (dropTable table)
       )
+
+-- | Setup the given permissions to the graphql engine in a TestEnvironment.
+setupPermissions :: [Permissions.Permission] -> TestEnvironment -> IO ()
+setupPermissions permissions env = Permissions.setup "pg" permissions env
+
+-- | Remove the given permissions from the graphql engine in a TestEnvironment.
+teardownPermissions :: [Permissions.Permission] -> TestEnvironment -> IO ()
+teardownPermissions permissions env = Permissions.teardown "pg" permissions env

server/tests-hspec/Harness/Test/Context.hs

@@ -8,6 +8,7 @@ module Harness.Test.Context
   ( run,
     runWithLocalTestEnvironment,
     Context (..),
+    context,
     ContextName (..),
     BackendType (..),
     defaultSource,
@@ -101,9 +102,9 @@ runWithLocalTestEnvironment ::
   (Options -> SpecWith (TestEnvironment, a)) ->
   SpecWith TestEnvironment
 runWithLocalTestEnvironment contexts tests =
-  for_ contexts \context@Context {name, customOptions} -> do
+  for_ contexts \ctx@Context {name, customOptions} -> do
     let options = fromMaybe defaultOptions customOptions
-    describe (show name) $ aroundAllWith (contextBracket context) (tests options)
+    describe (show name) $ aroundAllWith (contextBracket ctx) (tests options)
   where
     -- We want to be able to report exceptions happening both during the tests
     -- and at teardown, which is why we use a custom re-implementation of
@@ -188,6 +189,15 @@ data Context a = Context
     customOptions :: Maybe Options
   }
 
+-- | A simple smart constructor for a 'Context'.
+context :: ContextName -> Context ()
+context name = Context {..}
+  where
+    mkLocalTestEnvironment = noLocalTestEnvironment
+    setup = const (pure ())
+    teardown = const (pure ())
+    customOptions = Nothing
+
 -- | A name describing the given context.
 data ContextName
   = Backend BackendType

server/tests-hspec/Harness/Test/Permissions.hs

@@ -0,0 +1,164 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+-- | Common interface for setup/teardown of permissions metadata.
+--
+-- It's preferable to use the backend-specific versions of 'setup' and 'teardown'.
+module Harness.Test.Permissions
+  ( Permission (..),
+    createPermission,
+    dropPermission,
+    setup,
+    teardown,
+  )
+where
+
+import Data.Text (Text)
+import Harness.GraphqlEngine qualified as GraphqlEngine
+import Harness.Quoter.Yaml (yaml)
+import Harness.TestEnvironment
+import Prelude
+
+-- | Data type used to model permissions to be setup in tests.
+-- Each case of this type mirrors the fields in the correspond permission
+-- tracking metadata API payload.
+data Permission
+  = SelectPermission
+      { permissionTable :: Text,
+        permissionSource :: Text,
+        permissionRole :: Text,
+        permissionColumns :: [Text]
+      }
+  | UpdatePermission
+      { permissionTable :: Text,
+        permissionSource :: Text,
+        permissionRole :: Text,
+        permissionColumns :: [Text]
+      }
+  | InsertPermission
+      { permissionTable :: Text,
+        permissionSource :: Text,
+        permissionRole :: Text,
+        permissionColumns :: [Text]
+      }
+
+createPermission :: Text -> TestEnvironment -> Permission -> IO ()
+createPermission backendPrefix env InsertPermission {..} = do
+  let requestType = backendPrefix <> "_create_insert_permission"
+      qualifiedTable =
+        [yaml|
+          schema: "hasura"
+          name: *permissionTable
+        |]
+  GraphqlEngine.postMetadata_
+    env
+    [yaml|
+      type: *requestType
+      args:
+        table: *qualifiedTable
+        source: *permissionSource
+        role:  *permissionRole
+        permission:
+          columns: *permissionColumns
+          check: {}
+          set: {}
+    |]
+createPermission backendPrefix env UpdatePermission {..} = do
+  let requestType = backendPrefix <> "_create_update_permission"
+      qualifiedTable =
+        [yaml|
+          schema: "hasura"
+          name: *permissionTable
+        |]
+  GraphqlEngine.postMetadata_
+    env
+    [yaml|
+      type: *requestType
+      args:
+        table: *qualifiedTable
+        source: *permissionSource
+        role:  *permissionRole
+        permission:
+          columns: *permissionColumns
+          filter: {}
+          check: {}
+          set: {}
+    |]
+createPermission backendPrefix env SelectPermission {..} = do
+  let requestType = backendPrefix <> "_create_select_permission"
+      qualifiedTable =
+        [yaml|
+          schema: "hasura"
+          name: *permissionTable
+        |]
+  GraphqlEngine.postMetadata_
+    env
+    [yaml|
+      type: *requestType
+      args:
+        table: *qualifiedTable
+        source: *permissionSource
+        role:  *permissionRole
+        permission:
+          columns: *permissionColumns
+          filter: {}
+    |]
+
+dropPermission :: Text -> TestEnvironment -> Permission -> IO ()
+dropPermission backendPrefix env InsertPermission {..} = do
+  let requestType = backendPrefix <> "_drop_insert_permission"
+      qualifiedTable =
+        [yaml|
+          schema: "hasura"
+          name: *permissionTable
+        |]
+  GraphqlEngine.postMetadata_
+    env
+    [yaml|
+      type: *requestType
+      args:
+        table: *qualifiedTable
+        source: *permissionSource
+        role:  *permissionRole
+    |]
+dropPermission backendPrefix env SelectPermission {..} = do
+  let requestType = backendPrefix <> "_drop_select_permission"
+      qualifiedTable =
+        [yaml|
+          schema: "hasura"
+          name: *permissionTable
+        |]
+  GraphqlEngine.postMetadata_
+    env
+    [yaml|
+      type: *requestType
+      args:
+        table: *qualifiedTable
+        source: *permissionSource
+        role:  *permissionRole
+    |]
+dropPermission backendPrefix env UpdatePermission {..} = do
+  let requestType = backendPrefix <> "_drop_update_permission"
+      qualifiedTable =
+        [yaml|
+          schema: "hasura"
+          name: *permissionTable
+        |]
+  GraphqlEngine.postMetadata_
+    env
+    [yaml|
+      type: *requestType
+      args:
+        table: *qualifiedTable
+        source: *permissionSource
+        role:  *permissionRole
+    |]
+
+-- | Setup the given permissions to the graphql engine in a TestEnvironment.
+setup :: Text -> [Permission] -> TestEnvironment -> IO ()
+setup backendPrefix permissions testEnvironment =
+  mapM_ (createPermission backendPrefix testEnvironment) permissions
+
+-- | Remove the given permissions from the graphql engine in a TestEnvironment.
+teardown :: Text -> [Permission] -> TestEnvironment -> IO ()
+teardown backendPrefix permissions testEnvironment =
+  mapM_ (dropPermission backendPrefix testEnvironment) permissions

server/tests-hspec/Harness/Test/Schema.hs

@@ -3,6 +3,7 @@
 -- | Common interface for setup/teardown for all backends - schema and data
 module Harness.Test.Schema
   ( Table (..),
+    table,
     Reference (..),
     Column (..),
     ScalarType (..),
@@ -61,6 +62,11 @@ data Table = Table
   }
   deriving (Show, Eq)
 
+-- | Create a table from just a name.
+-- Use record updates to modify the result.
+table :: Text -> Table
+table tableName = Table tableName [] [] [] []
+
 -- | Foreign keys for backends that support it.
 data Reference = Reference
   { referenceLocalColumn :: Text,

server/tests-hspec/Test/InsertOnConflictSpec.hs

@@ -0,0 +1,213 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+-- | Tests of the Postgres-specific upsert feature.
+module Test.InsertOnConflictSpec (spec) where
+
+import Data.Aeson.Types (Parser, Value, listParser, parseEither, withObject, (.:), (.:?))
+import Data.Text
+import Data.Text.Encoding (encodeUtf8)
+import Harness.Backend.Citus qualified as Citus
+import Harness.Backend.Postgres qualified as Postgres
+import Harness.GraphqlEngine qualified as GraphqlEngine
+import Harness.Quoter.Graphql
+import Harness.Quoter.Yaml
+import Harness.Test.BackendType qualified as BackendType
+import Harness.Test.Context
+import Harness.Test.Permissions (Permission (..))
+import Harness.Test.Schema
+import Harness.TestEnvironment (TestEnvironment)
+import Hasura.Prelude
+import Test.Hspec hiding (context)
+
+--------------------------------------------------------------------------------
+-- Preamble
+
+spec :: SpecWith TestEnvironment
+spec = run [postgresContext, citusContext] (\_ -> tests)
+
+postgresContext :: Context ()
+postgresContext =
+  (context $ Backend BackendType.Postgres)
+    { setup = \(t, _) -> do
+        Postgres.setup tables (t, ())
+        Postgres.setupPermissions (permissions "postgres") t,
+      teardown = \(t, _) -> do
+        Postgres.teardownPermissions (permissions "postgres") t
+        Postgres.teardown tables (t, ())
+    }
+
+citusContext :: Context ()
+citusContext =
+  (context $ Backend BackendType.Citus)
+    { setup = \(t, _) -> do
+        Citus.setup tables (t, ())
+        Citus.setupPermissions (permissions "citus") t,
+      teardown = \(t, _) -> do
+        Citus.teardownPermissions (permissions "citus") t
+        Citus.teardown tables (t, ())
+    }
+
+tables :: [Table]
+tables =
+  [ (table "foo")
+      { tableColumns =
+          [ column "id" TInt,
+            column "bar" TStr
+          ],
+        tablePrimaryKey = ["id"],
+        tableData =
+          [ [VInt 0, VStr "initial"]
+          ]
+      }
+  ]
+
+permissions :: Text -> [Permission]
+permissions source =
+  [ SelectPermission
+      { permissionTable = "foo",
+        permissionSource = source,
+        permissionRole = "role-select-only",
+        permissionColumns = ["id", "bar"]
+      },
+    InsertPermission
+      { permissionTable = "foo",
+        permissionSource = source,
+        permissionRole = "role-insert-only",
+        permissionColumns = ["id", "bar"]
+      }
+  ]
+
+--------------------------------------------------------------------------------
+-- Tests
+
+tests :: SpecWith TestEnvironment
+tests =
+  -- Tests relating to https://github.com/hasura/graphql-engine/issues/8260
+  describe "The schema for insert mutations with an 'on_conflict' clause" do
+    describe "When no columns are updateable" do
+      it "Is still present with an empty enum" testEmptyUpdateColumns
+      it "Inserts ignoring duplicates" testInsertDoNothing
+
+testEmptyUpdateColumns :: TestEnvironment -> IO ()
+testEmptyUpdateColumns env = do
+  introspectTypes env "role-insert-only"
+    >>= (`shouldContain` ["hasura_foo_on_conflict"])
+
+  introspectEnums env "role-insert-only"
+    >>= (`shouldContain` [("hasura_foo_update_column", ["_PLACEHOLDER"])])
+
+testInsertDoNothing :: TestEnvironment -> IO ()
+testInsertDoNothing env = do
+  -- We can insert ignoring duplicates
+  GraphqlEngine.postGraphqlWithHeaders
+    env
+    [("X-Hasura-Role", encodeUtf8 "role-insert-only")]
+    [graphql|
+        mutation OnConflictDoNothing {
+          insert_hasura_foo
+          (
+            objects: [
+              {bar: "untouched", id: 0},
+              {bar: "inserted",  id: 1}],
+            on_conflict: {constraint: foo_pkey, update_columns: []}
+          )
+          {
+            affected_rows
+          }
+        }
+      |]
+    >>= ( `shouldBe`
+            [yaml|
+              data:
+                insert_hasura_foo:
+                  affected_rows: 1
+            |]
+        )
+
+  -- The data actually gets stored
+  GraphqlEngine.postGraphqlWithHeaders
+    env
+    [("X-Hasura-Role", encodeUtf8 "role-select-only")]
+    [graphql|
+      query ActualData {
+        hasura_foo {
+          bar
+          id
+        }
+      }
+      |]
+    >>= ( `shouldBe`
+            [yaml|
+              data:
+                hasura_foo:
+                - bar: "initial"
+                  id: 0
+                - bar: "inserted"
+                  id: 1
+            |]
+        )
+
+----------------------------------
+-- Test helpers
+
+introspectTypes :: TestEnvironment -> Text -> IO [Text]
+introspectTypes env role = do
+  res <-
+    GraphqlEngine.postGraphqlWithHeaders
+      env
+      [("X-Hasura-Role", encodeUtf8 role)]
+      [graphql|
+          query IntrospectTypes { __schema {
+            types { name }
+          }}
+        |]
+  onLeft (parseEither getTypes res) fail
+  where
+    getTypes :: Value -> Parser [Text]
+    getTypes = withObject "introspection top-level" $ \top -> do
+      d <- top .: "data"
+      sch <- d .: "__schema"
+      types <- sch .: "types"
+      listParser parseType types
+
+    parseType :: Value -> Parser Text
+    parseType = withObject "a 'types' element" $ \types -> types .: "name"
+
+introspectEnums :: TestEnvironment -> Text -> IO [(Text, [Text])]
+introspectEnums env role = do
+  res <-
+    GraphqlEngine.postGraphqlWithHeaders
+      env
+      [("X-Hasura-Role", encodeUtf8 role)]
+      [graphql|
+        query IntrospectEnums {
+          __schema {
+            types {
+              enumValues {
+                name
+              }
+              name
+            }
+          }
+        }
+      |]
+  onLeft (parseEither getEnums res) fail
+  where
+    getEnums :: Value -> Parser [(Text, [Text])]
+    getEnums = withObject "introspection top-level" $ \top -> do
+      d <- top .: "data"
+      sch <- d .: "__schema"
+      types <- sch .: "types"
+      catMaybes <$> listParser parseEnum types
+
+    parseEnum :: Value -> Parser (Maybe (Text, [Text]))
+    parseEnum = withObject "a 'types' element" $ \types -> do
+      name <- types .: "name"
+      maybeVals <- types .:? "enumValues"
+      case maybeVals of
+        Nothing -> return Nothing
+        Just vals -> Just . (name,) <$> listParser parseEnumValue vals
+
+    parseEnumValue :: Value -> Parser Text
+    parseEnumValue = withObject "enumValue" (.: "name")