Data Connectors: Support using array literals in permission checks

[GDC-868]: https://hasurahq.atlassian.net/browse/GDC-868?atlOrigin=eyJpIjoiNWRkNTljNzYxNjVmNDY3MDlhMDU5Y2ZhYzA5YTRkZjUiLCJwIjoiZ2l0aHViLWNvbS1KU1cifQ

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/9238
GitOrigin-RevId: 93593f79a4a6a92eec1d0dc10fd8e5bb21bd123e

dc-agents/sqlite/src/mutation.ts

@@ -242,7 +242,7 @@ async function deleteRows(db: Connection, relationships: Array<TableRelationship
 
 function postMutationCheckError(op: MutationOperation, failed: Array<Row>): ErrorWithStatusCode {
   return ErrorWithStatusCode.mutationPermissionCheckFailure(
-    `Post-Insert checks failed with ${failed.length} ${failed.length > 1 ? 'errors' : 'error'}: ${JSON.stringify(failed)}`,
+    "check constraint of an insert/update permission has failed",
     {op: op, results: failed}
   );
 }

server/lib/api-tests/src/Test/DataConnector/MockAgent/ErrorSpec.hs

@@ -50,11 +50,14 @@ sourceMetadata =
               custom_root_fields:
                 select: albums
                 select_by_pk: albums_by_pk
+                insert: insert_albums
               column_config:
                 AlbumId:
                   custom_name: id
                 Title:
                   custom_name: title
+                ArtistId:
+                  custom_name: artist_id
         configuration: {}
       |]
 
@@ -62,7 +65,7 @@ sourceMetadata =
 
 tests :: SpecWith (TestEnvironment, Mock.MockAgentEnvironment)
 tests = describe "Error Protocol Tests" $ do
-  mockAgentGraphqlTest "handles returned errors correctly" $ \_testEnv performGraphqlRequest -> do
+  mockAgentGraphqlTest "handles returned UncaughtError errors correctly" $ \_testEnv performGraphqlRequest -> do
     let headers = []
     let graphqlRequest =
           [graphql|
@@ -73,7 +76,7 @@ tests = describe "Error Protocol Tests" $ do
               }
             }
           |]
-    let errorResponse = API.ErrorResponse API.UncaughtError "Hello World!" [yaml| { foo: "bar" } |]
+    let errorResponse = API.ErrorResponse API.UncaughtError "An unhandled error occurred" [yaml| { foo: "bar" } |]
     let mockConfig = Mock.defaultMockRequestConfig {Mock._queryResponse = \_ -> Left errorResponse}
 
     MockRequestResults {..} <- performGraphqlRequest mockConfig headers graphqlRequest
@@ -81,13 +84,12 @@ tests = describe "Error Protocol Tests" $ do
     _mrrResponse
       `shouldBeYaml` [yaml|
         errors:
-          -
-            extensions:
+          - extensions:
               code: "data-connector-error"
               path: "$"
               internal:
                 foo: "bar"
-            message: "UncaughtError: Hello World!"
+            message: "An unhandled error occurred"
       |]
 
     _mrrRecordedRequest
@@ -104,3 +106,59 @@ tests = describe "Error Protocol Tests" $ do
                   & API.qLimit ?~ 1
               )
         )
+
+  mockAgentGraphqlTest "handles returned MutationConstraintViolation errors correctly" $ \_testEnv performGraphqlRequest -> do
+    let headers = []
+    let graphqlRequest =
+          [graphql|
+            mutation insertAlbum {
+              insert_albums(objects: [
+                {id: 9001, title: "Super Mega Rock", artist_id: 1}
+              ]) {
+                affected_rows
+              }
+            }
+          |]
+    let errorResponse = API.ErrorResponse API.MutationConstraintViolation "A constraint was violated" [yaml| { foo: "bar" } |]
+    let mockConfig = Mock.defaultMockRequestConfig {Mock._mutationResponse = \_ -> Left errorResponse}
+
+    MockRequestResults {..} <- performGraphqlRequest mockConfig headers graphqlRequest
+
+    _mrrResponse
+      `shouldBeYaml` [yaml|
+        errors:
+          - extensions:
+              code: "constraint-violation"
+              path: "$"
+              internal:
+                foo: "bar"
+            message: "A constraint was violated"
+      |]
+
+  mockAgentGraphqlTest "handles returned MutationPermissionCheckFailure errors correctly" $ \_testEnv performGraphqlRequest -> do
+    let headers = []
+    let graphqlRequest =
+          [graphql|
+            mutation insertAlbum {
+              insert_albums(objects: [
+                {id: 9001, title: "Super Mega Rock", artist_id: 1}
+              ]) {
+                affected_rows
+              }
+            }
+          |]
+    let errorResponse = API.ErrorResponse API.MutationPermissionCheckFailure "A permission check failed" [yaml| { foo: "bar" } |]
+    let mockConfig = Mock.defaultMockRequestConfig {Mock._mutationResponse = \_ -> Left errorResponse}
+
+    MockRequestResults {..} <- performGraphqlRequest mockConfig headers graphqlRequest
+
+    _mrrResponse
+      `shouldBeYaml` [yaml|
+        errors:
+          - extensions:
+              code: "permission-error"
+              path: "$"
+              internal:
+                foo: "bar"
+            message: "A permission check failed"
+      |]

server/lib/api-tests/src/Test/Schema/DataValidations/Permissions/InsertSpec.hs

@@ -7,11 +7,11 @@ module Test.Schema.DataValidations.Permissions.InsertSpec (spec) where
 
 import Control.Lens ((.~))
 import Data.Aeson (Value)
-import Data.Aeson.Key qualified as Key (toString)
 import Data.Aeson.Lens (atKey, key, values)
 import Data.List.NonEmpty qualified as NE
 import Harness.Backend.Citus qualified as Citus
 import Harness.Backend.Cockroach qualified as Cockroach
