server: fix JSON path in error when parsing sources in metadata

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/2839
GitOrigin-RevId: 9c46f289b28082bacb0a05a47ead643369d866d3

CHANGELOG.md

@@ -2,6 +2,8 @@
 
 ## Next release
 (Add highlights/major features below)
+
+- server: fix JSON path in error when parsing sources in metadata (fix #7769)
 - server: log locking DB queries during source catalog migration
 - server: fix to allow remote schema response to contain an "extensions" field (#7143)
 - console: add comments to tracked functions

server/src-lib/Data/Aeson/Extended.hs

@@ -3,12 +3,13 @@ module Data.Aeson.Extended
     encodeToStrictText,
     ToJSONKeyValue (..),
     FromJSONKeyValue (..),
+    mapWithJSONPath,
   )
 where
 
 import Data.Aeson as J
 import Data.Aeson.Text (encodeToTextBuilder)
-import Data.Aeson.Types (Parser)
+import Data.Aeson.Types (JSONPathElement (..), Parser)
 import Data.Functor.Const
 import Data.Text.Lazy (toStrict)
 import Data.Text.Lazy.Builder (toLazyText)
@@ -28,3 +29,8 @@ instance ToJSONKeyValue Void where
 
 instance ToJSONKeyValue a => ToJSONKeyValue (Const a b) where
   toJSONKeyValue = toJSONKeyValue . getConst
+
+-- | map a 'Parser' over a list, keeping the JSONPath context
+mapWithJSONPath :: (a -> Parser b) -> [a] -> Parser [b]
+mapWithJSONPath parser xs =
+  traverse (\(idx, item) -> parser item <?> Index idx) $ zip [0 ..] xs

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

@@ -100,6 +100,7 @@ where
 
 import Control.Lens hiding (set, (.=))
 import Data.Aeson.Casing
+import Data.Aeson.Extended (mapWithJSONPath)
 import Data.Aeson.Ordered qualified as AO
 import Data.Aeson.TH
 import Data.Aeson.Types
@@ -526,7 +527,7 @@ instance FromJSON Metadata where
     when (version /= MVVersion3) $
       fail $ "unexpected metadata version from storage: " <> show version
     rawSources <- o .: "sources"
-    sources <- oMapFromL getSourceName <$> traverse parseSourceMetadata rawSources
+    sources <- oMapFromL getSourceName <$> mapWithJSONPath parseSourceMetadata rawSources <?> Key "sources"
     endpoints <- oMapFromL _ceName <$> o .:? "rest_endpoints" .!= []
     network <- o .:? "network" .!= emptyNetwork
     ( remoteSchemas,
@@ -565,19 +566,20 @@ instance FromJSON Metadata where
 emptyMetadata :: Metadata
 emptyMetadata =
   Metadata
-    mempty
-    mempty
-    mempty
-    mempty
-    emptyCustomTypes
-    mempty
-    mempty
-    mempty
-    emptyApiLimit
-    emptyMetricsConfig
-    mempty
-    mempty
-    emptyNetwork
+    { _metaSources = mempty,
+      _metaRemoteSchemas = mempty,
+      _metaQueryCollections = mempty,
+      _metaAllowlist = mempty,
+      _metaActions = mempty,
+      _metaCronTriggers = mempty,
+      _metaRestEndpoints = mempty,
+      _metaInheritedRoles = mempty,
+      _metaSetGraphqlIntrospectionOptions = mempty,
+      _metaCustomTypes = emptyCustomTypes,
+      _metaApiLimits = emptyApiLimit,
+      _metaMetricsConfig = emptyMetricsConfig,
+      _metaNetwork = emptyNetwork
+    }
 
 tableMetadataSetter ::
   (Backend b) =>