Implement get_source_tables command for all backends

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8619 GitOrigin-RevId: 5e1b2c11775d801a77dc6d92de4c5abc1c9b8c60
2024-09-19 22:48:44 +03:00 · 2023-04-04 16:25:51 +01:00 · 2023-04-04 16:25:51 +01:00 · 794690f30c
commit 794690f30c
parent 9c779a64bf
10 changed files with 178 additions and 34 deletions
--- a/server/lib/api-tests/api-tests.cabal
+++ b/server/lib/api-tests/api-tests.cabal
@ -102,6 +102,7 @@ library
    Test.API.Metadata.LogicalModels.TypeCheckingSpec
    Test.API.Metadata.LogicalModels.ValidationSpec
    Test.API.Metadata.SuggestRelationshipsSpec
+    Test.API.Metadata.TablesSpec
    Test.API.Metadata.TestConnectionTemplateSpec
    Test.API.Metadata.TransparentDefaultsSpec
    Test.API.Metadata.WarningsSpec
--- a/server/lib/api-tests/src/Test/API/Metadata/TablesSpec.hs
+++ b/server/lib/api-tests/src/Test/API/Metadata/TablesSpec.hs
@ -0,0 +1,113 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Test.API.Metadata.TablesSpec where
+
+import Data.Aeson (Value)
+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.Postgres qualified as Postgres
+import Harness.Backend.Sqlserver qualified as Sqlserver
+import Harness.GraphqlEngine qualified as GraphqlEngine
+import Harness.Quoter.Yaml.InterpolateYaml
+import Harness.Schema qualified as Schema
+import Harness.Test.BackendType qualified as BackendType
+import Harness.Test.Fixture qualified as Fixture
+import Harness.TestEnvironment (GlobalTestEnvironment, TestEnvironment, getBackendTypeConfig)
+import Harness.Yaml (shouldReturnYaml)
+import Hasura.Prelude
+import Test.Hspec (SpecWith, it)
+
+spec :: SpecWith GlobalTestEnvironment
+spec = do
+  Fixture.run
+    ( NE.fromList
+        [ (Fixture.fixture $ Fixture.Backend Postgres.backendTypeMetadata)
+            { Fixture.setupTeardown = \(testEnvironment, _) ->
+                [ Postgres.setupTablesAction schema testEnvironment
+                ]
+            },
+          (Fixture.fixture $ Fixture.Backend Citus.backendTypeMetadata)
+            { Fixture.setupTeardown = \(testEnvironment, _) ->
+                [ Citus.setupTablesAction schema testEnvironment
+                ]
+            },
+          (Fixture.fixture $ Fixture.Backend Cockroach.backendTypeMetadata)
+            { Fixture.setupTeardown = \(testEnv, _) ->
+                [ Cockroach.setupTablesAction schema testEnv
+                ]
+            },
+          (Fixture.fixture $ Fixture.Backend Sqlserver.backendTypeMetadata)
+            { Fixture.setupTeardown = \(testEnvironment, _) ->
+                [ Sqlserver.setupTablesAction schema testEnvironment
+                ]
+            },
+          (Fixture.fixture $ Fixture.Backend BigQuery.backendTypeMetadata)
+            { Fixture.setupTeardown = \(testEnvironment, _) ->
+                [ BigQuery.setupTablesAction schema testEnvironment
+                ],
+              Fixture.customOptions =
+                Just $
+                  Fixture.defaultOptions
+                    { Fixture.stringifyNumbers = True
+                    }
+            }
+        ]
+    )
+    tests
+
+schema :: [Schema.Table]
+schema =
+  [ (Schema.table "articles")
+      { Schema.tableColumns =
+          [ Schema.column "id" Schema.TInt,
+            Schema.column "author" Schema.TInt,
+            Schema.column "title" Schema.TStr
+          ],
+        Schema.tablePrimaryKey = ["id"]
+      },
+    (Schema.table "authors")
+      { Schema.tableColumns =
+          [ Schema.column "id" Schema.TInt,
+            Schema.column "name" Schema.TStr
+          ],
+        Schema.tablePrimaryKey = ["id"]
+      }
+  ]
+
+tests :: SpecWith TestEnvironment
+tests = do
+  it "Returns the source tables" \testEnvironment -> do
+    let backendTypeMetadata = fromMaybe (error "Unknown backend") $ getBackendTypeConfig testEnvironment
+        backendType = BackendType.backendTypeString backendTypeMetadata
+        schemaName = Schema.getSchemaName testEnvironment
+
+        actual :: IO Value
+        actual =
+          GraphqlEngine.postMetadata
+            testEnvironment
+            [interpolateYaml|
+              type: #{backendType}_get_source_tables
+              args:
+                source: #{BackendType.backendSourceName backendTypeMetadata}
+            |]
+
+        expected :: Value
+        expected = case backendType of
+          "bigquery" ->
+            [interpolateYaml|
+              - dataset: #{schemaName}
+                name: articles
+              - dataset: #{schemaName}
+                name: authors
+            |]
+          _ ->
+            [interpolateYaml|
+              - schema: #{schemaName}
+                name: articles
+              - schema: #{schemaName}
+                name: authors
+            |]
+
+    shouldReturnYaml testEnvironment actual expected
--- a/server/lib/api-tests/src/Test/DataConnector/MetadataApiSpec.hs
+++ b/server/lib/api-tests/src/Test/DataConnector/MetadataApiSpec.hs
@ -28,6 +28,7 @@ import Harness.Backend.DataConnector.Chinook.Reference qualified as Reference
 import Harness.Backend.DataConnector.Chinook.Sqlite qualified as Sqlite
 import Harness.GraphqlEngine qualified as GraphqlEngine
 import Harness.Quoter.Yaml (yaml)