+import Harness.Backend.DataConnector.Sqlite qualified as Sqlite
 import Harness.Backend.Postgres qualified as Postgres
 import Harness.Backend.Sqlserver qualified as Sqlserver
 import Harness.GraphqlEngine (postGraphqlWithHeaders, postMetadata_)
@@ -52,6 +52,12 @@ spec = do
                 [ Sqlserver.setupTablesAction schema testEnvironment,
                   setupMetadata Sqlserver.backendTypeMetadata testEnvironment
                 ]
+            },
+          (Fixture.fixture $ Fixture.Backend Sqlite.backendTypeMetadata)
+            { Fixture.setupTeardown = \(testEnvironment, _) ->
+                [ Sqlite.setupTablesAction schema testEnvironment,
+                  setupMetadata Sqlite.backendTypeMetadata testEnvironment
+                ]
             }
         ]
     )
@@ -89,43 +95,44 @@ schema =
 -- Tests
 
 tests :: SpecWith TestEnvironment
-tests = do
-  let -- The error path differs across backends. Since it's immaterial for the tests we want to make we simply ignore it.
+tests = describe "Permissions on mutations" do
+  let -- The error path and internal property differs across backends. Since it's immaterial for the tests we want to make we simply ignore it.
       removeErrorPath :: Value -> Value
       removeErrorPath = key "errors" . values . key "extensions" . atKey "path" .~ Nothing
+      removeErrorInternal :: Value -> Value
+      removeErrorInternal = key "errors" . values . key "extensions" . atKey "internal" .~ Nothing
 
-  describe "Permissions on mutations" do
-    it "Rejects insertions by authors on behalf of others" \testEnvironment -> do
-      let schemaName :: Schema.SchemaName
-          schemaName = Schema.getSchemaName testEnvironment
+  it "Rejects insertions by authors on behalf of others" \testEnvironment -> do
+    let schemaName :: Schema.SchemaName
+        schemaName = Schema.getSchemaName testEnvironment
 
-      let expected :: Value
-          expected =
-            [interpolateYaml|
-              errors:
-              - extensions:
-                  code: permission-error
-                message: check constraint of an insert/update permission has failed
+    let expected :: Value
+        expected =
+          [interpolateYaml|
+            errors:
+            - extensions:
+                code: permission-error
+              message: check constraint of an insert/update permission has failed
+          |]
+
+        actual :: IO Value
+        actual =
+          postGraphqlWithHeaders
+            testEnvironment
+            [ ("X-Hasura-Role", "user"),
+              ("X-Hasura-User-Id", "2")
+            ]
+            [graphql|
+              mutation {
+                insert_#{schemaName}_article(objects: [
+                  { id: 1, title: "Author 1 article", author_id: 1 }
+                ]) {
+                  affected_rows
+                }
+              }
             |]
 
-          actual :: IO Value
-          actual =
-            postGraphqlWithHeaders
-              testEnvironment
-              [ ("X-Hasura-Role", "user"),
-                ("X-Hasura-User-Id", "2")
-              ]
-              [graphql|
-                mutation {
-                  insert_#{schemaName}_article(objects: [
-                    { id: 1, title: "Author 1 article", author_id: 1 }
-                  ]) {
-                    affected_rows
-                  }
-                }
-              |]
-
-      shouldReturnYaml testEnvironment (fmap removeErrorPath actual) expected
+    shouldReturnYaml testEnvironment (fmap (removeErrorPath . removeErrorInternal) actual) expected
 
   it "Allows authors to insert their own articles" \testEnvironment -> do
     let schemaName :: Schema.SchemaName
@@ -167,7 +174,7 @@ tests = do
               }
             |]
 
-    shouldReturnYaml testEnvironment (fmap removeErrorPath actual) expected
+    shouldReturnYaml testEnvironment (fmap (removeErrorPath . removeErrorInternal) actual) expected
 
   it "Authors can't add other authors" $ \testEnvironment -> do
     let schemaName :: Schema.SchemaName
@@ -199,7 +206,7 @@ tests = do
               }
             |]
 
-    shouldReturnYaml testEnvironment (fmap removeErrorPath actual) expected
+    shouldReturnYaml testEnvironment (fmap (removeErrorPath . removeErrorInternal) actual) expected
 
 --------------------------------------------------------------------------------
 -- Metadata
@@ -209,15 +216,18 @@ setupMetadata backendTypeMetadata testEnvironment = do
   let schemaName :: Schema.SchemaName
       schemaName = Schema.getSchemaName testEnvironment
 
-      schemaKeyword :: String
-      schemaKeyword = Key.toString $ Fixture.backendSchemaKeyword backendTypeMetadata
-
       backendPrefix :: String
       backendPrefix = Fixture.backendTypeString backendTypeMetadata
 
       source :: String
       source = Fixture.backendSourceName backendTypeMetadata
 
+      articleTable :: Value
+      articleTable = Schema.mkTableField backendTypeMetadata schemaName "article"
+
+      authorTable :: Value
+      authorTable = Schema.mkTableField backendTypeMetadata schemaName "author"
+
       setup :: IO ()
       setup =
         postMetadata_
@@ -228,9 +238,7 @@ setupMetadata backendTypeMetadata testEnvironment = do
             - type: #{backendPrefix}_create_insert_permission
               args:
                 source: #{source}
-                table:
-                  #{schemaKeyword}: #{schemaName}
-                  name: article
+                table: #{articleTable}
                 role: user
                 permission:
                   check:
@@ -244,9 +252,7 @@ setupMetadata backendTypeMetadata testEnvironment = do
             - type: #{backendPrefix}_create_select_permission
               args:
                 source: #{source}
-                table:
-                  #{schemaKeyword}: #{schemaName}
-                  name: article
+                table: #{articleTable}
                 role: user
                 permission:
                   filter:
@@ -260,9 +266,7 @@ setupMetadata backendTypeMetadata testEnvironment = do
             - type: #{backendPrefix}_create_insert_permission
               args:
                 source: #{source}
