server/postgres: fix string literals in arrays

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5634
GitOrigin-RevId: 67970b0c0f10c187c1a4b97d457717e14fdbd2c8

server/graphql-engine.cabal

@@ -1291,6 +1291,7 @@ test-suite tests-hspec
     Test.Queries.Simple.PrimaryKeySpec
     Test.Queries.SortSpec
     Test.Quoter.YamlSpec
+    Test.Regression.ArrayLiteralTextEncodingSpec
     Test.Regression.DoNotTruncateSessionVariables8158Spec
     Test.Regression.DropColumnWithPermissions8415Spec
     Test.Regression.InsertOnConflict8260Spec

server/src-lib/Hasura/Backends/Postgres/SQL/Value.hs

@@ -316,8 +316,18 @@ txtEncoder colVal = case txtEncodedVal colVal of
 -- https://github.com/hasura/graphql-engine-mono/issues/4892
 buildArrayLiteral :: [PGScalarValue] -> Text
 buildArrayLiteral ts =
-  T.concat ["{", T.intercalate "," (map (inner . txtEncodedVal) ts), "}"]
+  T.concat ["{", T.intercalate "," (map (inner . encodeElement) ts), "}"]
   where
+    -- Make sure to wrap text values in quotes, and escape unique characters
+    encodeElement = \case
+      PGValChar t -> TELit $ tshow $ T.singleton t
+      PGValVarchar t -> TELit $ tshow t
+      PGValText t -> TELit $ tshow t
+      PGValCitext t -> TELit $ tshow t
+      PGValLquery t -> TELit $ tshow t
+      PGValLtxtquery t -> TELit $ tshow t
+      PGValUnknown t -> TELit $ tshow t
+      other -> txtEncodedVal other
     inner = \case
       TENull -> "null"
       TELit t -> t

server/src-test/Hasura/Backends/Postgres/SQL/ValueSpec.hs

