server/nada: test mkUpdateCTE

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5341
GitOrigin-RevId: 39db14cc2d2329d8cadb7a6080b1e2361eba1fb5

server/graphql-engine.cabal

@@ -943,6 +943,7 @@ test-suite graphql-engine-tests
     , http-client
     , http-client-tls
     , http-types
+    , HUnit
     , immortal
     , insert-ordered-containers
     , jose
@@ -1035,6 +1036,7 @@ test-suite graphql-engine-tests
     Hasura.Backends.Postgres.SQL.EDSL
     Hasura.Backends.Postgres.SQL.Select.RenameIdentifiersSpec
     Hasura.Backends.Postgres.SQL.ValueSpec
+    Hasura.Backends.Postgres.Translate.UpdateSpec
     Hasura.EventingSpec
     Hasura.Generator.Common
     Hasura.GraphQL.NamespaceSpec
@@ -1066,11 +1068,13 @@ test-suite graphql-engine-tests
     Hasura.StreamingSubscriptionSuite
     Network.HTTP.Client.TransformableSpec
     Test.Aeson.Utils
+    Test.Backend.Postgres.Update
     Test.Parser.Expectation
     Test.Parser.Field
     Test.Parser.Internal
     Test.Parser.Monad
     Test.QuickCheck.Extended
+    Test.SIString
 
 test-suite tests-hspec
   import: common-all, lib-depends
@@ -1211,7 +1215,6 @@ test-suite tests-hspec
 
  -- Harness.Quoter
     Harness.Quoter.Graphql
-    Harness.Quoter.Sql
     Harness.Quoter.Yaml
     Harness.Quoter.Yaml.InterpolateYaml
 

server/src-lib/Hasura/Backends/Postgres/Translate/Update.hs