-                table:
-                  #{schemaKeyword}: #{schemaName}
-                  name: author
+                table: #{authorTable}
                 role: user
                 permission:
                   check:
@@ -282,23 +286,17 @@ setupMetadata backendTypeMetadata testEnvironment = do
             - type: #{backendPrefix}_drop_insert_permission
               args:
                 source: #{source}
-                table:
-                  #{schemaKeyword}: #{schemaName}
-                  name: article
+                table: #{articleTable}
                 role: user
             - type: #{backendPrefix}_drop_select_permission
               args:
                 source: #{source}
-                table:
-                  #{schemaKeyword}: #{schemaName}
-                  name: article
+                table: #{articleTable}
                 role: user
             - type: #{backendPrefix}_drop_insert_permission
               args:
                 source: #{source}
-                table:
-                  #{schemaKeyword}: #{schemaName}
-                  name: author
+                table: #{authorTable}
                 role: user
           |]
 

server/lib/api-tests/src/Test/Schema/DataValidations/Permissions/SelectSpec.hs

@@ -7,11 +7,11 @@
 module Test.Schema.DataValidations.Permissions.SelectSpec (spec) where
 
 import Data.Aeson (Value)
-import Data.Aeson.Key qualified as Key (toString)
 import Data.List.NonEmpty qualified as NE
 import Harness.Backend.BigQuery qualified as BigQuery
 import Harness.Backend.Citus qualified as Citus
 import Harness.Backend.Cockroach qualified as Cockroach
+import Harness.Backend.DataConnector.Sqlite qualified as Sqlite
 import Harness.Backend.Postgres qualified as Postgres
 import Harness.GraphqlEngine (postGraphqlWithHeaders, postMetadata_)
 import Harness.Quoter.Graphql (graphql)
@@ -22,7 +22,7 @@ import Harness.Test.Fixture qualified as Fixture
 import Harness.TestEnvironment (GlobalTestEnvironment, TestEnvironment)
 import Harness.Yaml (shouldReturnYaml)
 import Hasura.Prelude
-import Test.Hspec (SpecWith, describe, it)
+import Test.Hspec (SpecWith, describe, it, pendingWith)
 
 spec :: SpecWith GlobalTestEnvironment
 spec = do
@@ -31,25 +31,36 @@ spec = do
         [ (Fixture.fixture $ Fixture.Backend Postgres.backendTypeMetadata)
             { Fixture.setupTeardown = \(testEnvironment, _) ->
                 [ Postgres.setupTablesAction schema testEnvironment,
-                  setupMetadata Postgres.backendTypeMetadata testEnvironment
+                  setupMetadata SupportsArrayTypes Postgres.backendTypeMetadata testEnvironment
                 ]
             },
           (Fixture.fixture $ Fixture.Backend Citus.backendTypeMetadata)
             { Fixture.setupTeardown = \(testEnvironment, _) ->
                 [ Citus.setupTablesAction schema testEnvironment,
-                  setupMetadata Citus.backendTypeMetadata testEnvironment
+                  setupMetadata SupportsArrayTypes Citus.backendTypeMetadata testEnvironment
                 ]
             },
           (Fixture.fixture $ Fixture.Backend Cockroach.backendTypeMetadata)
             { Fixture.setupTeardown = \(testEnvironment, _) ->
                 [ Cockroach.setupTablesAction schema testEnvironment,
-                  setupMetadata Cockroach.backendTypeMetadata testEnvironment
+                  setupMetadata SupportsArrayTypes Cockroach.backendTypeMetadata testEnvironment
                 ]
             },
-          (Fixture.fixture $ Fixture.Backend BigQuery.backendTypeMetadata)
+          (Fixture.fixture $ Fixture.Backend Sqlite.backendTypeMetadata)
+            { Fixture.setupTeardown = \(testEnvironment, _) ->
+                [ Sqlite.setupTablesAction schema testEnvironment,
+                  setupMetadata SupportsArrayTypes Sqlite.backendTypeMetadata testEnvironment
+                ]
+            }
+        ]
+    )
+    (tests SupportsArrayTypes)
+  Fixture.run
+    ( NE.fromList
+        [ (Fixture.fixture $ Fixture.Backend BigQuery.backendTypeMetadata)
             { Fixture.setupTeardown = \(testEnvironment, _) ->
                 [ BigQuery.setupTablesAction schema testEnvironment,
-                  setupMetadata BigQuery.backendTypeMetadata testEnvironment
+                  setupMetadata DoesNotSupportArrayTypes BigQuery.backendTypeMetadata testEnvironment
                 ],
               Fixture.customOptions =
                 Just $
@@ -59,7 +70,7 @@ spec = do
             }
         ]
     )
-    tests
+    (tests DoesNotSupportArrayTypes)
 
 --------------------------------------------------------------------------------
 -- Schema
@@ -74,7 +85,8 @@ schema =
         tablePrimaryKey = ["id"],
         tableData =
           [ [Schema.VInt 1, Schema.VStr "Author 1"],
-            [Schema.VInt 2, Schema.VStr "Author 2"]
+            [Schema.VInt 2, Schema.VStr "Author 2"],
+            [Schema.VInt 3, Schema.VStr "Author 3"]
           ]
       },
     (table "article")
@@ -82,7 +94,7 @@ schema =
           [ Schema.column "id" Schema.TInt,
             Schema.column "title" Schema.TStr,
             Schema.columnNull "content" Schema.TStr,
-            Schema.column "is_published" Schema.TBool,
+            Schema.column "state" Schema.TStr, -- 'Draft', 'InReview', 'Published'
             Schema.column "author_id" Schema.TInt
           ],
         tablePrimaryKey = ["id"],
@@ -91,14 +103,20 @@ schema =
           [ [ Schema.VInt 1,
               Schema.VStr "Article 1",
               Schema.VStr "Sample article content 1",
-              Schema.VBool False,
+              Schema.VStr "InReview",
               Schema.VInt 1
             ],
             [ Schema.VInt 2,
               Schema.VStr "Article 2",
               Schema.VStr "Sample article content 2",
-              Schema.VBool True,
+              Schema.VStr "Published",
               Schema.VInt 2
+            ],
+            [ Schema.VInt 3,
+              Schema.VStr "Article 3",
+              Schema.VStr "Sample article content 3",
+              Schema.VStr "Draft",
+              Schema.VInt 3
             ]
           ]
       }