+import Harness.Quoter.Yaml.InterpolateYaml (interpolateYaml)
 import Harness.Test.BackendType (BackendTypeConfig (..))
 import Harness.Test.BackendType qualified as BackendType
 import Harness.Test.Fixture (Fixture (..))
@ -82,6 +83,9 @@ schemaInspectionTests = describe "Schema and Source Inspection" $ do
          sortYamlArray (J.Array a) = pure $ J.Array (Vector.fromList (sort (Vector.toList a)))
          sortYamlArray _ = fail "Should return Array"

+          backendTypeMetadata = fromMaybe (error "Unknown backend") $ getBackendTypeConfig testEnvironment
+          backendType = BackendType.backendTypeString backendTypeMetadata
+
      case BackendType.backendSourceName <$> getBackendTypeConfig testEnvironment of
        Nothing -> pendingWith "Backend not found for testEnvironment"
        Just sourceString -> do
@ -101,10 +105,10 @@ schemaInspectionTests = describe "Schema and Source Inspection" $ do
            sortYamlArray
            ( GraphqlEngine.postMetadata
                testEnvironment
-                [yaml|
-                type: get_source_tables
+                [interpolateYaml|
+                type: #{backendType}_get_source_tables
                args:
-                  source: *sourceString
+                  source: #{sourceString}
              |]
            )
            [yaml|
--- a/server/lib/api-tests/src/Test/DataConnector/MockAgent/MetadataApiSpec.hs
+++ b/server/lib/api-tests/src/Test/DataConnector/MockAgent/MetadataApiSpec.hs
@ -14,6 +14,7 @@ import Data.Vector qualified as Vector
 import Harness.Backend.DataConnector.Mock (MockRequestResults (..), mockAgentMetadataTest)
 import Harness.Backend.DataConnector.Mock qualified as Mock
 import Harness.Quoter.Yaml (yaml)
+import Harness.Quoter.Yaml.InterpolateYaml (interpolateYaml)
 import Harness.Test.BackendType qualified as BackendType
 import Harness.Test.Fixture qualified as Fixture
 import Harness.TestEnvironment (GlobalTestEnvironment, TestEnvironment, getBackendTypeConfig)
@ -58,16 +59,19 @@ tests :: SpecWith (TestEnvironment, Mock.MockAgentEnvironment)
 tests = do
  describe "MetadataAPI Mock Tests" $ do
    mockAgentMetadataTest "Should perform a template transform when calling get_source_tables" $ \testEnvironment performMetadataRequest -> do
+      let backendTypeMetadata = fromMaybe (error "Unknown backend") $ getBackendTypeConfig testEnvironment
+          backendType = BackendType.backendTypeString backendTypeMetadata
+
      sourceString <-
        BackendType.backendSourceName
          <$> getBackendTypeConfig testEnvironment
          `onNothing` assertFailure "Backend source name not found in test environment"

      let request =
-            [yaml|
-              type: get_source_tables
+            [interpolateYaml|
+              type: #{backendType}_get_source_tables
              args:
-                source: *sourceString
+                source: #{sourceString}
            |]

      MockRequestResults {..} <- performMetadataRequest Mock.chinookMock request
--- a/server/lib/test-harness/src/Harness/Backend/DataConnector/Mock.hs
+++ b/server/lib/test-harness/src/Harness/Backend/DataConnector/Mock.hs
@ -52,7 +52,7 @@ backendTypeMetadata =
    { backendType = BackendType.DataConnectorMock,
      backendSourceName = "mock",
      backendCapabilities = Nothing,
-      backendTypeString = "mock",
+      backendTypeString = "dataconnector",
      backendDisplayNameString = "mock",
      backendReleaseNameString = Nothing,
      backendServerUrl = Just "http://localhost:65006",
--- a/server/lib/test-harness/src/Harness/Backend/DataConnector/Sqlite.hs
+++ b/server/lib/test-harness/src/Harness/Backend/DataConnector/Sqlite.hs
@ -59,7 +59,7 @@ backendTypeMetadata =
        metrics: {}
        raw: {}
    |],
-      backendTypeString = "sqlite",
+      backendTypeString = "dataconnector",
      backendDisplayNameString = "Hasura SQLite (sqlite)",
      backendReleaseNameString = Nothing,
      backendServerUrl = Just "http://localhost:65007",
--- a/server/src-lib/Hasura/RQL/DDL/Schema/Source.hs
+++ b/server/src-lib/Hasura/RQL/DDL/Schema/Source.hs
@ -29,7 +29,7 @@ where

 --------------------------------------------------------------------------------

-import Control.Lens (at, (.~), (^.))
+import Control.Lens (at, (.~), (^.), (^?))
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Data.Aeson qualified as Aeson
 import Data.Aeson.Extended
@ -83,6 +83,7 @@ import Network.HTTP.Client qualified as HTTP
 import Servant.API (Union)
 import Servant.Client (BaseUrl, (//))
 import Servant.Client.Generic qualified as Servant.Client
+import Type.Reflection (eqTypeRep, typeRep, (:~~:) (HRefl))

 --------------------------------------------------------------------------------
 -- Add source
@ -344,9 +345,9 @@ runUpdateSource (UpdateSource name sourceConfig sourceCustomization healthCheckC

 --------------------------------------------------------------------------------

-newtype GetSourceTables = GetSourceTables {_gstSourceName :: Common.SourceName}
+newtype GetSourceTables (b :: BackendType) = GetSourceTables {_gstSourceName :: SourceName}

-instance FromJSON GetSourceTables where
+instance FromJSON (GetSourceTables b) where
  parseJSON = Aeson.withObject "GetSourceTables" \o -> do
    _gstSourceName <- o .: "source"
    pure $ GetSourceTables {..}
@ -354,7 +355,9 @@ instance FromJSON GetSourceTables where
 -- | Fetch a list of tables for the request data source. Currently
 -- this is only supported for Data Connectors.
 runGetSourceTables ::
-  ( CacheRM m,
+  forall b m r.
+  ( Backend b,
+    CacheRM m,
    Has (L.Logger L.Hasura) r,
    MonadReader r m,
    MonadError Error.QErr m,
@ -364,31 +367,43 @@ runGetSourceTables ::
    ProvidesNetwork m
  ) =>
  Env.Environment ->
-  GetSourceTables ->
+  GetSourceTables b ->
  m EncJSON
 runGetSourceTables env GetSourceTables {..} = do
  metadata <- Metadata.getMetadata

-  let sources = fmap Metadata.unBackendSourceMetadata $ Metadata._metaSources metadata
-      bmap = Metadata._metaBackendConfigs metadata
+  -- An unfortunate bit of type-hackery for now. Because GDCs have to make a
+  -- runtime request for their schema information (whereas native sources find
+  -- it in the metadata), we have to special-case GDCs. Eventually, we might
+  -- want to make this entirely backend-specific and implement it separately
+  -- for each backend, but it's probably not worth it while there's only one
+  -- exception.
+  case eqTypeRep (typeRep @b) (typeRep @'DataConnector) of
+    Just HRefl -> do
+      let sources = fmap Metadata.unBackendSourceMetadata $ Metadata._metaSources metadata
+          bmap = Metadata._metaBackendConfigs metadata

-  abSourceMetadata <- lookupSourceMetadata _gstSourceName sources
+      abSourceMetadata <- lookupSourceMetadata _gstSourceName sources

-  AnyBackend.dispatchAnyBackend @RQL.Types.Backend abSourceMetadata $ \Metadata.SourceMetadata {_smKind, _smConfiguration} -> do
-    case _smKind of
-      Backend.DataConnectorKind dcName -> do
-        logger :: L.Logger L.Hasura <- asks getter
-        manager <- askHTTPManager
-        let timeout = DC.Types.timeout _smConfiguration
+      AnyBackend.dispatchAnyBackend @RQL.Types.Backend abSourceMetadata $ \Metadata.SourceMetadata {_smKind, _smConfiguration} -> do
+        case _smKind of
+          Backend.DataConnectorKind dcName -> do
+            logger :: L.Logger L.Hasura <- asks getter
+            manager <- askHTTPManager
+            let timeout = DC.Types.timeout _smConfiguration

-        DC.Types.DataConnectorOptions {..} <- lookupDataConnectorOptions dcName bmap
-        configSchemaResponse <- getConfigSchemaResponse dcName
-        transformedConfig <- transformConnSourceConfig dcName _gstSourceName configSchemaResponse _smConfiguration [("$session", J.object []), ("$env", J.toJSON env)] env
-        schemaResponse <- querySourceSchema logger manager timeout _dcoUri _gstSourceName transformedConfig
+            DC.Types.DataConnectorOptions {..} <- lookupDataConnectorOptions dcName bmap
+            configSchemaResponse <- getConfigSchemaResponse dcName
+            transformedConfig <- transformConnSourceConfig dcName _gstSourceName configSchemaResponse _smConfiguration [("$session", J.object []), ("$env", J.toJSON env)] env
+            schemaResponse <- querySourceSchema logger manager timeout _dcoUri _gstSourceName transformedConfig

-        let fullyQualifiedTableNames = fmap API._tiName $ API._srTables schemaResponse
-        pure $ EncJSON.encJFromJValue fullyQualifiedTableNames
-      backend -> Error.throw500 ("Schema fetching is not supported for '" <> Text.E.toTxt backend <> "'")
+            pure $ EncJSON.encJFromJValue (fmap API._tiName $ API._srTables schemaResponse)
+          backend -> Error.throw500 ("Invalid command: " <> backend <<> " is not a data connector source.")
+    Nothing -> do
+      let maybeTables :: Maybe (Tables b)
+          maybeTables = metadata ^? metaSources . ix _gstSourceName . toSourceMetadata . smTables @b
+
+      pure $ EncJSON.encJFromJValue (foldMap InsOrdHashMap.keys maybeTables)

 --------------------------------------------------------------------------------

--- a/server/src-lib/Hasura/Server/API/Backend.hs
+++ b/server/src-lib/Hasura/Server/API/Backend.hs
@ -102,7 +102,8 @@ sourceCommands =

 tableCommands :: forall (b :: BackendType). Backend b => [CommandParser b]
 tableCommands =
-  [ commandParser "track_table" $ RMTrackTable . mkAnyBackend @b,
+  [ commandParser "get_source_tables" $ RMGetSourceTables . mkAnyBackend @b,
+    commandParser "track_table" $ RMTrackTable . mkAnyBackend @b,
    commandParser "untrack_table" $ RMUntrackTable . mkAnyBackend @b
  ]

--- a/server/src-lib/Hasura/Server/API/Metadata.hs
+++ b/server/src-lib/Hasura/Server/API/Metadata.hs
@ -56,6 +56,7 @@ import Hasura.RQL.DDL.Webhook.Transform.Validation
 import Hasura.RQL.Types.Action
 import Hasura.RQL.Types.Allowlist
 import Hasura.RQL.Types.ApiLimit
+import Hasura.RQL.Types.Backend (Backend)
 import Hasura.RQL.Types.Common
 import Hasura.RQL.Types.CustomTypes
 import Hasura.RQL.Types.Endpoint
@ -93,7 +94,7 @@ data RQLMetadataV1
  | RMUpdateSource !(AnyBackend UpdateSource)
  | RMListSourceKinds !ListSourceKinds
  | RMGetSourceKindCapabilities !GetSourceKindCapabilities
-  | RMGetSourceTables !GetSourceTables
+  | RMGetSourceTables !(AnyBackend GetSourceTables)
  | RMGetTableInfo !GetTableInfo
  | -- Tables
    RMTrackTable !(AnyBackend TrackTableV2)
@ -283,7 +284,6 @@ instance FromJSON RQLMetadataV1 where
      "dc_delete_agent" -> RMDCDeleteAgent <$> args
      "list_source_kinds" -> RMListSourceKinds <$> args
      "get_source_kind_capabilities" -> RMGetSourceKindCapabilities <$> args
-      "get_source_tables" -> RMGetSourceTables <$> args
      "get_table_info" -> RMGetTableInfo <$> args
      "set_custom_types" -> RMSetCustomTypes <$> args
      "set_api_limits" -> RMSetApiLimits <$> args
@ -658,7 +658,7 @@ runMetadataQueryV1M env currentResourceVersion = \case
  RMUpdateSource q -> dispatchMetadata runUpdateSource q
  RMListSourceKinds q -> runListSourceKinds q
  RMGetSourceKindCapabilities q -> runGetSourceKindCapabilities q
-  RMGetSourceTables q -> runGetSourceTables env q
+  RMGetSourceTables q -> dispatch (runGetSourceTables env) q
  RMGetTableInfo q -> runGetTableInfo env q
  RMTrackTable q -> dispatchMetadata runTrackTableV2Q q
  RMUntrackTable q -> dispatchMetadataAndEventTrigger runUntrackTableQ q
@ -793,6 +793,12 @@ runMetadataQueryV1M env currentResourceVersion = \case
  RMGetFeatureFlag q -> runGetFeatureFlag q
  RMBulk q -> encJFromList <$> indexedMapM (runMetadataQueryM env currentResourceVersion) q
  where
+    dispatch ::
+      (forall b. Backend b => i b -> a) ->
+      AnyBackend i ->
+      a
+    dispatch f x = dispatchAnyBackend @Backend x f
+
    dispatchMetadata ::
      (forall b. BackendMetadata b => i b -> a) ->
      AnyBackend i ->
--- a/server/src-lib/Hasura/Server/API/Metadata.hs-boot
+++ b/server/src-lib/Hasura/Server/API/Metadata.hs-boot
@ -47,7 +47,7 @@ data RQLMetadataV1
  | RMUpdateSource !(AnyBackend UpdateSource)
  | RMListSourceKinds !ListSourceKinds
  | RMGetSourceKindCapabilities !GetSourceKindCapabilities
-  | RMGetSourceTables !GetSourceTables
+  | RMGetSourceTables !(AnyBackend GetSourceTables)
  | RMGetTableInfo !GetTableInfo
  | -- Tables
    RMTrackTable !(AnyBackend TrackTableV2)