Fix metadata defaults bug - Defaults serialised into metadata table - GDC-647

## Description

There is a bug in the metadata defaults code, see [the original PR](https://github.com/hasura/graphql-engine-mono/pull/6286).

Steps to reproduce this issue:

* Start a new HGE project
* Start HGE with a defaults argument: `HASURA_GRAPHQL_LOG_LEVEL=debug cabal run exe:graphql-engine -- serve --enable-console --console-assets-dir=./console/static/dist --metadata-defaults='{"backend_configs": {"dataconnector": {"mongo": {"display_name": "BONGOBB", "uri": "http://localhost:8123"}}}}'`
* Add a source (doesn't need to be related to the defaults)
* Export metadata
* See that the defaults are present in the exported metadata

## Related Issues

* Github Issue: https://github.com/hasura/graphql-engine/issues/9237
* Jira: https://hasurahq.atlassian.net/browse/GDC-647
* Original PR: https://github.com/hasura/graphql-engine-mono/pull/6286

## Solution

* The test for if defaults should be included for metadata api operations has been extended to check for updates
* Metadata inconsistencies have been hidden for `/capabilities` calls on startup

## TODO

* [x] Fix bug
* [x] Write tests
* [x] OSS Metadata Migration to correct persisted data - `server/src-rsr/migrations/47_to_48.sql`
* [x] Cloud Metadata Migration - `pro/server/res/cloud/migrations/6_to_7.sql`
* [x] Bump Catalog Version - `server/src-rsr/catalog_version.txt`
* [x] Update Catalog Versions - `server/src-rsr/catalog_versions.txt` (This will be done by Infra when creating a release)
* [x] Log connection error as it occurs *(Already being logged. Requires `--enabled-log-types startup,webhook-log,websocket-log,http-log,data-connector-log`)
* [x] Don't mark metadata inconsistencies for this call.

## Questions

* [ ] Does the `pro/server/res/cloud/migrations/6_to_7.sql` cover the cloud scenarios?
* [ ] Should we have `SET search_path` in migrations?
* [x] What should be in `server/src-rsr/catalog_versions.txt`?

## Testing

To test the solution locally run:

> docker compose up -d

and

> cabal run  -- exe:api-tests --skip BigQuery --skip SQLServer --skip '/Test.API.Explain/Postgres/'

## Solution

In `runMetadataQuery` in `server/src-lib/Hasura/Server/API/Metadata.hs`:

```diff
-        if (exportsMetadata _rqlMetadata)
+        if (exportsMetadata _rqlMetadata || queryModifiesMetadata _rqlMetadata)
```

This ensures that defaults aren't present in operations that serialise metadata.

Note: You might think that `X_add_source` would need the defaults to be present to add a source that references the defaults, but since the resolution occurs in the schema-cache building phase, the defaults can be excluded for the metadata modifications required for `X_add_source`.

In addition to the code-change, a metadata migration has been introduced in order to clean up serialised defaults.

The following scenarios need to be considered for both OSS and Cloud:

* The user has not had defaults serialised
* The user has had the defaults serialised and no other backends configured
* The user has had the defaults serialised and has also configured other backends

We want to remove as much of the metadata as possible without any user-specified data and this should be reflected in migration `server/src-rsr/migrations/47_to_48.sql`.

## Server checklist

### Catalog upgrade

Does this PR change Hasura Catalog version?
- ✅ Yes

### Metadata
Does this PR add a new Metadata feature?
- ✅ No

### GraphQL
- ✅ No new GraphQL schema is generated

### Breaking changes
- ✅ No Breaking changes

## Changelog

__Component__ : server
__Type__: bugfix
__Product__: community-edition

### Short Changelog

Fixes a metadata defaults serialization bug and introduces a metadata migration to correct data that has been persisted due to the bug.

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

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

@@ -69,6 +69,7 @@ library
     Test.API.ExplainSpec
     Test.API.Metadata.ComputedFieldsSpec
     Test.API.Metadata.InconsistentSpec
+    Test.API.Metadata.TransparentDefaultsSpec
     Test.API.Schema.RunSQLSpec
     Test.Auth.Authorization.DisableRootFields.Common
     Test.Auth.Authorization.DisableRootFields.DefaultRootFieldsSpec
@@ -185,6 +186,7 @@ library
 
 executable api-tests
   build-depends:
+    , lens-aeson
     , api-tests
     , base
     , hspec

server/lib/api-tests/src/Test/API/Metadata/TransparentDefaultsSpec.hs

@@ -0,0 +1,117 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Test.API.Metadata.TransparentDefaultsSpec (spec) where
+
+import Control.Lens qualified as CL
+import Data.Aeson (Value (Object))
+import Data.Aeson.Lens qualified as AL
+import Data.List.NonEmpty qualified as NE
+import Harness.Backend.Postgres qualified as Postgres
+import Harness.GraphqlEngine (postMetadata, postMetadata_)
+import Harness.Quoter.Yaml
+import Harness.Test.BackendType qualified as BT
+import Harness.Test.Fixture qualified as Fixture
+import Harness.TestEnvironment
+import Hasura.Prelude
+import Test.Hspec
+
+spec :: SpecWith GlobalTestEnvironment
+spec =
+  Fixture.run
+    ( NE.fromList
+        [ (Fixture.fixture $ Fixture.Backend Postgres.backendTypeMetadata)
+            { Fixture.setupTeardown = \(testEnvironment, _) ->
+                [ setupMetadata testEnvironment
+                ]
+            }
+        ]
+    )
+    tests
+
+tests :: Fixture.Options -> SpecWith TestEnvironment
+tests _ = do
+  describe "properties of metadata in the presence of defaults" do
+    describe "without metadata modifications" do
+      -- Note that this requires that the foobar agent is running. Reuses sqlite service.
+      it "includes defaults in list_source_kinds" \testEnvironment -> do
+        response <- postMetadata testEnvironment listSourceKinds
+        let response' = response CL.^.. AL.key "sources" . AL._Array . CL.folded . CL.filtered (\x -> (x CL.^? AL.key "kind") == Just "foobar")
+            expected =
+              [yaml|
+            builtin: false
+            display_name: "FOOBARDB (foobar)"
+            kind: foobar
+          |]
+        response' `shouldBe` [expected]
+
+      it "does not include defaults on stand alone export" \testEnvironment -> do
+        response <- postMetadata testEnvironment exportMetadata
+        let response' = Object $ response CL.^. AL.key "metadata" . AL._Object & CL.sans "sources"
+            expected = [yaml| version: 3 |] -- Doesn't include defaults
+        response' `shouldBe` expected
+
+    describe "with metadata modifications" do
+      it "does not include defaults on stand alone export" \testEnvironment -> do
+        addSourceResults <- postMetadata testEnvironment addSource
+        addSourceResults `shouldBe` [yaml| message: success |]
+
+        response <- postMetadata testEnvironment exportMetadata
+        let response' = Object $ response CL.^. AL.key "metadata" . AL._Object & CL.sans "sources"
+            expected = [yaml| version: 3 |] -- Shouldn't include defaults
+        response' `shouldBe` expected
+
+exportMetadata :: Value
+exportMetadata =
+  [yaml|
+    type: export_metadata
+    version: 2
+    args: {}
+  |]
+
+-- Only works if the defaults are applied.
+addSource :: Value
+addSource =
+  [yaml|
+    type: foobar_add_source
+    args:
+      driver: foobar
+      name: myfoobar
+      replace_configuration: false
+      configuration:
+        db: /db.chinook.sqlite
+  |]
+
+listSourceKinds :: Value
+listSourceKinds =
+  [yaml|
+    type: list_source_kinds
+    version: 1
+    args: {}
+  |]
+
+setupMetadata :: TestEnvironment -> Fixture.SetupAction
+setupMetadata testEnvironment = do
+  let sourceName = BT.backendSourceName btc
+      sourceConfiguration = Postgres.defaultSourceConfiguration testEnvironment
+      btc = fromMaybe (error "Couldn't find backendTypeConfig") (backendTypeConfig testEnvironment)
+
+      setup :: IO ()
+      setup =
+        postMetadata_
+          testEnvironment
+          [yaml|
+            type: replace_metadata
+            args:
+              metadata:
+                version: 3
+                sources:
+                  - name: *sourceName
+                    kind: postgres
+                    tables: []
+                    configuration: *sourceConfiguration
+          |]
+
+      teardown :: IO ()
+      teardown = setup
+
+  Fixture.SetupAction setup \_ -> teardown

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

@@ -229,6 +229,9 @@ schemaCrudTests opts = describe "A series of actions to setup and teardown a sou
               - builtin: false
                 kind: *backendString
                 display_name: *backendDisplayName
+              - builtin: false
+                display_name: "FOOBARDB (foobar)"
+                kind: foobar
             |]
 
   describe "<kind>_add_source" $ do

server/lib/test-harness/src/Harness/GraphqlEngine.hs

@@ -44,7 +44,8 @@ where
 
 import Control.Concurrent.Async qualified as Async
 import Control.Monad.Trans.Managed (ManagedT (..), lowerManagedT)
-import Data.Aeson
+-- import Hasura.RQL.Types.Metadata (emptyMetadataDefaults)
+import Data.Aeson (Value, fromJSON, object, (.=))
 import Data.Aeson.Encode.Pretty as AP
 import Data.Aeson.Types (Pair)
 import Data.Environment qualified as Env
@@ -54,7 +55,7 @@ import Harness.Constants qualified as Constants
 import Harness.Exceptions (bracket, withFrozenCallStack)
 import Harness.Http qualified as Http
 import Harness.Logging
-import Harness.Quoter.Yaml (yaml)
+import Harness.Quoter.Yaml (fromYaml, yaml)
 import Harness.TestEnvironment (Server (..), TestEnvironment (..), getServer, serverUrl, testLogMessage)
 import Hasura.App (Loggers (..), ServeCtx (..))
 import Hasura.App qualified as App
@@ -267,8 +268,21 @@ startServerThread :: IO Server
 startServerThread = do
   port <- bracket (Warp.openFreePort) (Socket.close . snd) (pure . fst)
   let urlPrefix = "http://127.0.0.1"
+      backendConfigs =
+        [fromYaml|
+        backend_configs:
+          dataconnector:
+            foobar:
+              display_name: FOOBARDB
+              uri: "http://localhost:65007" |]
   thread <-
-    Async.async (runApp Constants.serveOptions {soPort = unsafePort port})
+    Async.async
+      ( runApp
+          Constants.serveOptions
+            { soPort = unsafePort port,
+              soMetadataDefaults = backendConfigs
+            }
+      )
   let server = Server {port = fromIntegral port, urlPrefix, thread}
   Http.healthCheck (serverUrl server)
   pure server

server/lib/test-harness/src/Harness/Quoter/Yaml.hs

@@ -5,6 +5,7 @@
 -- | Templating yaml files.
 module Harness.Quoter.Yaml
   ( yaml,
+    fromYaml,
     interpolateYaml,
     ToYamlString (..),
   )
@@ -48,6 +49,25 @@ yaml =
       quoteDec = \_ -> fail "invalid"
     }
 