@@ -107,37 +125,41 @@ schema =
 --------------------------------------------------------------------------------
 -- Tests
 
-tests :: SpecWith TestEnvironment
-tests = do
-  describe "Permissions on queries" do
-    it "Authors can't select another author's articles" \testEnvironment -> do
-      let schemaName :: Schema.SchemaName
-          schemaName = Schema.getSchemaName testEnvironment
+data ArrayTypeSupport
+  = SupportsArrayTypes
+  | DoesNotSupportArrayTypes
+  deriving stock (Eq, Show)
 
-          expected :: Value
-          expected =
-            [interpolateYaml|
-              data:
-                #{schemaName}_article: []
+tests :: ArrayTypeSupport -> SpecWith TestEnvironment
+tests arrayTypeSupport = describe "Permissions on queries" do
+  it "Authors can't select another author's articles" \testEnvironment -> do
+    let schemaName :: Schema.SchemaName
+        schemaName = Schema.getSchemaName testEnvironment
+
+        expected :: Value
+        expected =
+          [interpolateYaml|
+            data:
+              #{schemaName}_article: []
+          |]
+
+        actual :: IO Value
+        actual =
+          postGraphqlWithHeaders
+            testEnvironment
+            [ ("X-Hasura-Role", "author"),
+              ("X-Hasura-User-Id", "0")
+            ]
+            [graphql|
+              query {
+                #{schemaName}_article {
+                  id
+                  author_id
+                }
+              }
             |]
 
-          actual :: IO Value
-          actual =
-            postGraphqlWithHeaders
-              testEnvironment
-              [ ("X-Hasura-Role", "author"),
-                ("X-Hasura-User-Id", "0")
-              ]
-              [graphql|
-                query {
-                  #{schemaName}_article {
-                    id
-                    author_id
-                  }
-                }
-              |]
-
-      shouldReturnYaml testEnvironment actual expected
+    shouldReturnYaml testEnvironment actual expected
 
   it "Authors can select their own articles" \testEnvironment -> do
     let schemaName :: Schema.SchemaName
@@ -203,23 +225,72 @@ tests = do
 
     shouldReturnYaml testEnvironment actual expected
 
+  it "Editor role can select in review and published articles only" \testEnvironment -> do
+    when (arrayTypeSupport == DoesNotSupportArrayTypes) $
+      pendingWith "Backend does not support array types"
+
+    let schemaName :: Schema.SchemaName
+        schemaName = Schema.getSchemaName testEnvironment
+
+        expected :: Value
+        expected =
+          [interpolateYaml|
+            data:
+              #{schemaName}_article:
+              - author_id: 1
+                content: Sample article content 1
+                title: Article 1
+              - author_id: 2
+                content: Sample article content 2
+                title: Article 2
+          |]
+
+        actual :: IO Value
+        actual =
+          postGraphqlWithHeaders
+            testEnvironment
+            [ ("X-Hasura-Role", "editor")
+            ]
+            [graphql|
+              query {
+                #{schemaName}_article {
+                  title
+                  content
+                  author_id
+                }
+              }
+            |]
+
+    shouldReturnYaml testEnvironment actual expected
+
 --------------------------------------------------------------------------------
 -- Metadata
 
-setupMetadata :: Fixture.BackendTypeConfig -> TestEnvironment -> Fixture.SetupAction
-setupMetadata backendTypeMetadata testEnvironment = do
+setupMetadata :: ArrayTypeSupport -> Fixture.BackendTypeConfig -> TestEnvironment -> Fixture.SetupAction
+setupMetadata arrayTypeSupport backendTypeMetadata testEnvironment = do
   let schemaName :: Schema.SchemaName
       schemaName = Schema.getSchemaName testEnvironment
 
-      schemaKeyword :: String
-      schemaKeyword = Key.toString $ Fixture.backendSchemaKeyword backendTypeMetadata
-
       backendPrefix :: String
       backendPrefix = Fixture.backendTypeString backendTypeMetadata
 
       source :: String
       source = Fixture.backendSourceName backendTypeMetadata
 
+      articleTable :: Value
+      articleTable = Schema.mkTableField backendTypeMetadata schemaName "article"
+
+      articleEditorFilter :: Value
+      articleEditorFilter =
+        case arrayTypeSupport of
+          SupportsArrayTypes ->
+            [interpolateYaml|
+              state:
+                _in: [InReview, Published]
+            |]
+          DoesNotSupportArrayTypes ->
+            [interpolateYaml| {} |]
+
       setup :: IO ()
       setup =
         postMetadata_
@@ -230,9 +301,7 @@ setupMetadata backendTypeMetadata testEnvironment = do
             - type: #{backendPrefix}_create_select_permission
               args:
                 source: #{source}
-                table:
-                  #{schemaKeyword}: #{schemaName}
-                  name: article
+                table: #{articleTable}
                 role: author
                 permission:
                   filter:
@@ -242,14 +311,20 @@ setupMetadata backendTypeMetadata testEnvironment = do
             - type: #{backendPrefix}_create_select_permission
               args:
                 source: #{source}
-                table:
-                  #{schemaKeyword}: #{schemaName}
-                  name: article
+                table: #{articleTable}
                 role: user
                 permission:
                   filter:
-                    is_published:
-                      _eq: true
+                    state:
+                      _eq: Published
+                  columns: "*"
+            - type: #{backendPrefix}_create_select_permission
+              args:
+                source: #{source}
+                table: #{articleTable}
+                role: editor
+                permission:
+                  filter: #{articleEditorFilter}
                   columns: "*"
           |]
 
