Refactor insert mutations IR use of "default values"

PR-URL: hasura/graphql-engine-mono#4316
GitOrigin-RevId: 91f80902a2dc2a782821033f455c70c4e96f0950

Author: plcplc

server/src-lib/Data/HashMap/Strict/Extended.hs

@@ -11,6 +11,7 @@ module Data.HashMap.Strict.Extended
     unionWithM,
     unionsAll,
     unionsWith,
+    homogenise,
   )
 where
 
@@ -19,7 +20,10 @@ import Data.Align qualified as A
 import Data.Foldable qualified as F
 import Data.Function (on)
 import Data.HashMap.Strict as M
+import Data.HashSet (HashSet)
+import Data.HashSet qualified as S
 import Data.Hashable (Hashable)
+import Data.List qualified as L
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.These (These (That, These, This))
 import Prelude
@@ -133,3 +137,11 @@ unionsWith ::
   f (HashMap k a) ->
   HashMap k a
 unionsWith f ts = F.foldl' (unionWith f) empty ts
+
+-- | Homogenise maps, such that all maps range over the full set of
+-- keys, inserting a default value as needed.
+homogenise :: (Hashable a, Eq a) => b -> [HashMap a b] -> (HashSet a, [HashMap a b])
+homogenise defaultValue maps =
+  let ks = S.unions $ L.map keysSet maps
+      defaults = fromList [(k, defaultValue) | k <- S.toList ks]
+   in (ks, L.map (<> defaults) maps)

server/src-lib/Hasura/Backends/BigQuery/Instances/Schema.hs

@@ -57,9 +57,6 @@ instance BackendSchema 'BigQuery where
   computedField = bqComputedField
   node = bqNode
 
-  -- SQL literals
-  columnDefaultValue = error "TODO: Make impossible by the type system. BigQuery doesn't support insertions."
-
 ----------------------------------------------------------------
 -- Top level parsers
 

server/src-lib/Hasura/Backends/DataWrapper/Adapter/Schema.hs

@@ -60,8 +60,6 @@ instance BackendSchema 'DataWrapper where
     error "computedField: not implemented for GraphQL Data Wrappers."
   node =
     error "node: not implemented for GraphQL Data Wrappers."
-  columnDefaultValue =
-    error "columnDefaultValue: not implemented for GraphQL Data Wrappers."
 
 --------------------------------------------------------------------------------
 

server/src-lib/Hasura/Backends/MSSQL/Execute/Insert.hs

@@ -187,7 +187,7 @@ buildInsertTx tableName withAlias stringifyNum insert = do
 --   Should be used as part of a bigger transaction in 'buildInsertTx'.
 buildUpsertTx :: TSQL.TableName -> AnnotatedInsert 'MSSQL Void Expression -> IfMatched Expression -> Tx.TxET QErr IO ()
 buildUpsertTx tableName insert ifMatched = do
-  let presets = _aiDefaultValues $ _aiData insert
+  let presets = _aiPresetValues $ _aiData insert
       insertColumnNames =
         concatMap (map fst . getInsertColumns) (_aiInsertObject $ _aiData insert) <> HM.keys presets
       allTableColumns = _aiTableColumns $ _aiData insert

server/src-lib/Hasura/Backends/MSSQL/FromIr/Insert.hs

@@ -7,8 +7,9 @@ module Hasura.Backends.MSSQL.FromIr.Insert
   )
 where
 
-import Data.Containers.ListUtils (nubOrd)
 import Data.HashMap.Strict qualified as HM
+import Data.HashMap.Strict.Extended qualified as HM
+import Data.HashSet qualified as HS
 import Hasura.Backends.MSSQL.FromIr (FromIr)
 import Hasura.Backends.MSSQL.FromIr.Constants (tempTableNameInserted, tempTableNameValues)
 import Hasura.Backends.MSSQL.FromIr.Expression (fromGBoolExp)
@@ -23,13 +24,12 @@ import Hasura.SQL.Backend
 fromInsert :: IR.AnnotatedInsert 'MSSQL Void Expression -> Insert
 fromInsert IR.AnnotatedInsert {..} =
   let IR.AnnotatedInsertData {..} = _aiData
-      insertRows = normalizeInsertRows _aiDefaultValues $ map IR.getInsertColumns _aiInsertObject
-      insertColumnNames = maybe [] (map fst) $ listToMaybe insertRows
-      insertValues = map (Values . map snd) insertRows
+      (insertColumnNames, insertRows) = normalizeInsertRows _aiPresetValues $ _aiInsertObject
+      insertValues = map (Values . HM.elems) insertRows
       allColumnNames = map IR.ciColumn _aiTableColumns
       insertOutput = Output Inserted $ map OutputColumn allColumnNames
       tempTable = TempTable tempTableNameInserted allColumnNames