+-- | Combines `yaml` with `fromJson` for convenience.
+fromYaml :: QuasiQuoter
+fromYaml =
+  QuasiQuoter
+    { quoteExp = templateFromYaml,
+      quotePat = \_ -> fail "invalid",
+      quoteType = \_ -> fail "invalid",
+      quoteDec = \_ -> fail "invalid"
+    }
+
+templateFromYaml :: String -> Q Exp
+templateFromYaml inputString = do
+  e <- templateYaml inputString
+  [|
+    case fromJSON ($(pure e)) of
+      Aeson.Error err -> error err
+      Aeson.Success s -> s
+    |]
+
 -- | Template a YAML file contents. Throws a bunch of exception types:
 --  'YamlTemplateException' or 'YamlException' or 'ParseException'.
 --

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

@@ -24,7 +24,7 @@ import Hasura.Backends.DataConnector.Adapter.ConfigTransform (transformConnSourc
 import Hasura.Backends.DataConnector.Adapter.Types qualified as DC
 import Hasura.Backends.DataConnector.Agent.Client (AgentClientContext (..), runAgentClientT)
 import Hasura.Backends.Postgres.SQL.Types (PGDescription (..))
-import Hasura.Base.Error (Code (..), QErr, decodeValue, throw400, throw400WithDetail, throw500, withPathK)
+import Hasura.Base.Error (Code (..), QErr (..), decodeValue, throw400, throw400WithDetail, throw500, withPathK)
 import Hasura.Incremental qualified as Inc
 import Hasura.Incremental.Select qualified as Inc
 import Hasura.Logging (Hasura, Logger)

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

@@ -60,8 +60,8 @@ runRequestAcceptStatus' acceptStatus req = do
   (tracedReq, responseOrException) <- tracedHttpRequest transformableReq' (\tracedReq -> fmap (tracedReq,) . liftIO . try @HTTP.HttpException $ TransformableHTTP.performRequest tracedReq _accHttpManager)
   logAgentRequest _accLogger tracedReq responseOrException
   case responseOrException of
-    Left ex ->
-      throw500 $ "Error in Data Connector backend: " <> Hasura.HTTP.serializeHTTPExceptionMessage (Hasura.HTTP.HttpException ex)
+    -- throwConnectionError is used here in order to avoid a metadata inconsistency error
+    Left ex -> throwConnectionError $ "Error in Data Connector backend: " <> Hasura.HTTP.serializeHTTPExceptionMessage (Hasura.HTTP.HttpException ex)
     Right response -> do
       let status = TransformableHTTP.responseStatus response
           servantResponse = clientResponseToResponse id response

server/src-lib/Hasura/Base/Error.hs

@@ -27,6 +27,7 @@ module Hasura.Base.Error
     throw429,
     throw500,
     throw500WithDetail,
+    throwConnectionError,
     throw401,
     iResultToMaybe,
     -- Aeson helpers
@@ -74,6 +75,7 @@ data Code
   | BigQueryError
   | Busy
   | ConcurrentUpdate
+  | ConnectionNotEstablished
   | CoercionError
   | Conflict
   | ConstraintError
@@ -121,6 +123,7 @@ instance ToJSON Code where
     BigQueryError -> "bigquery-error"
     Busy -> "busy"
     ConcurrentUpdate -> "concurrent-update"
+    ConnectionNotEstablished -> "connection-not-established"
     CoercionError -> "coercion-error"
     Conflict -> "conflict"
     ConstraintError -> "constraint-error"
@@ -171,12 +174,14 @@ data QErr = QErr
 data QErrExtra
   = ExtraExtensions Value
   | ExtraInternal Value
+  | HideInconsistencies
   deriving (Eq)
 
 instance ToJSON QErrExtra where
   toJSON = \case
     ExtraExtensions v -> v
     ExtraInternal v -> v
+    HideInconsistencies -> Null
 
 instance ToJSON QErr where
   toJSON (QErr jPath _ msg code Nothing) =
@@ -189,6 +194,7 @@ instance ToJSON QErr where
     case extra of
       ExtraInternal e -> err ++ ["internal" .= e]
       ExtraExtensions {} -> err
+      HideInconsistencies -> []
     where
       err =
         [ "path" .= encodeJSONPath jPath,
@@ -233,6 +239,7 @@ encodeGQLErr includeInternal (QErr jPath _ msg code maybeExtra) =
       Just (ExtraExtensions v) -> v
       Just (ExtraInternal v) ->
         object $ appendIf includeInternal codeAndPath ["internal" .= v]
+      Just HideInconsistencies -> Null
     codeAndPath =
       [ "path" .= encodeJSONPath jPath,
         "code" .= code
@@ -325,6 +332,14 @@ throw500WithDetail :: (QErrM m) => Text -> Value -> m a
 throw500WithDetail t detail =
   throwError $ (err500 Unexpected t) {qeInternal = Just $ ExtraInternal detail}
 
+throwConnectionError :: (QErrM m) => Text -> m a
+throwConnectionError t =
+  throwError $
+    (err500 Unexpected t)
+      { qeInternal = Just HideInconsistencies,
+        qeCode = ConnectionNotEstablished
+      }
+
 modifyQErr ::
   (QErrM m) =>
   (QErr -> QErr) ->

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

@@ -131,6 +131,8 @@ withRecordInconsistencyM metadataObject f = do
           recordInconsistencyM (Just (toJSON exts)) metadataObject "withRecordInconsistency: unexpected ExtraExtensions"
         Just (ExtraInternal internal) ->
           recordInconsistencyM (Just (toJSON internal)) metadataObject (qeError err)
+        Just HideInconsistencies ->
+          pure ()
         Nothing ->
           recordInconsistencyM Nothing metadataObject (qeError err)
       return Nothing
@@ -154,6 +156,8 @@ withRecordInconsistency f = proc (e, (metadataObject, s)) -> do
           recordInconsistency -< ((Just (toJSON exts), metadataObject), "withRecordInconsistency: unexpected ExtraExtensions")
         Just (ExtraInternal internal) ->
           recordInconsistency -< ((Just (toJSON internal), metadataObject), qeError err)
+        Just HideInconsistencies ->
+          returnA -< ()
         Nothing ->
           recordInconsistency -< ((Nothing, metadataObject), qeError err)
       returnA -< Nothing

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

@@ -385,7 +385,22 @@ runMetadataQuery env logger instanceId userInfo httpManager serverConfigCtx sche
         RMV2 (RMV2ExportMetadata _) -> True
         _ -> False
       metadataDefaults =
-        if (exportsMetadata _rqlMetadata)
+        -- Note: The following check is performed to determine if the metadata defaults can
+        --       be safely merged into the reader at this point.
+        --
+        -- We want to prevent scenarios:
+        -- \* Exporting defaults - Contradicting the "roundtrip" principle of metadata operations
+        -- \* Serializing defaults into the metadata storage - Putting data into the users hdb_catalog
+        --
+        -- While this check does have the desired effect it relies on the fact that the only
+        -- operations that need access to the defaults here do not export or modify metadata.
+        -- If at some point in future an operation needs access to the defaults and also needs to
+        -- export/modify metadata, then another approach will need to be taken.
+        --
+        -- Luckily, most actual need for defaults access exists within the schema cache build phase,
+        -- so metadata operations don't need "smarts" that require defaults access.
+        --
+        if (exportsMetadata _rqlMetadata || queryModifiesMetadata _rqlMetadata)
           then emptyMetadataDefaults
           else _sccMetadataDefaults serverConfigCtx
   ((r, modMetadata), modSchemaCache, cacheInvalidations) <-

server/src-rsr/catalog_version.txt

@@ -1 +1 @@
-47
+48

server/src-rsr/migrations/47_to_48.sql

@@ -0,0 +1,40 @@
+-- Incorrect serialization of the metadata defaults in the metadata table is removed in this migration.
+
+-- This helper function is required since the jsonb '-' operator only became available in pg15.
+CREATE OR REPLACE FUNCTION hdb_catalog.remove_json_key__(
+  IN object jsonb, 
+  IN key_to_delete text, 
+  OUT jsonb
+)
+  IMMUTABLE
+  STRICT
+  LANGUAGE SQL
+AS 
+$$
+  SELECT jsonb_object_agg(key, value)
+     FROM (SELECT key, value 
+           FROM jsonb_each(object)
+           WHERE
+            key <> key_to_delete
+     ) each_subselect
+$$
+;
+
+-- One issue with this could be that a user may have already set a backend config in their metadata.
+-- To prevent this we only remove the backend_config if it already matches the given athena value.
+UPDATE hdb_catalog.hdb_metadata
+  SET metadata = hdb_catalog.remove_json_key__(
+    metadata :: jsonb,
+    'backend_configs' :: text
+  )
+  WHERE
+    ((metadata #> '{backend_configs,dataconnector}') :: jsonb)
+    =
+    ('{"athena": {"uri": "http://localhost:8081/api/v1/athena"}}' :: jsonb)
+  ;
+
+DROP FUNCTION IF EXISTS hdb_catalog.remove_json_key__(
+  IN object jsonb, 
+  IN key_to_delete text, 
+  OUT jsonb
+);

server/src-rsr/migrations/48_to_47.sql

@@ -0,0 +1,7 @@
+-- This backwards migration is empty due to 47 to 48 smiply fixing a piece of data in metadata.
+
+DROP FUNCTION IF EXISTS hdb_catalog.remove_json_key__(
+  IN object jsonb, 
+  IN key_to_delete text, 
+  OUT jsonb
+);