@@ -263,17 +338,18 @@ setupMetadata backendTypeMetadata testEnvironment = do
             - type: #{backendPrefix}_drop_select_permission
               args:
                 source: #{source}
-                table:
-                  name: article
-                  #{schemaKeyword}: #{schemaName}
+                table: #{articleTable}
                 role: author
             - type: #{backendPrefix}_drop_select_permission
               args:
                 source: #{source}
-                table:
-                  name: article
-                  #{schemaKeyword}: #{schemaName}
+                table: #{articleTable}
                 role: user
+            - type: #{backendPrefix}_drop_select_permission
+              args:
+                source: #{source}
+                table: #{articleTable}
+                role: editor
           |]
 
   Fixture.SetupAction setup \_ -> teardown

server/lib/api-tests/src/Test/Schema/DataValidations/Permissions/UpdateSpec.hs

@@ -6,10 +6,10 @@
 module Test.Schema.DataValidations.Permissions.UpdateSpec (spec) where
 
 import Data.Aeson (Value)
-import Data.Aeson.Key qualified as Key (toString)
 import Data.List.NonEmpty qualified as NE
 import Harness.Backend.Citus qualified as Citus
 import Harness.Backend.Cockroach qualified as Cockroach
+import Harness.Backend.DataConnector.Sqlite qualified as Sqlite
 import Harness.Backend.Postgres qualified as Postgres
 import Harness.GraphqlEngine (postGraphqlWithHeaders, postMetadata_)
 import Harness.Quoter.Graphql (graphql)
@@ -43,6 +43,12 @@ spec = do
                 [ Cockroach.setupTablesAction schema testEnvironment,
                   setupMetadata Cockroach.backendTypeMetadata testEnvironment
                 ]
+            },
+          (Fixture.fixture $ Fixture.Backend Sqlite.backendTypeMetadata)
+            { Fixture.setupTeardown = \(testEnvironment, _) ->
+                [ Sqlite.setupTablesAction schema testEnvironment,
+                  setupMetadata Sqlite.backendTypeMetadata testEnvironment
+                ]
             }
         ]
     )
@@ -150,7 +156,7 @@ tests =
             errors:
             - extensions:
                 code: validation-failed
-                path: "$.selectionSet.update_hasura_author.args._set.id"
+                path: "$.selectionSet.update_#{schemaName}_author.args._set.id"
               message: "field 'id' not found in type: '#{schemaName}_author_set_input'"
             |]
 
@@ -184,7 +190,7 @@ tests =
             errors:
             - extensions:
                 code: validation-failed
-                path: "$.selectionSet.update_hasura_author_many.args.updates[0]._set.id"
+                path: "$.selectionSet.update_#{schemaName}_author_many.args.updates[0]._set.id"
               message: "field 'id' not found in type: '#{schemaName}_author_set_input'"
             |]
 
@@ -216,15 +222,15 @@ setupMetadata backendTypeMetadata testEnvironment = do
   let schemaName :: Schema.SchemaName
       schemaName = Schema.getSchemaName testEnvironment
 
-      schemaKeyword :: String
-      schemaKeyword = Key.toString $ Fixture.backendSchemaKeyword backendTypeMetadata
-
       backendPrefix :: String
       backendPrefix = Fixture.backendTypeString backendTypeMetadata
 
       source :: String
       source = Fixture.backendSourceName backendTypeMetadata
 
+      authorTable :: Value
+      authorTable = Schema.mkTableField backendTypeMetadata schemaName "author"
+
       setup :: IO ()
       setup =
         postMetadata_
@@ -235,9 +241,7 @@ setupMetadata backendTypeMetadata testEnvironment = do
             - type: #{backendPrefix}_create_select_permission
               args:
                 source: #{source}
-                table:
-                  #{schemaKeyword}: #{schemaName}
-                  name: author
+                table: #{authorTable}
                 role: user
                 permission:
                   filter:
@@ -249,9 +253,7 @@ setupMetadata backendTypeMetadata testEnvironment = do
             - type: #{backendPrefix}_create_update_permission
               args:
                 source: #{source}
-                table:
-                  #{schemaKeyword}: #{schemaName}
-                  name: author
+                table: #{authorTable}
                 role: user
                 permission:
                   filter:
@@ -271,16 +273,12 @@ setupMetadata backendTypeMetadata testEnvironment = do
             - type: #{backendPrefix}_drop_select_permission
               args:
                 source: #{source}
-                table:
-                  #{schemaKeyword}: #{schemaName}
-                  name: author
+                table: #{authorTable}
                 role: user
             - type: #{backendPrefix}_drop_update_permission
               args:
                 source: #{source}
-                table:
-                  #{schemaKeyword}: #{schemaName}
-                  name: author
+                table: #{authorTable}
                 role: user
           |]
 

server/lib/dc-api/src/Hasura/Backends/DataConnector/API/V0/ErrorResponse.hs

@@ -6,7 +6,6 @@ module Hasura.Backends.DataConnector.API.V0.ErrorResponse
     ErrorResponse400,
     ErrorResponseType (..),
     errorResponseJsonText,
-    errorResponseSummary,
   )
 where
 
@@ -16,7 +15,7 @@ import Data.Aeson (FromJSON, ToJSON)
 import Data.Aeson qualified as J
 import Data.Aeson.Text (encodeToLazyText)
 import Data.OpenApi (ToSchema (..))
-import Data.Text (Text, pack)
+import Data.Text (Text)
 import Data.Text.Lazy (toStrict)
 import GHC.Generics (Generic)
 import Servant.API (HasStatus)
@@ -51,10 +50,6 @@ instance HasStatus ErrorResponse where
 
 type ErrorResponse400 = Servant.WithStatus 400 ErrorResponse
 
