[GDC] Transform SourceConnConfig in runGetSourceTables

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7112
GitOrigin-RevId: d6ab09ba001fa8d4d33cc8f669b588459360f910

server/lib/api-tests/api-tests.cabal

@@ -89,6 +89,7 @@ library
     Test.DataConnector.MockAgent.BasicQuerySpec
     Test.DataConnector.MockAgent.CustomScalarsSpec
     Test.DataConnector.MockAgent.ErrorSpec
+    Test.DataConnector.MockAgent.MetadataApiSpec
     Test.DataConnector.MockAgent.QueryRelationshipsSpec
     Test.DataConnector.MockAgent.TransformedConfigurationSpec
     Test.DataConnector.QuerySpec

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

@@ -0,0 +1,101 @@
+{-# LANGUAGE QuasiQuotes #-}
+-- For runWithLocalTestEnvironmentSingleSetup
+{-# OPTIONS_GHC -Wno-deprecations #-}
+
+-- | Metadata API tests for Data Connector Backend
+module Test.DataConnector.MockAgent.MetadataApiSpec where
+
+--------------------------------------------------------------------------------
+
+import Control.Lens qualified as Lens
+import Data.Aeson qualified as Aeson
+import Data.Aeson.KeyMap qualified as KM
+import Data.Aeson.Lens
+import Data.IORef qualified as IORef
+import Data.List.NonEmpty qualified as NE
+import Data.Vector qualified as Vector
+import Harness.Backend.DataConnector.Mock qualified as Mock
+import Harness.GraphqlEngine qualified as GraphqlEngine
+import Harness.Quoter.Yaml (yaml)
+import Harness.Test.BackendType (defaultBackendCapabilities, defaultBackendServerUrl)
+import Harness.Test.Fixture (defaultBackendDisplayNameString, defaultBackendTypeString, defaultSource)
+import Harness.Test.Fixture qualified as Fixture
+import Harness.TestEnvironment (TestEnvironment)
+import Harness.TestEnvironment qualified as TE
+import Harness.Yaml (shouldReturnYaml, shouldReturnYamlF)
+import Hasura.Backends.DataConnector.API.V0.ConfigSchema (Config (..))
+import Hasura.Prelude
+import Test.Hspec (SpecWith, describe, it, pendingWith, shouldBe)
+
+--------------------------------------------------------------------------------
+
+spec :: SpecWith TestEnvironment
+spec =
+  Fixture.runWithLocalTestEnvironment
+    ( NE.fromList
+        [ (Fixture.fixture $ Fixture.Backend Fixture.DataConnectorMock)
+            { Fixture.mkLocalTestEnvironment = Mock.mkLocalTestEnvironment,
+              Fixture.setupTeardown = \(testEnv, mockEnv) ->
+                [Mock.setupAction sourceMetadata Mock.agentConfig (testEnv, mockEnv)]
+            }
+        ]
+    )
+    tests
+
+sourceMetadata :: Aeson.Value
+sourceMetadata =
+  let source = defaultSource Fixture.DataConnectorMock
+      backendType = defaultBackendTypeString Fixture.DataConnectorMock
+   in [yaml|
+        name : *source
+        kind: *backendType
+        tables: []
+        configuration:
+          value: {}
+          template: |
+            {
+              "DEBUG": { "test": "data" }
+            }
+      |]
+
+--------------------------------------------------------------------------------
+
+tests :: Fixture.Options -> SpecWith (TestEnvironment, Mock.MockAgentEnvironment)
+tests opts = do
+  describe "MetadataAPI Mock Tests" $ do
+    it "Should peform a template transform when calling _get_source_tables" $ \(testEnvironment, Mock.MockAgentEnvironment {maeQueryConfig}) -> do
+      let sortYamlArray :: Aeson.Value -> IO Aeson.Value
+          sortYamlArray (Aeson.Array a) = pure $ Aeson.Array (Vector.fromList (sort (Vector.toList a)))
+          sortYamlArray _ = fail "Should return Array"
+
+      case defaultSource <$> TE.backendType testEnvironment of
+        Nothing -> pendingWith "Backend not found for testEnvironment"
+        Just sourceString -> do
+          queryConfig <- IORef.readIORef maeQueryConfig
+          IORef.writeIORef maeQueryConfig Nothing
+
+          queryConfig `shouldBe` Just (Config $ KM.fromList [("DEBUG", Aeson.Object (KM.fromList [("test", Aeson.String "data")]))])
+
+          shouldReturnYamlF
+            sortYamlArray
+            opts
+            ( GraphqlEngine.postMetadata
+                testEnvironment
+                [yaml|
+                type: get_source_tables
+                args:
+                  source: *sourceString
+              |]
+            )
+            [yaml|
+              - - Album
+              - - Artist
+              - - Customer
+              - - Employee
+              - - Genre
+              - - Invoice
+              - - InvoiceLine
+              - - MediaType
+              - - MyCustomScalarsTable
+              - - Track
+            |]

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

@@ -1,6 +1,8 @@
 module Hasura.Backends.DataConnector.Adapter.ConfigTransform
   ( transformSourceConfig,
     transformConnSourceConfig,
+    validateConfiguration,
+    getConfigSchemaResponse,
   )
 where
 
@@ -9,15 +11,22 @@ where
 import Data.Aeson qualified as J
 import Data.Aeson.Kriti.Functions qualified as KFunc
 import Data.Environment qualified as Env
-import Data.HashMap.Strict qualified as M
-import Data.Text qualified as T
+import Data.HashMap.Strict qualified as HashMap
+import Data.Text qualified as Text
+import Data.Text.Extended qualified as Text
 import Hasura.Backends.DataConnector.API qualified as API
 import Hasura.Backends.DataConnector.Adapter.Types (ConnSourceConfig (ConnSourceConfig, template, value), SourceConfig (..))
-import Hasura.Base.Error (Code (NotSupported), QErr, throw400)
+import Hasura.Backends.DataConnector.Adapter.Types qualified as DC
+import Hasura.Base.Error (Code (DataConnectorError, NotSupported), QErr, throw400)
 import Hasura.Prelude
+import Hasura.RQL.Types.Common as Common
+import Hasura.RQL.Types.SchemaCache
+import Hasura.SQL.Backend qualified as Backend
 import Kriti.Error qualified as Kriti
 
-transformConfig :: (MonadError QErr m) => API.Config -> Maybe Text -> [(T.Text, J.Value)] -> Env.Environment -> m API.Config
+--------------------------------------------------------------------------------
+
+transformConfig :: (MonadError QErr m) => API.Config -> Maybe Text -> [(Text, J.Value)] -> Env.Environment -> m API.Config
 transformConfig config maybeTemplate scope env = do
   case maybeTemplate of
     Nothing -> pure config
@@ -27,13 +36,53 @@ transformConfig config maybeTemplate scope env = do
         Right (J.Object r) -> pure $ API.Config r
         Right o -> throw400 NotSupported $ "transformConfig: Kriti did not decode into Object - " <> tshow o
 
-transformSourceConfig :: (MonadError QErr m) => SourceConfig -> [(T.Text, J.Value)] -> Env.Environment -> m SourceConfig
+transformSourceConfig :: (MonadError QErr m) => SourceConfig -> [(Text, J.Value)] -> Env.Environment -> m SourceConfig
 transformSourceConfig sc@SourceConfig {_scConfig, _scTemplate} scope env = do
   transformedConfig <- transformConfig _scConfig _scTemplate scope env
   pure sc {_scConfig = transformedConfig}
 
-transformConnSourceConfig :: (MonadError QErr m) => ConnSourceConfig -> [(T.Text, J.Value)] -> Env.Environment -> m API.Config
+transformConnSourceConfig :: (MonadError QErr m) => ConnSourceConfig -> [(Text, J.Value)] -> Env.Environment -> m API.Config
 transformConnSourceConfig ConnSourceConfig {value, template} scope env = transformConfig value template scope env
 
-additionalFunctions :: Env.Environment -> M.HashMap T.Text (J.Value -> Either Kriti.CustomFunctionError J.Value)
+--------------------------------------------------------------------------------
+
+-- | Given a 'DC.DataConnectorName' fetch the associated
+-- 'DC.DataConnectorInfo' from the SchemaCache.
+getDataConnectorInfo' :: CacheRM m => DC.DataConnectorName -> m (Maybe DC.DataConnectorInfo)
+getDataConnectorInfo' dataConnectorName = do
+  bmap <- getBackendInfo @'Backend.DataConnector
+  pure $ bmap >>= HashMap.lookup dataConnectorName
+
+-- | Given a 'DC.DataConnectorName' fetch the associated
+-- 'DC.DataConnectorInfo' from the SchemaCache. Lookup failures are
+-- pushed into 'MonadError QErr m'.
+getDataConnectorInfo :: (CacheRM m, MonadError QErr m) => DC.DataConnectorName -> m DC.DataConnectorInfo
+getDataConnectorInfo dataConnectorName = do
+  onNothingM (getDataConnectorInfo' dataConnectorName) $
+    throw400 DataConnectorError ("Data connector named " <> Text.dquote dataConnectorName <> " was not found in the data connector backend info")
+
+-- | Given a 'DC.DataConnectorName' fetch the associated
+-- 'API.ConfigSchemaResponse' from the SchemaCache. Lookup failures
+-- are pushed into 'MonadError QErr m'.
+getConfigSchemaResponse :: (CacheRM m, MonadError QErr m) => DC.DataConnectorName -> m API.ConfigSchemaResponse
+getConfigSchemaResponse = fmap DC._dciConfigSchemaResponse . getDataConnectorInfo
+
+--------------------------------------------------------------------------------
+
+validateConfiguration ::
+  MonadError QErr m =>
+  Common.SourceName ->
+  DC.DataConnectorName ->
+  API.ConfigSchemaResponse ->
+  API.Config ->
+  m ()
+validateConfiguration sourceName dataConnectorName configSchema config = do
+  let errors = API.validateConfigAgainstConfigSchema configSchema config
+  unless (null errors) $
+    let errorsText = Text.unlines (("- " <>) . Text.pack <$> errors)
+     in throw400
+          DataConnectorError
+          ("Configuration for source " <> Text.dquote sourceName <> " is not valid based on the configuration schema declared by the " <> Text.dquote dataConnectorName <> " data connector agent. Errors:\n" <> errorsText)
+
+additionalFunctions :: Env.Environment -> HashMap Text (J.Value -> Either Kriti.CustomFunctionError J.Value)
 additionalFunctions env = KFunc.environmentFunctions env

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

@@ -15,13 +15,12 @@ import Data.HashMap.Strict.NonEmpty qualified as NEHashMap
 import Data.HashSet qualified as HashSet
 import Data.Sequence qualified as Seq
 import Data.Sequence.NonEmpty qualified as NESeq
-import Data.Text qualified as Text
 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.ErrorResponse (_crDetails)
 import Hasura.Backends.DataConnector.Adapter.Backend (columnTypeToScalarType)
-import Hasura.Backends.DataConnector.Adapter.ConfigTransform (transformConnSourceConfig)
+import Hasura.Backends.DataConnector.Adapter.ConfigTransform (transformConnSourceConfig, validateConfiguration)
 import Hasura.Backends.DataConnector.Adapter.Types qualified as DC
 import Hasura.Backends.DataConnector.Agent.Client (AgentClientContext (..), runAgentClientT)
 import Hasura.Backends.Postgres.SQL.Types (PGDescription (..))
@@ -145,12 +144,10 @@ resolveSourceConfig'
   backendInfo
   env
   manager = runExceptT do
-    DC.DataConnectorInfo {DC._dciOptions = DC.DataConnectorOptions {..}, ..} <-
-      Map.lookup dataConnectorName backendInfo
-        `onNothing` throw400 DataConnectorError ("Data connector named " <> toTxt dataConnectorName <<> " was not found in the data connector backend info")
+    DC.DataConnectorInfo {..} <- getDataConnectorInfo dataConnectorName backendInfo
+    let DC.DataConnectorOptions {_dcoUri} = _dciOptions
 
     transformedConfig <- transformConnSourceConfig csc [("$session", J.object []), ("$env", J.toJSON env)] env
-
     validateConfiguration sourceName dataConnectorName _dciConfigSchemaResponse transformedConfig
 
     schemaResponseU <-
@@ -174,20 +171,10 @@ resolveSourceConfig'
           _scDataConnectorName = dataConnectorName
         }
 
-validateConfiguration ::
-  MonadError QErr m =>
-  SourceName ->
-  DC.DataConnectorName ->
-  API.ConfigSchemaResponse ->
-  API.Config ->
-  m ()
-validateConfiguration sourceName dataConnectorName configSchema config = do
-  let errors = API.validateConfigAgainstConfigSchema configSchema config
-  unless (null errors) $
-    let errorsText = Text.unlines (("- " <>) . Text.pack <$> errors)
-     in throw400
-          DataConnectorError
-          ("Configuration for source " <> sourceName <<> " is not valid based on the configuration schema declared by the " <> dataConnectorName <<> " data connector agent. Errors:\n" <> errorsText)
+getDataConnectorInfo :: (MonadError QErr m) => DC.DataConnectorName -> HashMap DC.DataConnectorName DC.DataConnectorInfo -> m DC.DataConnectorInfo
+getDataConnectorInfo dataConnectorName backendInfo =
+  onNothing (Map.lookup dataConnectorName backendInfo) $
+    throw400 DataConnectorError ("Data connector named " <> toTxt dataConnectorName <<> " was not found in the data connector backend info")
 
 resolveDatabaseMetadata' ::
   Applicative m =>

server/src-lib/Hasura/RQL/DDL/Schema/Source.hs

@@ -36,6 +36,7 @@ import Data.Aeson qualified as Aeson
 import Data.Aeson.Extended
 import Data.Aeson.Extended qualified as J
 import Data.Aeson.TH
+import Data.Environment qualified as Env
 import Data.Has
 import Data.HashMap.Strict qualified as HM
 import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
@@ -45,6 +46,7 @@ import Data.Text.Extended qualified as Text.E
 import Hasura.Backends.DataConnector.API (errorResponseSummary, schemaCase)
 import Hasura.Backends.DataConnector.API qualified as API
 import Hasura.Backends.DataConnector.API.V0.ErrorResponse (_crDetails)
+import Hasura.Backends.DataConnector.Adapter.ConfigTransform (getConfigSchemaResponse, transformConnSourceConfig, validateConfiguration)
 import Hasura.Backends.DataConnector.Adapter.Types qualified as DC.Types
 import Hasura.Backends.DataConnector.Agent.Client qualified as Agent.Client
 import Hasura.Base.Error
@@ -339,16 +341,18 @@ instance FromJSON GetSourceTables where
 -- | Fetch a list of tables for the request data source. Currently
 -- this is only supported for Data Connectors.
 runGetSourceTables ::
-  ( Has (L.Logger L.Hasura) r,
+  ( CacheRM m,
+    Has (L.Logger L.Hasura) r,
     HTTP.Manager.HasHttpManagerM m,
     MonadReader r m,
     MonadError Error.QErr m,
     Metadata.MetadataM m,
     MonadIO m
   ) =>
+  Env.Environment ->
   GetSourceTables ->
   m EncJSON
-runGetSourceTables GetSourceTables {..} = do
+runGetSourceTables env GetSourceTables {..} = do
   metadata <- Metadata.getMetadata
 
   let sources = fmap Metadata.unBackendSourceMetadata $ Metadata._metaSources metadata
@@ -364,7 +368,6 @@ runGetSourceTables GetSourceTables {..} = do
         logger :: L.Logger L.Hasura <- asks getter
         manager <- HTTP.Manager.askHttpManager
         let timeout = DC.Types.timeout _smConfiguration
-            apiConfig = DC.Types.value _smConfiguration
 
         DC.Types.DataConnectorOptions {..} <- do
           let backendConfig = Metadata.unBackendConfigWrapper <$> BackendMap.lookup @'Backend.DataConnector bmap
@@ -372,10 +375,14 @@ runGetSourceTables GetSourceTables {..} = do
             (InsOrdHashMap.lookup dcName =<< backendConfig)
             (Error.throw400 Error.DataConnectorError ("Data connector named " <> Text.E.toTxt dcName <> " was not found in the data connector backend config"))
 
+        transformedConfig <- transformConnSourceConfig _smConfiguration [("$session", J.object []), ("$env", J.toJSON env)] env
+        configSchemaResponse <- getConfigSchemaResponse dcName
+        validateConfiguration _gstSourceName dcName configSchemaResponse transformedConfig
+
         schemaResponse <-
           Tracing.runTraceTWithReporter Tracing.noReporter "resolve source"
             . flip Agent.Client.runAgentClientT (Agent.Client.AgentClientContext logger _dcoUri manager (DC.Types.sourceTimeoutMicroseconds <$> timeout))
-            $ schemaGuard =<< (Servant.Client.genericClient // API._schema) (Text.E.toTxt _gstSourceName) apiConfig
+            $ schemaGuard =<< (Servant.Client.genericClient // API._schema) (Text.E.toTxt _gstSourceName) transformedConfig
 
         let fullyQualifiedTableNames = fmap API._tiName $ API._srTables schemaResponse
         pure $ EncJSON.encJFromJValue fullyQualifiedTableNames

server/src-lib/Hasura/RQL/Types/SchemaCache.hs

@@ -104,6 +104,7 @@ module Hasura.RQL.Types.SchemaCache
     getOpExpDeps,
     BackendInfoWrapper (..),
     BackendCache,
+    getBackendInfo,
   )
 where
 
@@ -149,7 +150,8 @@ import Hasura.RemoteSchema.Metadata
 import Hasura.RemoteSchema.SchemaCache.Types
 import Hasura.SQL.AnyBackend qualified as AB
 import Hasura.SQL.Backend
-import Hasura.SQL.BackendMap
+import Hasura.SQL.BackendMap (BackendMap)
+import Hasura.SQL.BackendMap qualified as BackendMap
 import Hasura.SQL.Tag (HasTag (backendTag), reify)
 import Hasura.Server.Types
 import Hasura.Session
@@ -465,6 +467,9 @@ deriving newtype instance (Monoid (BackendInfo b)) => Monoid (BackendInfoWrapper
 
 type BackendCache = BackendMap BackendInfoWrapper
 
+getBackendInfo :: forall b m. (CacheRM m, HasTag b) => m (Maybe (BackendInfo b))
+getBackendInfo = askSchemaCache <&> fmap unBackendInfoWrapper . BackendMap.lookup @b . scBackendCache
+
 -------------------------------------------------------------------------------
 
 data SchemaCache = SchemaCache

server/src-lib/Hasura/Server/API/Metadata.hs

@@ -606,7 +606,7 @@ runMetadataQueryV1M env currentResourceVersion = \case
   RMUpdateSource q -> dispatchMetadata runUpdateSource q
   RMListSourceKinds q -> runListSourceKinds q
   RMGetSourceKindCapabilities q -> runGetSourceKindCapabilities q
-  RMGetSourceTables q -> runGetSourceTables q
+  RMGetSourceTables q -> runGetSourceTables env q
   RMGetTableInfo q -> runGetTableInfo q
   RMTrackTable q -> dispatchMetadata runTrackTableV2Q q
   RMUntrackTable q -> dispatchMetadataAndEventTrigger runUntrackTableQ q