@@ -48,6 +48,7 @@ mkUpdateCTE (AnnotatedUpdateG tn (permFltr, wc) chk backendUpdate _ columnsInfo
               upWhere =
                 Just
                   . S.WhereFrag
+                  . S.simplifyBoolExp
                   . toSQLBoolExp (S.QualTable tn)
                   $ andAnnBoolExps permFltr wc,
               upRet =
@@ -71,7 +72,10 @@ mkUpdateCTE (AnnotatedUpdateG tn (permFltr, wc) chk backendUpdate _ columnsInfo
                   S.SetExp $ map (expandOperator columnsInfo) (Map.toList mruExpression),
                 upFrom = Nothing,
                 upWhere =
-                  Just . S.WhereFrag $ toSQLBoolExp (S.QualTable tn) mruWhere,
+                  Just
+                    . S.WhereFrag
+                    . S.simplifyBoolExp
+                    $ toSQLBoolExp (S.QualTable tn) mruWhere,
                 upRet =
                   Just $
                     S.RetExp

server/src-test/Hasura/Backends/Postgres/Translate/UpdateSpec.hs

@@ -0,0 +1,181 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Hasura.Backends.Postgres.Translate.UpdateSpec
+  ( spec,
+  )
+where
+
+import Database.PG.Query.Pool qualified as QQ
+import Hasura.Backends.Postgres.SQL.Types (PGScalarType (..))
+import Hasura.Backends.Postgres.SQL.Value (PGScalarValue (..))
+import Hasura.Backends.Postgres.Types.Update (UpdateOpExpression (..))
+import Hasura.Prelude
+import Hasura.RQL.IR.BoolExp (OpExpG (..))
+import Hasura.RQL.IR.Returning (MutFldG (..), MutationOutputG (..))
+import Hasura.RQL.IR.Value (UnpreparedValue (..))
+import Hasura.RQL.Types.Column (ColumnInfo, ColumnType (..), ColumnValue (..))
+import Hasura.SQL.Backend (BackendType (Postgres), PostgresKind (Vanilla))
+import Test.Backend.Postgres.Update qualified as Test
+import Test.Hspec
+import Test.Parser.Expectation qualified as Expect
+
+type PG = 'Postgres 'Vanilla
+
+spec :: Spec
+spec =
+  describe "Postgres.Translate.UpdateSpec" do
+    Test.runTest
+      Test.TestBuilder
+        { name = "set field where id",
+          table = Expect.mkTable "test",
+          columns = [idColumn, nameColumn],
+          output = MOutMultirowFields [("affected_rows", MCount)],
+          where_ = [(idColumn, [AEQ True integerOne])],
+          update = Expect.UpdateTable [(nameColumn, UpdateSet newValue)],
+          expected =
+            [QQ.sql|
+UPDATE "public"."test"
+  SET "name" = $1
+  WHERE
+    (("public"."test"."id") = ($0))
+  RETURNING * , ('true')::boolean AS "check__constraint"
+              |]
+        }
+
+    Test.runTest
+      Test.TestBuilder
+        { name = "set multiple field where id",
+          table = Expect.mkTable "test",
+          columns = [idColumn, nameColumn, descColumn],
+          output = MOutMultirowFields [("affected_rows", MCount)],
+          where_ = [(idColumn, [AEQ True integerOne])],
+          update = Expect.UpdateTable [(nameColumn, UpdateSet newValue), (descColumn, UpdateSet newValue)],
+          expected =
+            [QQ.sql|
+UPDATE "public"."test"
+  SET "name" = $1, "description" = $2
+  WHERE
+    (("public"."test"."id") = ($0))
+  RETURNING * , ('true')::boolean AS "check__constraint"
+              |]
+        }
+
+    Test.runTest
+      Test.TestBuilder
+        { name = "set field where id and old value",
+          table = Expect.mkTable "test",
+          columns = [idColumn, nameColumn, descColumn],
+          output = MOutMultirowFields [("affected_rows", MCount)],
+          where_ = [(idColumn, [AEQ True integerOne]), (nameColumn, [AEQ False oldValue])],
+          update = Expect.UpdateTable [(nameColumn, UpdateSet newValue)],
+          expected =
+            [QQ.sql|
+UPDATE "public"."test"
+  SET "name" = $2
+  WHERE
+    ((("public"."test"."id") = ($0))
+      AND
+     ((("public"."test"."name") = ($1))
+       OR
+      ((("public"."test"."name") IS NULL)
+        AND (($1) IS NULL))
+      ))
+  RETURNING * , ('true')::boolean AS "check__constraint"
+              |]
+        }
+
+    Test.runMultipleUpdates
+      Test.TestBuilder
+        { name = "update_many with two updates",
+          table = Expect.mkTable "test",
+          columns = [idColumn, nameColumn, descColumn],
+          output = MOutMultirowFields [("affected_rows", MCount)],
+          where_ = [],
+          update =
+            Expect.UpdateMany $
+              [ Expect.MultiRowUpdateBuilder
+                  { mrubWhere = [(idColumn, [AEQ True integerOne]), (nameColumn, [AEQ False oldValue])],
+                    mrubUpdate = [(nameColumn, UpdateSet newValue)]
+                  },
+                Expect.MultiRowUpdateBuilder
+                  { mrubWhere = [(idColumn, [AEQ True integerOne])],
+                    mrubUpdate = [(descColumn, UpdateSet oldValue)]
+                  }
+              ],
+          expected =
+            [ [QQ.sql|
+UPDATE "public"."test"
+  SET "name" = $2
+  WHERE
+    ((("public"."test"."id") = ($0))
+      AND
+     ((("public"."test"."name") = ($1))
+       OR
+      ((("public"."test"."name") IS NULL)
+        AND (($1) IS NULL))
+      ))
+  RETURNING * , ('true')::boolean AS "check__constraint"
+              |],
+              [QQ.sql|
+UPDATE "public"."test"
+  SET "description" = $4
+  WHERE
+    (("public"."test"."id") = ($3))
+  RETURNING * , ('true')::boolean AS "check__constraint"
+              |]
+            ]
+        }
+
+idColumn :: ColumnInfo PG
+idColumn =
+  Expect.mkColumnInfo
+    Expect.ColumnInfoBuilder
+      { cibName = "id",
+        cibType = ColumnScalar PGInteger,
+        cibNullable = False,
+        cibIsPrimaryKey = True
+      }
+
+nameColumn :: ColumnInfo PG
+nameColumn =
+  Expect.mkColumnInfo
+    Expect.ColumnInfoBuilder
+      { cibName = "name",
+        cibType = ColumnScalar PGText,
+        cibNullable = False,
+        cibIsPrimaryKey = False
+      }
+
+descColumn :: ColumnInfo PG
+descColumn =
+  Expect.mkColumnInfo
+    Expect.ColumnInfoBuilder
+      { cibName = "description",
+        cibType = ColumnScalar PGText,
+        cibNullable = False,
+        cibIsPrimaryKey = False
+      }
+
+integerOne :: UnpreparedValue PG
+integerOne =
+  UVParameter Nothing $
+    ColumnValue
+      { cvType = ColumnScalar PGInteger,
+        cvValue = PGValInteger 1
+      }
+
+newValue :: UnpreparedValue PG
+newValue =
+  UVParameter Nothing $
+    ColumnValue
+      { cvType = ColumnScalar PGText,
+        cvValue = PGValText "new name"
+      }
+
+oldValue :: UnpreparedValue PG
+oldValue =
+  UVParameter Nothing $
+    ColumnValue
+      { cvType = ColumnScalar PGText,
+        cvValue = PGValText "old name"
+      }

server/src-test/Test/Backend/Postgres/Update.hs

@@ -0,0 +1,104 @@
+-- | Test Backend Postgres Update
+--
+-- Helpers to build 'Hasura.RQL.IR.Update.AnnotatedUpdateG' and test the results
+-- of running 'Hasura.Backends.Postgres.Translate.Update.mkUpdateCTE' as raw
+-- SQL.
+--
+-- See 'Hasura.Backends.Postgres.Translate.UpdateSpec.spec' for usage examples.
+module Test.Backend.Postgres.Update
+  ( TestBuilder (..),
+    runTest,
+    runMultipleUpdates,
+  )
+where
+
+import Hasura.Backends.Postgres.SQL.DML qualified as S
+import Hasura.Backends.Postgres.SQL.Types (QualifiedTable)
+import Hasura.Backends.Postgres.Translate.Update qualified as Update
+import Hasura.Prelude
+import Hasura.RQL.IR.BoolExp (OpExpG (..))
+import Hasura.RQL.IR.Returning (MutationOutputG (..))
+import Hasura.RQL.IR.Value (UnpreparedValue (..))
+import Hasura.RQL.Types.Column (ColumnInfo)
+import Hasura.SQL.Backend (BackendType (Postgres), PostgresKind (Vanilla))
+import Hasura.SQL.Types (toSQLTxt)
+import Test.HUnit.Base (assertFailure)
+import Test.Hspec
+import Test.Parser.Expectation qualified as Expect
+import Test.SIString qualified as SI
+
+type PG = 'Postgres 'Vanilla
+
+-- | Describes a /mkUpdateCTE/ test.
+data TestBuilder e = TestBuilder
+  { -- | test name
+    name :: String,
+    -- | table details
+    table :: QualifiedTable,
+    -- | table columnd
+    columns :: [ColumnInfo PG],
+    -- | expected output fields
+    output :: MutationOutputG PG Void (UnpreparedValue PG),
+    -- | where clause for the query (usually empty for /update_many/)
+    where_ :: [(ColumnInfo PG, [OpExpG PG (UnpreparedValue PG)])],
+    -- | update clause
+    update :: Expect.BackendUpdateBuilder (ColumnInfo PG),
+    -- | expected result; this is either 'Text' or '[Text]'
+    expected :: e
+  }
+
+-- | Runs a test for single updates.
+runTest :: TestBuilder Text -> Spec
+runTest TestBuilder {..} =
+  it name do
+    let upd =
+          (`evalState` 0) $
+            traverse go $
+              Expect.mkAnnotatedUpdate @Void
+                Expect.AnnotatedUpdateBuilder
+                  { Expect.aubTable = table,
+                    Expect.aubOutput = output,
+                    Expect.aubColumns = columns,
+                    Expect.aubWhere = where_,
+                    Expect.aubUpdate = update
+                  }
+    case Update.mkUpdateCTE @'Vanilla upd of
+      (Update.Update cte) -> (SI.fromText $ toSQLTxt cte) `shouldBe` SI.fromText expected
+      _ -> assertFailure "expected single update, got multiple updates"
+  where
+    go :: UnpreparedValue PG -> State Int S.SQLExp
+    go = \case
+      UVLiteral sqlExp -> pure sqlExp
+      UVParameter _varInfo _cval -> do
+        index <- get
+        modify (+ 1)
+        pure $ S.SEPrep index
+      _ -> error "unexpected value"
+
+-- | Runs a test for /update_many/
+runMultipleUpdates :: TestBuilder [Text] -> Spec
+runMultipleUpdates TestBuilder {..} =
+  it name do
+    let upd =
+          (`evalState` 0) $
+            traverse go $
+              Expect.mkAnnotatedUpdate @Void
+                Expect.AnnotatedUpdateBuilder
+                  { Expect.aubTable = table,
+                    Expect.aubOutput = output,
+                    Expect.aubColumns = columns,
+                    Expect.aubWhere = where_,
+                    Expect.aubUpdate = update
+                  }
+    case Update.mkUpdateCTE @'Vanilla upd of
+      (Update.MultiUpdate ctes) -> SI.fromText . toSQLTxt <$> ctes `shouldBe` SI.fromText <$> expected
+      _ -> assertFailure "expedted update_many, got single update"
+  where
+    go :: UnpreparedValue PG -> State Int S.SQLExp
+    go = \case
+      UVLiteral sqlExp -> pure sqlExp
+      UVParameter _varInfo _cval -> do
+        index <- get
+        modify (+ 1)
+        pure $ S.SEPrep index
+      _ -> error "unexpected value"

server/src-test/Test/Parser/Expectation.hs

@@ -9,6 +9,8 @@ module Test.Parser.Expectation
     MultiRowUpdateBuilder (..),
     runUpdateFieldTest,
     module I,
+    AnnotatedUpdateBuilder (..),
+    mkAnnotatedUpdate,
   )
 where
 
@@ -32,14 +34,14 @@ import Hasura.SQL.Backend (BackendType (Postgres), PostgresKind (Vanilla))
 import Language.GraphQL.Draft.Syntax qualified as Syntax
 import Test.Hspec
 import Test.Parser.Internal
-import Test.Parser.Internal as I (ColumnInfoBuilder (..))
+import Test.Parser.Internal as I (ColumnInfoBuilder (..), mkColumnInfo, mkTable)
 import Test.Parser.Monad
 
 type PG = 'Postgres 'Vanilla
 
 type BoolExp = GBoolExp PG (AnnBoolExpFld PG (UnpreparedValue PG))
 
-type Output = MutationOutputG PG (RemoteRelationshipFieldWrapper UnpreparedValue) (UnpreparedValue PG)
+type Output r = MutationOutputG PG r (UnpreparedValue PG)
 
 type Field = Syntax.Field Syntax.NoFragments Variable
 
@@ -65,7 +67,7 @@ data UpdateExpectationBuilder = UpdateExpectationBuilder
   { -- | build the expected selection set/output, e.g.
     --
     -- > MOutMultirowFields [("affected_rows", MCount)]
-    utbOutput :: Output,
+    utbOutput :: Output (RemoteRelationshipFieldWrapper UnpreparedValue),
     -- | expected where condition(s), e.g. given a @nameColumn ::
     -- ColumnInfoBuilder@ and @oldValue :: UnpreparedValue PG@:
     --
@@ -116,11 +118,11 @@ runUpdateFieldTest UpdateTestSetup {..} =
 -- | Internal use only. The intended use is through 'runUpdateFieldTest'.
 --
 -- Build an 'AnnotatedUpdateG', to be used with 'mkAnnotatedUpdate'.
-data AnnotatedUpdateBuilder = AnnotatedUpdateBuilder
+data AnnotatedUpdateBuilder r = AnnotatedUpdateBuilder
   { -- | the main table for the update
     aubTable :: QualifiedTable,
     -- | the 'Output' clause, e.g., selection set, affected_rows, etc.
-    aubOutput :: Output,
+    aubOutput :: Output r,
     -- | the table columns (all of them)
     aubColumns :: [ColumnInfo PG],
     -- | the where clause(s)
@@ -154,8 +156,9 @@ instance Eq (RemoteRelationshipFieldWrapper vf) where
 
 -- | Internal use, see 'runUpdateFieldTest'.
 mkAnnotatedUpdate ::
-  AnnotatedUpdateBuilder ->
-  AnnotatedUpdateG PG (RemoteRelationshipFieldWrapper UnpreparedValue) (UnpreparedValue PG)
+  forall r.
+  AnnotatedUpdateBuilder r ->
+  AnnotatedUpdateG PG r (UnpreparedValue PG)
 mkAnnotatedUpdate AnnotatedUpdateBuilder {..} = AnnotatedUpdateG {..}
   where
     toBoolExp :: [(ColumnInfo PG, [OpExpG PG (UnpreparedValue PG)])] -> BoolExp
@@ -187,7 +190,7 @@ mkAnnotatedUpdate AnnotatedUpdateBuilder {..} = AnnotatedUpdateG {..}
           mruExpression = HM.fromList $ fmap (bimap ciColumn id) mrubUpdate
         }
 
-    _auOutput :: Output
+    _auOutput :: Output r
     _auOutput = aubOutput
 
     _auAllCols :: [ColumnInfo PG]

server/src-test/Test/SIString.hs

@@ -0,0 +1,22 @@
+-- | Space Insensitive String.
+--
+-- Used for things like comparing SQL strings where one of them might be
+-- formatted differently for easier reading.
+module Test.SIString
+  ( SIString (..),
+    fromText,
+  )
+where
+
+import Data.Char (isSpace)
+import Data.Text qualified as T
+import Hasura.Prelude
+
+newtype SIString = SIString {getSIString :: String}
+  deriving newtype (Show)
+
+fromText :: Text -> SIString
+fromText = SIString . T.unpack
+
+instance Eq SIString where
+  (==) = (==) `on` filter (not . isSpace) . getSIString

server/tests-hspec/Harness/Quoter/Sql.hs

@@ -1,17 +0,0 @@
--- | Simple SQL quasi quoter. Even if this doesn't do anything, it's
--- still useful. Some editors (Emacs) display [sql| ...|] with SQL
--- syntax highlighting.
-module Harness.Quoter.Sql (sql) where
-
-import Hasura.Prelude
-import Language.Haskell.TH
-import Language.Haskell.TH.Quote
-
-sql :: QuasiQuoter
-sql =
-  QuasiQuoter
-    { quoteExp = stringE,
-      quotePat = \_ -> fail "invalid",
-      quoteType = \_ -> fail "invalid",
-      quoteDec = \_ -> fail "invalid"
-    }

server/tests-hspec/Test/SQLServer/InsertVarcharColumnSpec.hs

@@ -4,10 +4,10 @@
 module Test.SQLServer.InsertVarcharColumnSpec (spec) where
 
 import Data.List.NonEmpty qualified as NE
+import Database.PG.Query.Pool (sql)
 import Harness.Backend.Sqlserver qualified as Sqlserver
 import Harness.GraphqlEngine qualified as GraphqlEngine
 import Harness.Quoter.Graphql (graphql)
-import Harness.Quoter.Sql (sql)
 import Harness.Quoter.Yaml (yaml)
 import Harness.Test.Context qualified as Context
 import Harness.TestEnvironment (TestEnvironment)

server/tests-hspec/Test/ViewsSpec.hs

@@ -4,10 +4,10 @@
 module Test.ViewsSpec (spec) where
 
 import Data.List.NonEmpty qualified as NE
+import Database.PG.Query.Pool (sql)
 import Harness.Backend.Mysql as Mysql
 import Harness.GraphqlEngine qualified as GraphqlEngine
 import Harness.Quoter.Graphql
-import Harness.Quoter.Sql
 import Harness.Quoter.Yaml
 import Harness.Test.Context qualified as Context
 import Harness.Test.Schema (Table (..), table)