-   in Insert _aiTableName insertColumnNames insertOutput tempTable insertValues
+   in Insert _aiTableName (HS.toList insertColumnNames) insertOutput tempTable insertValues
 
 -- | Normalize a row by adding missing columns with @DEFAULT@ value and sort by
 -- column name to make sure all rows are consistent in column values and order.
@@ -58,16 +58,12 @@ fromInsert IR.AnnotatedInsert {..} =
 -- >   VALUES (1, 'Foo', 21), (2, 'Bar', DEFAULT)
 normalizeInsertRows ::
   HM.HashMap (Column 'MSSQL) Expression ->
-  [[(Column 'MSSQL, Expression)]] ->
-  [[(Column 'MSSQL, Expression)]]
+  [IR.AnnotatedInsertRow 'MSSQL Expression] ->
+  (HashSet (Column 'MSSQL), [HM.HashMap (Column 'MSSQL) Expression])
 normalizeInsertRows presets insertRows =
-  let insertColumns = nubOrd (concatMap (map fst) insertRows <> HM.keys presets)
-      allColumnsWithDefaultValue =
-        map (\col -> (col, fromMaybe DefaultExpression $ HM.lookup col presets)) insertColumns
-      addMissingColumns insertRow =
-        HM.toList $ HM.fromList insertRow `HM.union` HM.fromList allColumnsWithDefaultValue
-      sortByColumn = sortBy (\l r -> compare (fst l) (fst r))
-   in map (sortByColumn . addMissingColumns) insertRows
+  HM.homogenise
+    DefaultExpression
+    (map ((presets <>) . HM.fromList . IR.getInsertColumns) insertRows)
 
 -- | Construct a MERGE statement from AnnotatedInsert information.
 --   A MERGE statement is responsible for actually inserting and/or updating
@@ -79,8 +75,10 @@ toMerge ::
   IfMatched Expression ->
   FromIr Merge
 toMerge tableName insertRows allColumns IfMatched {..} = do
-  let normalizedInsertRows = normalizeInsertRows _imColumnPresets $ map IR.getInsertColumns insertRows
-      insertColumnNames = maybe [] (map fst) $ listToMaybe normalizedInsertRows
+  let insertColumnNames =
+        HS.toList $
+          HM.keysSet _imColumnPresets
+            <> HS.unions (map (HM.keysSet . HM.fromList . IR.getInsertColumns) insertRows)
       allColumnNames = map IR.ciColumn allColumns
 
   matchConditions <-
@@ -108,11 +106,10 @@ toMerge tableName insertRows allColumns IfMatched {..} = do
 toInsertValuesIntoTempTable :: TempTableName -> IR.AnnotatedInsert 'MSSQL Void Expression -> InsertValuesIntoTempTable
 toInsertValuesIntoTempTable tempTable IR.AnnotatedInsert {..} =
   let IR.AnnotatedInsertData {..} = _aiData
-      insertRows = normalizeInsertRows _aiDefaultValues $ map IR.getInsertColumns _aiInsertObject
-      insertColumnNames = maybe [] (map fst) $ listToMaybe insertRows
-      insertValues = map (Values . map snd) insertRows
+      (insertColumnNames, insertRows) = normalizeInsertRows _aiPresetValues _aiInsertObject
+      insertValues = map (Values . HM.elems) insertRows
    in InsertValuesIntoTempTable
         { ivittTempTableName = tempTable,
-          ivittColumns = insertColumnNames,
+          ivittColumns = HS.toList insertColumnNames,
           ivittValues = insertValues
         }

server/src-lib/Hasura/Backends/MSSQL/Instances/Schema.hs

@@ -71,9 +71,6 @@ instance BackendSchema 'MSSQL where
   computedField = msComputedField
   node = msNode
 
-  -- SQL literals
-  columnDefaultValue = msColumnDefaultValue
-
 ----------------------------------------------------------------
 
 -- * Top level parsers
@@ -474,12 +471,3 @@ msNode ::
         )
     )
 msNode = throw500 "MSSQL does not support relay; `node` should never be exposed in the schema."
-
-----------------------------------------------------------------
-
--- * SQL literals
-
--- FIXME: this is nonsensical for MSSQL, we'll need to adjust the corresponding mutation
--- and its representation.
-msColumnDefaultValue :: Column 'MSSQL -> SQLExpression 'MSSQL
-msColumnDefaultValue = const $ MSSQL.ValueExpression ODBC.NullValue

server/src-lib/Hasura/Backends/MySQL/Instances/Schema.hs

@@ -47,7 +47,6 @@ instance BackendSchema 'MySQL where
   aggregateOrderByCountType = error "aggregateOrderByCountType: MySQL backend does not support this operation yet."
   computedField = error "computedField: MySQL backend does not support this operation yet."
   node = error "node: MySQL backend does not support this operation yet."
-  columnDefaultValue = error "columnDefaultValue: MySQL backend does not support this operation yet."
 
 mysqlTableArgs ::
   forall r m n.

server/src-lib/Hasura/Backends/Postgres/Execute/Insert.hs

@@ -10,6 +10,7 @@ where
 
 import Data.Aeson qualified as J
 import Data.HashMap.Strict qualified as Map
+import Data.HashMap.Strict.Extended qualified as Map
 import Data.List qualified as L
 import Data.Sequence qualified as Seq
 import Data.Text qualified as T
@@ -55,7 +56,7 @@ convertToSQLTransaction (IR.AnnotatedInsert fieldName isSingle annIns mutationOu
     then pure $ IR.buildEmptyMutResp mutationOutput
     else
       withPaths ["selectionSet", fieldName, "args", suffix] $
-        insertMultipleObjects annIns [] userInfo mutationOutput planVars stringifyNum
+        insertMultipleObjects annIns mempty userInfo mutationOutput planVars stringifyNum
   where
     withPaths p x = foldr ($) x $ withPathK <$> p
     suffix = bool "objects" "object" isSingle
@@ -70,7 +71,7 @@ insertMultipleObjects ::
     MonadReader QueryTagsComment m
   ) =>
   IR.MultiObjectInsert ('Postgres pgKind) PG.SQLExp ->
-  [(PGCol, PG.SQLExp)] ->
+  Map.HashMap PGCol PG.SQLExp ->
   UserInfo ->
   IR.MutationOutput ('Postgres pgKind) ->
   Seq.Seq Q.PrepArg ->
@@ -79,21 +80,21 @@ insertMultipleObjects ::
 insertMultipleObjects multiObjIns additionalColumns userInfo mutationOutput planVars stringifyNum =
   bool withoutRelsInsert withRelsInsert anyRelsToInsert
   where
-    IR.AnnotatedInsertData insObjs table checkCondition columnInfos defVals (BackendInsert conflictClause) = multiObjIns
+    IR.AnnotatedInsertData insObjs table checkCondition columnInfos presetRow (BackendInsert conflictClause) = multiObjIns
     allInsObjRels = concatMap IR.getInsertObjectRelationships insObjs
     allInsArrRels = concatMap IR.getInsertArrayRelationships insObjs
     anyRelsToInsert = not $ null allInsArrRels && null allInsObjRels
 
     withoutRelsInsert = do
       indexedForM_ (IR.getInsertColumns <$> insObjs) \column ->
-        validateInsert (map fst column) [] (map fst additionalColumns)
-      let columnValues = map (mkSQLRow defVals) $ union additionalColumns . IR.getInsertColumns <$> insObjs
-          columnNames = Map.keys defVals
+        validateInsert (map fst column) [] (Map.keys additionalColumns)
+      let insObjRows = Map.fromList . IR.getInsertColumns <$> insObjs
+          (columnNames, insertRows) = Map.homogenise PG.columnDefaultValue $ map ((presetRow <> additionalColumns) <>) insObjRows
           insertQuery =
             IR.InsertQueryP1
               table
-              columnNames
-              columnValues
+              (toList columnNames)
+              (map Map.elems insertRows)
               conflictClause
               checkCondition
               mutationOutput
@@ -105,7 +106,7 @@ insertMultipleObjects multiObjIns additionalColumns userInfo mutationOutput plan
 
     withRelsInsert = do
       insertRequests <- indexedForM insObjs \obj -> do
-        let singleObj = IR.AnnotatedInsertData (IR.Single obj) table checkCondition columnInfos defVals (BackendInsert conflictClause)
+        let singleObj = IR.AnnotatedInsertData (IR.Single obj) table checkCondition columnInfos presetRow (BackendInsert conflictClause)
         insertObject singleObj additionalColumns userInfo planVars stringifyNum
       let affectedRows = sum $ map fst insertRequests
           columnValues = mapMaybe snd insertRequests
@@ -129,23 +130,23 @@ insertObject ::
     MonadReader QueryTagsComment m
   ) =>
   IR.SingleObjectInsert ('Postgres pgKind) PG.SQLExp ->
-  [(PGCol, PG.SQLExp)] ->
+  HashMap PGCol PG.SQLExp ->
   UserInfo ->
   Seq.Seq Q.PrepArg ->
   StringifyNumbers ->
   m (Int, Maybe (ColumnValues ('Postgres pgKind) TxtEncodedVal))
 insertObject singleObjIns additionalColumns userInfo planVars stringifyNum = Tracing.trace ("Insert " <> qualifiedObjectToText table) do
-  validateInsert (map fst columns) (map IR._riRelationInfo objectRels) (map fst additionalColumns)
+  validateInsert (Map.keys columns) (map IR._riRelationInfo objectRels) (Map.keys additionalColumns)
 
   -- insert all object relations and fetch this insert dependent column values
   objInsRes <- forM beforeInsert $ insertObjRel planVars userInfo stringifyNum
 
   -- prepare final insert columns
   let objRelAffRows = sum $ map fst objInsRes
-      objRelDeterminedCols = concatMap snd objInsRes
-      finalInsCols = columns <> objRelDeterminedCols <> additionalColumns
+      objRelDeterminedCols = Map.fromList $ concatMap snd objInsRes
+      finalInsCols = presetValues <> columns <> objRelDeterminedCols <> additionalColumns
 
-  let cte = mkInsertQ table onConflict finalInsCols defaultValues checkCond
+  let cte = mkInsertQ table onConflict finalInsCols checkCond
 
   PGE.MutateResp affRows colVals <-
     liftTx $
@@ -157,8 +158,8 @@ insertObject singleObjIns additionalColumns userInfo planVars stringifyNum = Tra
 
   return (totAffRows, colValM)
   where
-    IR.AnnotatedInsertData (IR.Single annObj) table checkCond allColumns defaultValues (BackendInsert onConflict) = singleObjIns
-    columns = IR.getInsertColumns annObj
+    IR.AnnotatedInsertData (IR.Single annObj) table checkCond allColumns presetValues (BackendInsert onConflict) = singleObjIns
+    columns = Map.fromList $ IR.getInsertColumns annObj
     objectRels = IR.getInsertObjectRelationships annObj
     arrayRels = IR.getInsertArrayRelationships annObj
 
@@ -220,7 +221,7 @@ insertObjRel ::
   m (Int, [(PGCol, PG.SQLExp)])
 insertObjRel planVars userInfo stringifyNum objRelIns =
   withPathK (relNameToTxt relName) $ do
-    (affRows, colValM) <- withPathK "data" $ insertObject singleObjIns [] userInfo planVars stringifyNum
+    (affRows, colValM) <- withPathK "data" $ insertObject singleObjIns mempty userInfo planVars stringifyNum
     colVal <- onNothing colValM $ throw400 NotSupported errMsg
     retColsWithVals <- fetchFromColVals colVal rColInfos
     let columns = flip mapMaybe (Map.toList mapCols) \(column, target) -> do
@@ -256,9 +257,10 @@ insertArrRel ::
   m Int
 insertArrRel resCols userInfo planVars stringifyNum arrRelIns =
   withPathK (relNameToTxt $ riName relInfo) $ do
-    let additionalColumns = flip mapMaybe resCols \(column, value) -> do
-          target <- Map.lookup column mapping
-          Just (target, value)
+    let additionalColumns = Map.fromList $
+          flip mapMaybe resCols \(column, value) -> do
+            target <- Map.lookup column mapping
+            Just (target, value)
     resBS <-
       withPathK "data" $
         insertMultipleObjects multiObjIns additionalColumns userInfo mutOutput planVars stringifyNum
@@ -270,8 +272,12 @@ insertArrRel resCols userInfo planVars stringifyNum arrRelIns =
     mapping = riMapping relInfo
     mutOutput = IR.MOutMultirowFields [("affected_rows", IR.MCount)]
 
--- | validate an insert object based on insert columns,
--- | insert object relations and additional columns from parent
+-- | Validate an insert object based on insert columns,
+-- insert object relations and additional columns from parent:
+--
+-- * There should be no overlap between 'insCols' and 'addCols'.
+-- * There should be no overlap between any object relationship columns and
+--   'insCols' and 'addCols'.
 validateInsert ::
   (MonadError QErr m) =>
   -- | inserting columns
@@ -307,15 +313,14 @@ mkInsertQ ::
   Backend ('Postgres pgKind) =>
   QualifiedTable ->
   Maybe (IR.OnConflictClause ('Postgres pgKind) PG.SQLExp) ->
-  [(PGCol, PG.SQLExp)] ->
   Map.HashMap PGCol PG.SQLExp ->
   (AnnBoolExpSQL ('Postgres pgKind), Maybe (AnnBoolExpSQL ('Postgres pgKind))) ->
   PG.CTE
-mkInsertQ table onConflictM insCols defVals (insCheck, updCheck) =
+mkInsertQ table onConflictM insertRow (insCheck, updCheck) =
   let sqlConflict = PGT.toSQLConflict table <$> onConflictM
-      sqlExps = mkSQLRow defVals insCols
+      sqlExps = Map.elems insertRow
       valueExp = PG.ValuesExp [PG.TupleExp sqlExps]
-      tableCols = Map.keys defVals
+      tableCols = Map.keys insertRow
       sqlInsert =
         PG.SQLInsert table tableCols valueExp sqlConflict
           . Just
@@ -347,13 +352,6 @@ fetchFromColVals colVal reqCols =
           TELit t -> PG.SELit t
     return (ciColumn ci, pgColVal)
 
-mkSQLRow :: Map.HashMap PGCol PG.SQLExp -> [(PGCol, PG.SQLExp)] -> [PG.SQLExp]
-mkSQLRow defVals withPGCol = map snd $
-  flip map (Map.toList defVals) $
-    \(col, defVal) -> (col,) $ fromMaybe defVal $ Map.lookup col withPGColMap
-  where
-    withPGColMap = Map.fromList withPGCol
-
 decodeEncJSON :: (J.FromJSON a, QErrM m) => EncJSON -> m a
 decodeEncJSON =
   either (throw500 . T.pack) decodeValue

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

@@ -160,9 +160,6 @@ instance
   computedField = computedFieldPG
   node = pgkNode
 
-  -- SQL literals
-  columnDefaultValue = const PG.columnDefaultValue
-
 backendInsertParser ::
   forall pgKind m r n.
   MonadBuildSchema ('Postgres pgKind) r m n =>

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

@@ -225,9 +225,6 @@ class
     MonadBuildSchema b r m n =>
     m (Parser 'Output n (HashMap (TableName b) (SourceName, SourceConfig b, SelPermInfo b, PrimaryKeyColumns b, AnnotatedFields b)))
 
-  -- SQL literals
-  columnDefaultValue :: Column b -> SQLExpression b
-
 type ComparisonExp b = OpExpG b (UnpreparedValue b)
 
 -- $modelling

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

@@ -311,22 +311,15 @@ mkInsertObject objects tableInfo backendInsert insertPerms updatePerms =
       _aiTableName = table,
       _aiCheckCondition = (insertCheck, updateCheck),
       _aiTableColumns = columns,
-      _aiDefaultValues = defaultValues,
+      _aiPresetValues = presetValues,
       _aiBackendInsert = backendInsert
     }
   where
     table = tableInfoName tableInfo
     columns = tableColumns tableInfo
     insertCheck = fmap partialSQLExpToUnpreparedValue <$> ipiCheck insertPerms
     updateCheck = (fmap . fmap . fmap) partialSQLExpToUnpreparedValue $ upiCheck =<< updatePerms
-    defaultValues =
-      Map.union (partialSQLExpToUnpreparedValue <$> ipiSet insertPerms) $
-        Map.fromList
-          [ (column, UVLiteral $ columnDefaultValue @b column)
-            | ci <- columns,
-              _cmIsInsertable (ciMutability ci),
-              let column = ciColumn ci
-          ]
+    presetValues = partialSQLExpToUnpreparedValue <$> ipiSet insertPerms
 
 -- delete
 

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

@@ -72,7 +72,7 @@ data AnnotatedInsertData (b :: BackendType) (f :: Type -> Type) (v :: Type) = An
     _aiTableName :: TableName b,
     _aiCheckCondition :: (AnnBoolExp b v, Maybe (AnnBoolExp b v)),
     _aiTableColumns :: [ColumnInfo b],
-    _aiDefaultValues :: PreSetColsG b v,
+    _aiPresetValues :: PreSetColsG b v,
     _aiBackendInsert :: BackendInsert b v
   }
   deriving (Functor, Foldable, Traversable)