-{-# HLINT ignore "Use tshow" #-}
-errorResponseSummary :: ErrorResponse -> Text
-errorResponseSummary ErrorResponse {..} = pack (show _crType) <> ": " <> _crMessage
-
 errorResponseJsonText :: ErrorResponse -> Text
 errorResponseJsonText = toStrict . encodeToLazyText
 

server/src-lib/Hasura/Backends/DataConnector/Adapter/Execute.hs

@@ -11,17 +11,16 @@ where
 import Data.Aeson qualified as J
 import Data.ByteString.Lazy qualified as BL
 import Data.Text.Encoding qualified as TE
-import Data.Text.Extended (toTxt)
 import Hasura.Backends.DataConnector.API qualified as API
-import Hasura.Backends.DataConnector.API.V0.ErrorResponse (ErrorResponse (..))
 import Hasura.Backends.DataConnector.Adapter.ConfigTransform (transformSourceConfig)
 import Hasura.Backends.DataConnector.Adapter.Types (SourceConfig (..))
 import Hasura.Backends.DataConnector.Agent.Client (AgentClientT)
+import Hasura.Backends.DataConnector.Agent.Client qualified as Client
 import Hasura.Backends.DataConnector.Plan.Common (Plan (..))
 import Hasura.Backends.DataConnector.Plan.MutationPlan qualified as Plan
 import Hasura.Backends.DataConnector.Plan.QueryPlan qualified as Plan
 import Hasura.Backends.DataConnector.Plan.RemoteRelationshipPlan qualified as Plan
-import Hasura.Base.Error (Code (..), QErr, throw400, throw400WithDetail)
+import Hasura.Base.Error (Code (..), QErr, throw400)
 import Hasura.EncJSON (EncJSON, encJFromBuilder, encJFromJValue)
 import Hasura.GraphQL.Execute.Backend (BackendExecute (..), DBStepInfo (..), ExplainPlan (..), OnBaseMonad (..), withNoStatistics)
 import Hasura.GraphQL.Namespace qualified as GQL
@@ -31,8 +30,6 @@ import Hasura.RQL.Types.Common qualified as RQL
 import Hasura.SQL.AnyBackend (mkAnyBackend)
 import Hasura.Session
 import Hasura.Tracing (MonadTrace)
-import Servant.Client.Core.HasClient ((//))
-import Servant.Client.Generic (genericClient)
 
 data DataConnectorPreparedQuery
   = QueryRequest API.QueryRequest
@@ -114,13 +111,9 @@ instance BackendExecute 'DataConnector where
 
 buildQueryAction :: (MonadIO m, MonadTrace m, MonadError QErr m) => RQL.SourceName -> SourceConfig -> Plan API.QueryRequest API.QueryResponse -> AgentClientT m EncJSON
 buildQueryAction sourceName SourceConfig {..} Plan {..} = do
-  queryResponse <- queryGuard =<< (genericClient // API._query) (toTxt sourceName) _scConfig _pRequest
+  queryResponse <- Client.query sourceName _scConfig _pRequest
   reshapedResponse <- _pResponseReshaper queryResponse
   pure . encJFromBuilder $ J.fromEncoding reshapedResponse
-  where
-    errorAction e = throw400WithDetail DataConnectorError (API.errorResponseSummary e) (_crDetails e)
-    defaultAction = throw400 DataConnectorError "Unexpected data connector query response - Unexpected Type"
-    queryGuard = API.queryCase defaultAction pure errorAction
 
 -- Delegates the generation to the Agent's /explain endpoint if it has that capability,
 -- otherwise, returns the IR sent to the agent.
@@ -129,7 +122,7 @@ buildExplainAction fieldName sourceName SourceConfig {..} Plan {..} =
   case API._cExplain _scCapabilities of
     Nothing -> pure . encJFromJValue . toExplainPlan fieldName $ _pRequest
     Just API.ExplainCapabilities -> do
-      explainResponse <- (genericClient // API._explain) (toTxt sourceName) _scConfig _pRequest
+      explainResponse <- Client.explain sourceName _scConfig _pRequest
       pure . encJFromJValue $
         ExplainPlan
           fieldName
@@ -142,10 +135,6 @@ toExplainPlan fieldName queryRequest =
 
 buildMutationAction :: (MonadIO m, MonadTrace m, MonadError QErr m) => RQL.SourceName -> SourceConfig -> Plan API.MutationRequest API.MutationResponse -> AgentClientT m EncJSON
 buildMutationAction sourceName SourceConfig {..} Plan {..} = do
-  queryResponse <- mutationGuard =<< (genericClient // API._mutation) (toTxt sourceName) _scConfig _pRequest
+  queryResponse <- Client.mutation sourceName _scConfig _pRequest
   reshapedResponse <- _pResponseReshaper queryResponse
   pure . encJFromBuilder $ J.fromEncoding reshapedResponse
-  where
-    errorAction e = throw400WithDetail DataConnectorError (API.errorResponseSummary e) (_crDetails e)
-    defaultAction = throw400 DataConnectorError "Unexpected data connector mutations response - Unexpected Type"
-    mutationGuard = API.mutationCase defaultAction pure errorAction

server/src-lib/Hasura/Backends/DataConnector/Adapter/Metadata.hs

@@ -21,17 +21,16 @@ import Data.Semigroup.Foldable (Foldable1 (..))
 import Data.Sequence qualified as Seq
 import Data.Sequence.NonEmpty qualified as NESeq
 import Data.Text.Extended (toTxt, (<<>), (<>>))
-import Hasura.Backends.DataConnector.API (capabilitiesCase, errorResponseSummary, schemaCase)
 import Hasura.Backends.DataConnector.API qualified as API
 import Hasura.Backends.DataConnector.API.V0 (FunctionInfo (_fiDescription, _fiName))
-import Hasura.Backends.DataConnector.API.V0.ErrorResponse (_crDetails)
 import Hasura.Backends.DataConnector.API.V0.Table qualified as DC (TableType (..))
 import Hasura.Backends.DataConnector.Adapter.Backend (columnTypeToScalarType)
 import Hasura.Backends.DataConnector.Adapter.ConfigTransform (transformSourceConfig, validateConnSourceConfig)
 import Hasura.Backends.DataConnector.Adapter.Types qualified as DC
 import Hasura.Backends.DataConnector.Agent.Client (AgentClientContext (..), runAgentClientT)
+import Hasura.Backends.DataConnector.Agent.Client qualified as Client
 import Hasura.Backends.Postgres.SQL.Types (PGDescription (..))
-import Hasura.Base.Error (Code (..), QErr (..), decodeValue, throw400, throw400WithDetail, withPathK)
+import Hasura.Base.Error (Code (..), QErr (..), decodeValue, runAesonParser, throw400, withPathK)
 import Hasura.Function.Cache
   ( FunctionConfig (..),
     FunctionExposedAs (FEAMutation, FEAQuery),
@@ -86,8 +85,6 @@ import Hasura.Tracing (ignoreTraceT)
 import Language.GraphQL.Draft.Syntax qualified as G
 import Language.GraphQL.Draft.Syntax qualified as GQL
 import Network.HTTP.Client qualified as HTTP
-import Servant.Client ((//))
-import Servant.Client.Generic (genericClient)
 import Witch qualified
 
 instance BackendMetadata 'DataConnector where
@@ -251,15 +248,11 @@ resolveBackendInfo' logger = proc (invalidationKeys, optionsMap) -> do
       HTTP.Manager ->
       m (Either QErr DC.DataConnectorInfo)
     getDataConnectorCapabilities options@DC.DataConnectorOptions {..} manager = runExceptT do
-      capabilitiesU <-
+      API.CapabilitiesResponse {..} <-
         ignoreTraceT
           . flip runAgentClientT (AgentClientContext logger _dcoUri manager Nothing Nothing)
-          $ genericClient @API.Routes // API._capabilities
-
-      let defaultAction = throw400 DataConnectorError "Unexpected data connector capabilities response - Unexpected Type"
-          capabilitiesAction API.CapabilitiesResponse {..} = pure $ DC.DataConnectorInfo options _crCapabilities _crConfigSchemaResponse _crDisplayName _crReleaseName
-
-      capabilitiesCase defaultAction capabilitiesAction errorAction capabilitiesU
+          $ Client.capabilities
+      pure $ DC.DataConnectorInfo options _crCapabilities _crConfigSchemaResponse _crDisplayName _crReleaseName
 
     toHashMap = HashMap.fromList . Map.toList
 
@@ -371,15 +364,9 @@ requestDatabaseSchema ::
   m API.SchemaResponse
 requestDatabaseSchema logger sourceName sourceConfig = do
   transformedSourceConfig <- transformSourceConfig sourceConfig Nothing
-
-  schemaResponseU <-
-    ignoreTraceT
-      . flip runAgentClientT (AgentClientContext logger (DC._scEndpoint transformedSourceConfig) (DC._scManager transformedSourceConfig) (DC._scTimeoutMicroseconds transformedSourceConfig) Nothing)
-      $ (genericClient // API._schema) (toTxt sourceName) (DC._scConfig transformedSourceConfig)
-
-  let defaultAction = throw400 DataConnectorError "Unexpected data connector schema response - Unexpected Type"
-
-  schemaCase defaultAction pure errorAction schemaResponseU
+  ignoreTraceT
+    . flip runAgentClientT (AgentClientContext logger (DC._scEndpoint transformedSourceConfig) (DC._scManager transformedSourceConfig) (DC._scTimeoutMicroseconds transformedSourceConfig) Nothing)
+    $ Client.schema sourceName (DC._scConfig transformedSourceConfig)
 
 toTableObjectType :: API.Capabilities -> HashSet G.Name -> API.ObjectTypeDefinition -> Maybe (G.Name, RQL.T.T.TableObjectType 'DataConnector)
 toTableObjectType capabilities typeNames API.ObjectTypeDefinition {..} =
@@ -542,8 +529,10 @@ parseCollectableType' collectableType = \case
   val -> case collectableType of
     CollectableTypeScalar columnType ->
       PSESQLExp . DC.ValueLiteral (columnTypeToScalarType columnType) <$> RQL.T.C.parseScalarValueColumnType columnType val
-    CollectableTypeArray _ ->
-      throw400 NotSupported "Array types are not supported by the Data Connector backend"
+    CollectableTypeArray columnType -> do
+      vals <- runAesonParser J.parseJSON val
+      scalarValues <- RQL.T.C.parseScalarValuesColumnType columnType vals
+      pure . PSESQLExp $ DC.ArrayLiteral (columnTypeToScalarType columnType) scalarValues
 
 mkTypedSessionVar ::
   CollectableType (RQL.T.C.ColumnType 'DataConnector) ->
@@ -552,9 +541,6 @@ mkTypedSessionVar ::
 mkTypedSessionVar columnType =
   PSESessVar (columnTypeToScalarType <$> columnType)
 
-errorAction :: (MonadError QErr m) => API.ErrorResponse -> m a
-errorAction e = throw400WithDetail DataConnectorError (errorResponseSummary e) (_crDetails e)
-
 -- | This function assumes that if a type name is present in the custom object types for the table then it
 -- refers to a nested object of that type.
 -- Otherwise it is a normal (scalar) column.

server/src-lib/Hasura/Backends/DataConnector/Agent/Client.hs

@@ -5,6 +5,11 @@ module Hasura.Backends.DataConnector.Agent.Client
     AgentClientContext (..),
     AgentClientT,
     runAgentClientT,
+    capabilities,
+    schema,
+    query,
+    explain,
+    mutation,
   )
 where
 
@@ -13,16 +18,20 @@ where
 import Control.Exception (try)
 import Control.Lens ((%=), (&~), (.=))
 import Data.ByteString (ByteString)
+import Data.Text.Extended (toTxt)
+import Hasura.Backends.DataConnector.API qualified as API
 import Hasura.Backends.DataConnector.Logging (logAgentRequest, logClientError)
 import Hasura.Base.Error
 import Hasura.HTTP qualified
 import Hasura.Logging (Hasura, Logger)
 import Hasura.Prelude
+import Hasura.RQL.Types.Common qualified as RQL
 import Hasura.Tracing (MonadTrace, traceHTTPRequest)
 import Network.HTTP.Client.Transformable qualified as HTTP
 import Network.HTTP.Types.Status (Status)
 import Servant.Client
 import Servant.Client.Core (Request, RunClient (..))
+import Servant.Client.Generic (genericClient)
 import Servant.Client.Internal.HttpClient (clientResponseToResponse, mkFailureResponse)
 
 -------------------------------------------------------------------------------rs
@@ -86,3 +95,47 @@ throwClientError' err = do
   case err of
     FailureResponse _ r | responseStatusCode r == HTTP.status401 -> throw401 "EE License Key Required."
     _ -> throw500 $ "Error in Data Connector backend: " <> Hasura.HTTP.serializeServantClientErrorMessage err
+
+-------------------------------------------------------------------------------
+
+capabilities :: (MonadIO m, MonadTrace m, MonadError QErr m) => AgentClientT m API.CapabilitiesResponse
+capabilities = do
+  capabilitiesGuard =<< (genericClient @API.Routes // API._capabilities)
+  where
+    errorAction e = throw400WithDetail (mapErrorType $ API._crType e) (API._crMessage e) (API._crDetails e)
+    defaultAction = throw400 DataConnectorError "Unexpected data connector capabilities response - Unexpected Type"
+    capabilitiesGuard = API.capabilitiesCase defaultAction pure errorAction
+
+schema :: (MonadIO m, MonadTrace m, MonadError QErr m) => RQL.SourceName -> API.Config -> AgentClientT m API.SchemaResponse
+schema sourceName config = do
+  schemaGuard =<< (genericClient // API._schema) (toTxt sourceName) config
+  where
+    errorAction e = throw400WithDetail (mapErrorType $ API._crType e) (API._crMessage e) (API._crDetails e)
+    defaultAction = throw400 DataConnectorError "Unexpected data connector schema response - Unexpected Type"
+    schemaGuard = API.schemaCase defaultAction pure errorAction
+
+query :: (MonadIO m, MonadTrace m, MonadError QErr m) => RQL.SourceName -> API.Config -> API.QueryRequest -> AgentClientT m API.QueryResponse
+query sourceName config queryRequest = do
+  queryGuard =<< (genericClient // API._query) (toTxt sourceName) config queryRequest
+  where
+    errorAction e = throw400WithDetail (mapErrorType $ API._crType e) (API._crMessage e) (API._crDetails e)
+    defaultAction = throw400 DataConnectorError "Unexpected data connector query response - Unexpected Type"
+    queryGuard = API.queryCase defaultAction pure errorAction
+
+explain :: (MonadIO m, MonadTrace m, MonadError QErr m) => RQL.SourceName -> API.Config -> API.QueryRequest -> AgentClientT m API.ExplainResponse
+explain sourceName config queryRequest = do
+  (genericClient // API._explain) (toTxt sourceName) config queryRequest
+
+mutation :: (MonadIO m, MonadTrace m, MonadError QErr m) => RQL.SourceName -> API.Config -> API.MutationRequest -> AgentClientT m API.MutationResponse
+mutation sourceName config mutationRequest = do
+  mutationGuard =<< (genericClient // API._mutation) (toTxt sourceName) config mutationRequest
+  where
+    errorAction e = throw400WithDetail (mapErrorType $ API._crType e) (API._crMessage e) (API._crDetails e)
+    defaultAction = throw400 DataConnectorError "Unexpected data connector mutation response - Unexpected Type"
+    mutationGuard = API.mutationCase defaultAction pure errorAction
+
+mapErrorType :: API.ErrorResponseType -> Code
+mapErrorType = \case
+  API.UncaughtError -> DataConnectorError
+  API.MutationConstraintViolation -> ConstraintViolation
+  API.MutationPermissionCheckFailure -> PermissionError

server/src-lib/Hasura/RQL/DDL/DataConnector.hs

@@ -21,10 +21,9 @@ import Data.Has
 import Data.Map.Strict qualified as Map
 import Data.Monoid
 import Data.Text.Extended (ToTxt (..))
-import Hasura.Backends.DataConnector.API (ErrorResponse (_crDetails))
-import Hasura.Backends.DataConnector.API qualified as API
 import Hasura.Backends.DataConnector.Adapter.Types qualified as DC.Types
 import Hasura.Backends.DataConnector.Agent.Client (AgentClientContext (..), runAgentClientT)
+import Hasura.Backends.DataConnector.Agent.Client qualified as Client
 import Hasura.Base.Error qualified as Error
 import Hasura.EncJSON (EncJSON)
 import Hasura.EncJSON qualified as EncJSON
@@ -39,8 +38,6 @@ import Hasura.SQL.BackendMap qualified as BackendMap
 import Hasura.Services.Network
 import Hasura.Tracing (ignoreTraceT)
 import Servant.Client qualified as Servant
-import Servant.Client.Core.HasClient ((//))
-import Servant.Client.Generic (genericClient)
 
 --------------------------------------------------------------------------------
 
@@ -134,13 +131,7 @@ checkAgentAvailability ::
 checkAgentAvailability url = do
   manager <- askHTTPManager
   logger <- asks getter
-  res <- runExceptT $ do
-    capabilitiesU <- (ignoreTraceT . flip runAgentClientT (AgentClientContext logger url manager Nothing Nothing) $ genericClient @API.Routes // API._capabilities)
-    API.capabilitiesCase
-      (Error.throw500 "Capabilities request failed unexpectedly")
-      pure
-      (\e -> Error.throw500WithDetail (API.errorResponseSummary e) (_crDetails e))
-      capabilitiesU
+  res <- runExceptT . ignoreTraceT . flip runAgentClientT (AgentClientContext logger url manager Nothing Nothing) $ Client.capabilities
   -- NOTE: 'capabilitiesCase' does not handle the 'no connection to host' scenario so we must handle it explicitly here:
   pure (either NotAvailable (const Available) res)