@@ -1,8 +1,11 @@
+{-# LANGUAGE QuasiQuotes #-}
+
 module Hasura.Backends.Postgres.SQL.ValueSpec (spec) where
 
+import Data.Text.RawString (raw)
 import Hasura.Backends.Postgres.SQL.DML
 import Hasura.Backends.Postgres.SQL.Types
-import Hasura.Backends.Postgres.SQL.Value
+import Hasura.Backends.Postgres.SQL.Value (PGScalarValue (..), parsePGValue, pgScalarValueToJson, txtEncoder)
 import Hasura.Base.Error (Code (ParseFailed), QErr (..), runAesonParser)
 import Hasura.Base.Error.TestInstances ()
 import Hasura.Prelude
@@ -14,9 +17,10 @@ spec = do
   txtEncoderSpec
   jsonValueSpec
 
-singleElement, multiElement, nestedArray, nestedArray', malformedArray :: PGScalarValue
+singleElement, multiElement, edgeCaseStrings, nestedArray, nestedArray', malformedArray :: PGScalarValue
 singleElement = PGValArray [PGValInteger 1]
 multiElement = PGValArray [PGValVarchar "a", PGValVarchar "b"]
+edgeCaseStrings = PGValArray $ map PGValVarchar ["a", "", [raw|"|], [raw|\|], [raw|,|], [raw|}|]]
 nestedArray = PGValArray [multiElement, multiElement]
 nestedArray' = PGValArray [nestedArray]
 malformedArray = PGValArray [PGValInteger 1]
@@ -25,13 +29,15 @@ txtEncoderSpec :: Spec
 txtEncoderSpec =
   describe "txtEncoder should encode a valid Postgres array of:" $ do
     it "a single element" $ do
-      txtEncoder singleElement `shouldBe` SELit "{1}"
+      txtEncoder singleElement `shouldBe` SELit [raw|{1}|]
     it "multiple elements" $ do
-      txtEncoder multiElement `shouldBe` SELit "{a,b}"
+      txtEncoder multiElement `shouldBe` SELit [raw|{"a","b"}|]
     it "simple nested arrays" $ do
-      txtEncoder nestedArray `shouldBe` SELit "{{a,b},{a,b}}"
+      txtEncoder nestedArray `shouldBe` SELit [raw|{{"a","b"},{"a","b"}}|]
     it "more deeply nested arrays" $ do
-      txtEncoder nestedArray' `shouldBe` SELit "{{{a,b},{a,b}}}"
+      txtEncoder nestedArray' `shouldBe` SELit [raw|{{{"a","b"},{"a","b"}}}|]
+    it "edge case strings" $ do
+      txtEncoder edgeCaseStrings `shouldBe` SELit [raw|{"a","","\"","\\",",","}"}|]
 
 pgArrayRoundtrip :: PGScalarValue -> PGScalarType -> Expectation
 pgArrayRoundtrip v t = do

server/tests-hspec/Test/Regression/ArrayLiteralTextEncodingSpec.hs

@@ -0,0 +1,121 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+-- | Testing the encoding of array literals
+module Test.Regression.ArrayLiteralTextEncodingSpec (spec) where
+
+import Data.Aeson (Value)
+import Data.List.NonEmpty qualified as NE
+import Harness.Backend.Postgres qualified as Postgres
+import Harness.GraphqlEngine (postGraphql)
+import Harness.Quoter.Graphql
+import Harness.Quoter.Yaml
+import Harness.Test.Fixture qualified as Fixture
+import Harness.Test.Schema (Table (..), table)
+import Harness.Test.Schema qualified as Schema
+import Harness.TestEnvironment (TestEnvironment)
+import Harness.Yaml (shouldReturnYaml)
+import Hasura.Prelude
+import Test.Hspec (SpecWith, it)
+
+spec :: SpecWith TestEnvironment
+spec =
+  Fixture.run
+    ( NE.fromList
+        [ (Fixture.fixture $ Fixture.Backend Fixture.Postgres)
+            { Fixture.setupTeardown = \(testEnvironment, _) ->
+                [ Postgres.setupTablesAction schema testEnvironment
+                ]
+            }
+        ]
+    )
+    tests
+
+--------------------------------------------------------------------------------
+-- Schema
+
+schema :: [Schema.Table]
+schema =
+  [ (table "table")
+      { tableColumns =
+          [ Schema.column "id" Schema.TInt,
+            Schema.column "str" Schema.TStr
+          ],
+        tablePrimaryKey = ["id"],
+        tableData =
+          [ [Schema.VInt 1, Schema.VStr "a,b"],
+            [Schema.VInt 2, Schema.VStr "a,"],
+            [Schema.VInt 3, Schema.VStr ""],
+            [Schema.VInt 4, Schema.VStr ","],
+            [Schema.VInt 5, Schema.VStr "\\"],
+            [Schema.VInt 6, Schema.VStr "\""],
+            [Schema.VInt 7, Schema.VStr "&"],
+            [Schema.VInt 8, Schema.VStr "c"]
+          ]
+      }
+  ]
+
+--------------------------------------------------------------------------------
+-- Tests
+
+tests :: Fixture.Options -> SpecWith TestEnvironment
+tests opts = do
+  let shouldBe :: IO Value -> Value -> IO ()
+      shouldBe = shouldReturnYaml opts
+
+  it "Query is a,b or c" \testEnvironment -> do
+    let expected :: Value
+        expected =
+          [yaml|
+            data:
+              hasura_table:
+              - id: 1
+                str: a,b
+              - id: 8
+                str: c
+          |]
+
+        actual :: IO Value
+        actual =
+          postGraphql
+            testEnvironment
+            [graphql|
+                query {
+                  hasura_table(where: {str: {_in: ["a,b", "c"]}}, order_by: { id: asc }) {
+                    id
+                    str
+                  }
+                }
+              |]
+
+    actual `shouldBe` expected
+
+  it "Query is not a, empty, comma, or quote" \testEnvironment -> do
+    let expected :: Value
+        expected =
+          [yaml|
+            data:
+              hasura_table:
+              - id: 1
+                str: a,b
+              - id: 5
+                str: \
+              - id: 7
+                str: '&'
+              - id: 8
+                str: c
+          |]
+
+        actual :: IO Value
+        actual =
+          postGraphql
+            testEnvironment
+            [graphql|
+                query {
+                  hasura_table(where: {str: {_nin: ["a,", "", ",", "\""]}}, order_by: { id: asc }) {
+                    id
+                    str
+                  }
+                }
+              |]
+
+    actual `shouldBe` expected