Fix source metadata getting erased if the source is inconsistent when…

… the source update is performed

PR-URL: hasura/graphql-engine-mono#11133
GitOrigin-RevId: 3dc258190dd97de7f26f6885f190d9f552d507ca

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

@@ -6,7 +6,7 @@ import Data.Aeson (Value)
 import Data.List.NonEmpty qualified as NE
 import Data.Maybe qualified as Maybe
 import Harness.Backend.Postgres qualified as Postgres
-import Harness.GraphqlEngine (postMetadata, postMetadata_)
+import Harness.GraphqlEngine (postMetadata, postMetadataWithStatus, postMetadata_)
 import Harness.Quoter.Yaml
 import Harness.Schema qualified as Schema
 import Harness.Test.BackendType qualified as BackendType
@@ -121,6 +121,27 @@ tests = do
           inconsistent_objects: []
         |]
 
+  describe "updating a source that is already inconsistent" do
+    it "should fail to update the source" \testEnvironment -> do
+      let shouldReturnYaml :: IO Value -> Value -> IO ()
+          shouldReturnYaml = Yaml.shouldReturnYaml testEnvironment
+
+      _ <- postMetadata testEnvironment (setupMetadataWithInconsistentSource testEnvironment)
+
+      postMetadataWithStatus 400 testEnvironment (addSourceWithIncorrectConnectionString testEnvironment)
+        `shouldReturnYaml` [yaml|
+          code: invalid-configuration
+          error: "Inconsistent object: connection error"
+          internal:
+          - definition: postgres
+            message: |
+              missing "=" after "postgresbusted://postgres:postgres@postgres:5432/another_non_existent_db" in connection info string
+            name: source postgres
+            reason: "Inconsistent object: connection error"
+            type: source
+          path: $.args
+        |]
+
 reloadMetadata :: Value
 reloadMetadata =
   [yaml|
@@ -179,6 +200,22 @@ setupMetadataWithInconsistentSource testEnvironment =
     schemaName = Schema.getSchemaName testEnvironment
     tableName = Schema.tableName table
 
+addSourceWithIncorrectConnectionString :: TestEnvironment -> Value
+addSourceWithIncorrectConnectionString testEnvironment =
+  [yaml|
+    type: pg_add_source
+    args:
+      name: *sourceName
+      configuration:
+        connection_info:
+          database_url: postgresbusted://postgres:postgres@postgres:5432/another_non_existent_db
+          pool_settings: {}
+      replace_configuration: true
+  |]
+  where
+    backendTypeMetadata = Maybe.fromMaybe (error "Unknown backend") $ getBackendTypeConfig testEnvironment
+    sourceName = Fixture.backendSourceName backendTypeMetadata
+
 repaceMetadataRemoveInconsistentSource :: Value
 repaceMetadataRemoveInconsistentSource =
   [yaml|

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

@@ -111,15 +111,18 @@ runAddSource ::
   AddSource b ->
   m EncJSON
 runAddSource env (AddSource name backendKind sourceConfig replaceConfiguration sourceCustomization healthCheckConfig) = do
-  sources <- scSources <$> askSchemaCache
+  -- Get the sources from metadata so that we can check if this is an update or a create operatoion;
+  -- it is important that this is from metadata directly and not from the schema cache because
+  -- the schema cache will not contain the source if it is inconsistent
+  sources <- _metaSources <$> getMetadata
   do
     -- version check
     result <- liftIO $ versionCheckImplementation @b env name sourceConfig
     liftEither result
 
   metadataModifier <-
     MetadataModifier
-      <$> if HashMap.member name sources
+      <$> if InsOrdHashMap.member name sources
         then
           if replaceConfiguration
             then do

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

@@ -328,20 +328,26 @@ buildSchemaCache = buildSchemaCacheWithInvalidations mempty
 -- If there are any new inconsistencies, the changes to the metadata and the schema cache are abandoned.
 tryBuildSchemaCache ::
   (CacheRWM m, MetadataM m) =>
+  -- | A list of metadata object ids for which if there are any inconsistencies in the new build,
+  -- it must be rejected regardless of whether that inconsistency is new or not
+  [MetadataObjId] ->
   MetadataModifier ->
   m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
-tryBuildSchemaCache MetadataModifier {..} =
-  tryBuildSchemaCacheWithModifiers [pure . runMetadataModifier]
+tryBuildSchemaCache unacceptableInconsistentObjects MetadataModifier {..} =
+  tryBuildSchemaCacheWithModifiers unacceptableInconsistentObjects [pure . runMetadataModifier]
 
 -- | Rebuilds the schema cache after modifying metadata sequentially and returns any _new_ metadata inconsistencies.
 -- If there are any new inconsistencies, the changes to the metadata and the schema cache are abandoned.
 -- If the metadata modifiers run into validation issues (e.g. a native query is already tracked in the metadata),
 -- we throw these errors back without changing the metadata and schema cache.
 tryBuildSchemaCacheWithModifiers ::
   (CacheRWM m, MetadataM m) =>
+  -- | A list of metadata object ids for which if there are any inconsistencies in the new build,
+  -- it must be rejected regardless of whether that inconsistency is new or not
+  [MetadataObjId] ->
   [Metadata -> m Metadata] ->
   m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
-tryBuildSchemaCacheWithModifiers modifiers = do
+tryBuildSchemaCacheWithModifiers unacceptableInconsistentObjects modifiers = do
   modifiedMetadata <- do
     metadata <- getMetadata
     foldM (flip ($)) metadata modifiers
@@ -359,11 +365,16 @@ tryBuildSchemaCacheWithModifiers modifiers = do
   where
     validateNewSchemaCache :: SchemaCache -> SchemaCache -> (ValidateNewSchemaCacheResult, HashMap MetadataObjId (NonEmpty InconsistentMetadata))
     validateNewSchemaCache oldSchemaCache newSchemaCache =
-      let diffInconsistentObjects = HashMap.difference `on` (groupInconsistentMetadataById . scInconsistentObjs)
-          newInconsistentObjects = newSchemaCache `diffInconsistentObjects` oldSchemaCache
-       in if newInconsistentObjects == mempty
-            then (KeepNewSchemaCache, newInconsistentObjects)
-            else (DiscardNewSchemaCache, newInconsistentObjects)
+      let inconsistenciesFromOld = groupInconsistentMetadataById $ scInconsistentObjs oldSchemaCache
+          inconsistenciesFromNew = groupInconsistentMetadataById $ scInconsistentObjs newSchemaCache
+          unacceptableInconsistenciesInNew = HashMap.filterWithKey (\objId _ -> objId `elem` unacceptableInconsistentObjects) inconsistenciesFromNew
+          noUnacceptableInconsistenciesInNew = HashMap.null unacceptableInconsistenciesInNew
+          newInconsistentObjects = inconsistenciesFromNew `HashMap.difference` inconsistenciesFromOld
+       in -- If there are no new inconsistencies and no unacceptable inconsistencies in the new build, keep the new build,
+          -- otherwise discard the new build and return the offending inconsistencies
+          if noUnacceptableInconsistenciesInNew && newInconsistentObjects == mempty
+            then (KeepNewSchemaCache, mempty)
+            else (DiscardNewSchemaCache, HashMap.union newInconsistentObjects unacceptableInconsistenciesInNew)
 
 -- | Tries to modify the metadata for all the specified metadata objects. If the modification fails,
 -- any objects that directly caused a new metadata inconsistency are removed and the modification
@@ -383,7 +394,7 @@ tryBuildSchemaCacheAndWarnOnFailingObjects ::
   m (HashMap MetadataObjId a)
 tryBuildSchemaCacheAndWarnOnFailingObjects mkMetadataModifier warningCode metadataObjects = do
   metadataModifier <- fmap mconcat . traverse mkMetadataModifier $ HashMap.elems metadataObjects
-  metadataInconsistencies <- tryBuildSchemaCache metadataModifier
+  metadataInconsistencies <- tryBuildSchemaCache [] metadataModifier
 
   let inconsistentObjects = HashMap.intersectionWith (,) metadataInconsistencies metadataObjects
   let successfulObjects = HashMap.difference metadataObjects inconsistentObjects
@@ -398,7 +409,7 @@ tryBuildSchemaCacheAndWarnOnFailingObjects mkMetadataModifier warningCode metada
 
         -- Try again, this time only with objects that were previously successful
         withoutFailedObjectsMetadataModifier <- fmap mconcat . traverse mkMetadataModifier $ HashMap.elems successfulObjects
-        tryBuildSchemaCache withoutFailedObjectsMetadataModifier
+        tryBuildSchemaCache [] withoutFailedObjectsMetadataModifier
       else -- Otherwise just look at the rest of the errors, if any
         pure metadataInconsistencies
 
@@ -411,14 +422,15 @@ tryBuildSchemaCacheAndWarnOnFailingObjects mkMetadataModifier warningCode metada
   pure successfulObjects
 
 -- | Rebuilds the schema cache after modifying metadata. If an object with the given object id became newly inconsistent,
--- raises an error about it specifically. Otherwise, raises a generic metadata inconsistency error.
+-- or was already inconsistent and stays inconsistent, raises an error about it specifically.
+-- Otherwise, raises a generic metadata inconsistency error.
 buildSchemaCacheFor ::
   (QErrM m, CacheRWM m, MetadataM m) =>
   MetadataObjId ->
   MetadataModifier ->
   m ()
 buildSchemaCacheFor objectId metadataModifier = do
-  newInconsistentObjects <- tryBuildSchemaCache metadataModifier
+  newInconsistentObjects <- tryBuildSchemaCache [objectId] metadataModifier
 
   for_ (HashMap.lookup objectId newInconsistentObjects) $ \matchingObjects -> do
     let reasons = commaSeparated $ imReason <$> matchingObjects

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

@@ -615,7 +615,7 @@ runBulkAtomic cmds = do
 
   -- Try building the schema cache using the combined modifiers. If we run into
   -- any inconsistencies, we should fail and roll back.
-  inconsistencies <- tryBuildSchemaCacheWithModifiers mdModifiers
+  inconsistencies <- tryBuildSchemaCacheWithModifiers [] mdModifiers
 
   unless (null inconsistencies)
     $ throw400WithDetail BadRequest "Schema inconsistency"