From c265e303f6be28fca59cf0ca7bce2a5ff996cc33 Mon Sep 17 00:00:00 2001 From: Jesse Hallett Date: Thu, 15 Dec 2022 12:38:07 -0500 Subject: [PATCH] server: codecs for remote schemas metadata These codecs should fully cover the `remote_schemas` property of the Metadata type. Ticket: [GDC-522](https://hasurahq.atlassian.net/browse/GDC-522) PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6812 GitOrigin-RevId: 1b256f6829486295957c232b92ff184bd9a86469 --- server/src-lib/Autodocodec/Extended.hs | 12 +++++- .../Data/HashMap/Strict/InsOrd/Autodocodec.hs | 43 +++++++++++++++---- .../src-lib/Hasura/Metadata/DTO/MetadataV3.hs | 20 +++++++-- server/src-lib/Hasura/RQL/DDL/Headers.hs | 27 ++++++++++++ server/src-lib/Hasura/RQL/Types/Common.hs | 17 +++++++- server/src-lib/Hasura/RQL/Types/Metadata.hs | 2 +- .../Hasura/RQL/Types/Relationships/Remote.hs | 9 +--- .../Hasura/RemoteSchema/Metadata/Core.hs | 30 +++++++++++++ .../RemoteSchema/Metadata/Customization.hs | 27 ++++++++++++ .../RemoteSchema/Metadata/Permission.hs | 20 +++++++++ .../Metadata/RemoteRelationship.hs | 17 +++++++- .../Hasura/Metadata/DTO/MetadataDTOSpec.hs | 2 +- 12 files changed, 200 insertions(+), 26 deletions(-) diff --git a/server/src-lib/Autodocodec/Extended.hs b/server/src-lib/Autodocodec/Extended.hs index c26ba248e58..f08fe6a57e8 100644 --- a/server/src-lib/Autodocodec/Extended.hs +++ b/server/src-lib/Autodocodec/Extended.hs @@ -1,6 +1,7 @@ module Autodocodec.Extended ( graphQLFieldNameCodec, graphQLValueCodec, + graphQLSchemaDocumentCodec, hashSetCodec, hashSetCodecWith, integerCodec, @@ -18,11 +19,14 @@ import Data.Text qualified as T import Data.Typeable (Typeable) import Hasura.Metadata.DTO.Utils (typeableName) import Hasura.Prelude +import Language.GraphQL.Draft.Parser qualified as GParser +import Language.GraphQL.Draft.Printer qualified as GPrinter import Language.GraphQL.Draft.Syntax qualified as G +import Text.Builder qualified as TB -- | Codec for a GraphQL field name graphQLFieldNameCodec :: JSONCodec G.Name -graphQLFieldNameCodec = bimapCodec dec enc codec +graphQLFieldNameCodec = named "GraphQLName" $ bimapCodec dec enc codec where dec text = maybeToEither ("invalid GraphQL field name '" <> T.unpack text <> "'") $ @@ -70,6 +74,12 @@ graphQLValueCodec varCodec = enc _ = error msg -- encoding is supposed to be total so we need an exception here in bimapCodec dec enc nullCodec +graphQLSchemaDocumentCodec :: JSONCodec G.SchemaDocument +graphQLSchemaDocumentCodec = named "GraphQLSchema" $ bimapCodec dec enc $ codec @Text + where + dec = mapLeft T.unpack . GParser.parseSchemaDocument + enc = TB.run . GPrinter.schemaDocument + -- | Serializes a hash set by converting it to a list. This matches the FromJSON -- and ToJSON instances in aeson. hashSetCodec :: (Hashable a, HasCodec a) => JSONCodec (HashSet a) diff --git a/server/src-lib/Data/HashMap/Strict/InsOrd/Autodocodec.hs b/server/src-lib/Data/HashMap/Strict/InsOrd/Autodocodec.hs index 1f6b033b8fb..7d56b970302 100644 --- a/server/src-lib/Data/HashMap/Strict/InsOrd/Autodocodec.hs +++ b/server/src-lib/Data/HashMap/Strict/InsOrd/Autodocodec.hs @@ -1,5 +1,7 @@ module Data.HashMap.Strict.InsOrd.Autodocodec - ( sortedElemsCodec, + ( insertionOrderedElemsCodec, + insertionOrderedElemsCodecWith, + sortedElemsCodec, sortedElemsCodecWith, ) where @@ -24,17 +26,40 @@ sortedElemsCodec = sortedElemsCodecWith codec -- This version is useful if there is no 'HasCodec' instance for the type of the -- hash map values. You supply a codec as an argument instead. sortedElemsCodecWith :: (Hashable k, Ord k, T.ToTxt k) => JSONCodec a -> (a -> k) -> JSONCodec (InsOrdHashMap k a) -sortedElemsCodecWith valueCodec keyForElem = bimapCodec dec enc $ listCodec valueCodec +sortedElemsCodecWith elemCodec keyForElem = bimapCodec dec enc $ listCodec elemCodec where - dec xs = - let dupKeys = duplicates $ map keyForElem xs - in if null dupKeys - then Right $ oMapFromL keyForElem xs - else Left $ T.unpack $ errMsg <> T.commaSeparated dupKeys - + dec = fromListWithDuplicateCheck elemCodec keyForElem enc = sortOn keyForElem . elems - errMsg = case codecName valueCodec of +-- | Codec for ordered hash maps that serializes to a list. Elements are ordered +-- according to insertion order in the map. A function to map from elements to +-- key is used on deserialization. +-- +-- This version is useful if there is no 'HasCodec' instance for the type of the +-- hash map values. You supply a codec as an argument instead. +insertionOrderedElemsCodec :: (Hashable k, HasCodec a, T.ToTxt k) => (a -> k) -> JSONCodec (InsOrdHashMap k a) +insertionOrderedElemsCodec = insertionOrderedElemsCodecWith codec + +-- | Codec for ordered hash maps that serializes to a list. Elements are ordered +-- according to insertion order in the map. A function to map from elements to +-- key is used on deserialization. +-- +-- This version is useful if there is no 'HasCodec' instance for the type of the +-- hash map values. You supply a codec as an argument instead. +insertionOrderedElemsCodecWith :: (Hashable k, T.ToTxt k) => JSONCodec a -> (a -> k) -> JSONCodec (InsOrdHashMap k a) +insertionOrderedElemsCodecWith elemCodec keyForElem = bimapCodec dec enc $ listCodec elemCodec + where + dec = fromListWithDuplicateCheck elemCodec keyForElem + enc = elems + +fromListWithDuplicateCheck :: (Hashable k, T.ToTxt k) => JSONCodec a -> (a -> k) -> [a] -> Either String (InsOrdHashMap k a) +fromListWithDuplicateCheck elemCodec keyForElem xs = + let dupKeys = duplicates $ map keyForElem xs + in if null dupKeys + then Right $ oMapFromL keyForElem xs + else Left $ T.unpack $ errMsg <> T.commaSeparated dupKeys + where + errMsg = case codecName elemCodec of (Just t) -> "multiple " <> t <> " declarations exist: " Nothing -> "multiple declarations exist: " diff --git a/server/src-lib/Hasura/Metadata/DTO/MetadataV3.hs b/server/src-lib/Hasura/Metadata/DTO/MetadataV3.hs index c55e48fd21d..a727c534d84 100644 --- a/server/src-lib/Hasura/Metadata/DTO/MetadataV3.hs +++ b/server/src-lib/Hasura/Metadata/DTO/MetadataV3.hs @@ -1,20 +1,32 @@ +{-# LANGUAGE OverloadedLists #-} + module Hasura.Metadata.DTO.MetadataV3 (MetadataV3 (..)) where -import Autodocodec (Autodocodec (Autodocodec), HasCodec (codec), object, optionalField, requiredFieldWith, (.=)) +import Autodocodec + ( Autodocodec (Autodocodec), + HasCodec (codec), + object, + optionalField, + optionalFieldWithOmittedDefaultWith, + requiredFieldWith, + (.=), + ) import Autodocodec.OpenAPI () import Data.Aeson (FromJSON, ToJSON) +import Data.HashMap.Strict.InsOrd.Autodocodec (sortedElemsCodec) import Data.OpenApi qualified as OpenApi import Hasura.Metadata.DTO.Placeholder (PlaceholderArray, PlaceholderObject) import Hasura.Metadata.DTO.Utils (versionField) import Hasura.Prelude -import Hasura.RQL.Types.Metadata.Common (Sources, sourcesCodec) +import Hasura.RQL.Types.Metadata.Common (RemoteSchemas, Sources, sourcesCodec) +import Hasura.RemoteSchema.Metadata.Core (RemoteSchemaMetadataG (_rsmName)) -- | Revision 3 of the Metadata export format. Note that values of the types, -- 'PlaceholderArray' and 'PlaceholderObject' are placeholders that will -- eventually be expanded to represent more detail. data MetadataV3 = MetadataV3 { metaV3Sources :: Sources, - metaV3RemoteSchemas :: Maybe PlaceholderArray, + metaV3RemoteSchemas :: RemoteSchemas, metaV3QueryCollections :: Maybe PlaceholderArray, metaV3Allowlist :: Maybe PlaceholderArray, metaV3Actions :: Maybe PlaceholderArray, @@ -43,7 +55,7 @@ instance HasCodec MetadataV3 where MetadataV3 <$ versionField 3 <*> requiredFieldWith "sources" sourcesCodec "configured databases" .= metaV3Sources - <*> optionalField "remote_schemas" "merge remote GraphQL schemas and provide a unified GraphQL API" .= metaV3RemoteSchemas + <*> optionalFieldWithOmittedDefaultWith "remote_schemas" (sortedElemsCodec _rsmName) [] "merge remote GraphQL schemas and provide a unified GraphQL API" .= metaV3RemoteSchemas <*> optionalField "query_collections" "group queries using query collections" .= metaV3QueryCollections <*> optionalField "allowlist" "safe GraphQL operations - when allow lists are enabled only these operations are allowed" .= metaV3Allowlist <*> optionalField "actions" "action definitions which extend Hasura's schema with custom business logic using custom queries and mutations" .= metaV3Actions diff --git a/server/src-lib/Hasura/RQL/DDL/Headers.hs b/server/src-lib/Hasura/RQL/DDL/Headers.hs index 0bd3172a938..a20047139a3 100644 --- a/server/src-lib/Hasura/RQL/DDL/Headers.hs +++ b/server/src-lib/Hasura/RQL/DDL/Headers.hs @@ -6,6 +6,8 @@ module Hasura.RQL.DDL.Headers ) where +import Autodocodec (HasCodec (codec), dimapCodec, disjointEitherCodec, requiredField') +import Autodocodec qualified as AC import Data.Aeson import Data.CaseInsensitive qualified as CI import Data.Environment qualified as Env @@ -31,6 +33,31 @@ instance NFData HeaderValue instance Hashable HeaderValue +instance HasCodec HeaderConf where + codec = + dimapCodec + ( either + (\(name, value) -> HeaderConf name (HVValue value)) + (\(name, value) -> HeaderConf name (HVEnv value)) + ) + ( \case + HeaderConf name (HVValue value) -> Left (name, value) + HeaderConf name (HVEnv value) -> Right (name, value) + ) + $ disjointEitherCodec valueCodec fromEnvCodec + where + valueCodec = + AC.object "HeaderConfValue" $ + (,) + <$> requiredField' "name" AC..= fst + <*> requiredField' "value" AC..= snd + + fromEnvCodec = + AC.object "HeaderConfFromEnv" $ + (,) + <$> requiredField' "name" AC..= fst + <*> requiredField' "value_from_env" AC..= snd + instance FromJSON HeaderConf where parseJSON (Object o) = do name <- o .: "name" diff --git a/server/src-lib/Hasura/RQL/Types/Common.hs b/server/src-lib/Hasura/RQL/Types/Common.hs index e47daf4d6a5..0546e9eecc1 100644 --- a/server/src-lib/Hasura/RQL/Types/Common.hs +++ b/server/src-lib/Hasura/RQL/Types/Common.hs @@ -42,6 +42,7 @@ module Hasura.RQL.Types.Common ApolloFederationVersion (..), isApolloFedV1enabled, RemoteRelationshipG (..), + remoteRelationshipCodec, rrDefinition, rrName, TriggerOnReplication (..), @@ -50,12 +51,14 @@ where import Autodocodec ( HasCodec (codec), + JSONCodec, bimapCodec, dimapCodec, disjointEitherCodec, optionalFieldOrNull', requiredField, requiredField', + requiredFieldWith', stringConstCodec, ) import Autodocodec qualified as AC @@ -71,6 +74,7 @@ import Data.Scientific (toBoundedInteger) import Data.Text qualified as T import Data.Text.Extended import Data.Text.NonEmpty +import Data.Typeable (Typeable) import Data.URL.Template import Database.PG.Query qualified as PG import Hasura.Base.Error @@ -78,7 +82,7 @@ import Hasura.Base.ErrorValue qualified as ErrorValue import Hasura.Base.ToErrorValue import Hasura.EncJSON import Hasura.GraphQL.Schema.Options qualified as Options -import Hasura.Metadata.DTO.Utils (fromEnvCodec) +import Hasura.Metadata.DTO.Utils (fromEnvCodec, typeableName) import Hasura.Prelude import Hasura.RQL.DDL.Headers () import Language.GraphQL.Draft.Syntax qualified as G @@ -666,5 +670,16 @@ data RemoteRelationshipG definition = RemoteRelationship } deriving (Show, Eq, Generic) +remoteRelationshipCodec :: + forall definition. + (Typeable definition) => + JSONCodec definition -> + JSONCodec (RemoteRelationshipG definition) +remoteRelationshipCodec definitionCodec = + AC.object ("RemoteRelationship_" <> typeableName @definition) $ + RemoteRelationship + <$> requiredField' "name" AC..= _rrName + <*> requiredFieldWith' "definition" definitionCodec AC..= _rrDefinition + $(makeLenses ''RemoteRelationshipG) $(deriveToJSON hasuraJSON {J.omitNothingFields = False} ''RemoteRelationshipG) diff --git a/server/src-lib/Hasura/RQL/Types/Metadata.hs b/server/src-lib/Hasura/RQL/Types/Metadata.hs index 154a045c204..9d3801bc65a 100644 --- a/server/src-lib/Hasura/RQL/Types/Metadata.hs +++ b/server/src-lib/Hasura/RQL/Types/Metadata.hs @@ -510,7 +510,7 @@ metadataToDTO ) = MetadataV3 { metaV3Sources = sources, - metaV3RemoteSchemas = placeholder <$> remoteSchemasToOrdJSONList remoteSchemas, + metaV3RemoteSchemas = remoteSchemas, metaV3QueryCollections = placeholder <$> queryCollectionsToOrdJSONList queryCollections, metaV3Allowlist = placeholder <$> allowlistToOrdJSONList allowlist, metaV3Actions = placeholder <$> actionMetadataToOrdJSONList actions, diff --git a/server/src-lib/Hasura/RQL/Types/Relationships/Remote.hs b/server/src-lib/Hasura/RQL/Types/Relationships/Remote.hs index f89419da630..f46480bb891 100644 --- a/server/src-lib/Hasura/RQL/Types/Relationships/Remote.hs +++ b/server/src-lib/Hasura/RQL/Types/Relationships/Remote.hs @@ -48,14 +48,7 @@ import Hasura.SQL.Backend type RemoteRelationship = RemoteRelationshipG RemoteRelationshipDefinition instance HasCodec RemoteRelationship where - codec = - AC.object "RemoteRelationship" $ - RemoteRelationship - <$> requiredField' "name" AC..= _rrName - <*> requiredFieldWith' - "definition" - (remoteRelationshipDefinitionCodec RRPLenient) - AC..= _rrDefinition + codec = remoteRelationshipCodec $ remoteRelationshipDefinitionCodec RRPLenient instance FromJSON RemoteRelationship where parseJSON = withObject "RemoteRelationship" $ \obj -> diff --git a/server/src-lib/Hasura/RemoteSchema/Metadata/Core.hs b/server/src-lib/Hasura/RemoteSchema/Metadata/Core.hs index 35d423f1df6..3bc81462b4d 100644 --- a/server/src-lib/Hasura/RemoteSchema/Metadata/Core.hs +++ b/server/src-lib/Hasura/RemoteSchema/Metadata/Core.hs @@ -16,13 +16,18 @@ module Hasura.RemoteSchema.Metadata.Core ) where +import Autodocodec (object, optionalField', optionalFieldWithDefault', optionalFieldWithDefaultWith', requiredField', (.=)) +import Autodocodec.Class (HasCodec (codec)) import Control.Lens (makeLenses) import Data.Aeson qualified as J import Data.Aeson.TH qualified as J import Data.Environment qualified as Env +import Data.HashMap.Strict.InsOrd.Autodocodec (insertionOrderedElemsCodec) import Data.HashMap.Strict.InsOrd.Extended qualified as OM import Data.Text qualified as T +import Data.Typeable (Typeable) import Hasura.Base.Error +import Hasura.Metadata.DTO.Utils (typeableName) import Hasura.Prelude import Hasura.RQL.DDL.Headers (HeaderConf (..)) import Hasura.RQL.Types.Common @@ -53,6 +58,17 @@ data RemoteSchemaDef = RemoteSchemaDef instance NFData RemoteSchemaDef +instance HasCodec RemoteSchemaDef where + codec = + object "RemoteSchemaDef" $ + RemoteSchemaDef + <$> optionalField' "url" .= _rsdUrl + <*> optionalField' "url_from_env" .= _rsdUrlFromEnv + <*> optionalField' "headers" .= _rsdHeaders + <*> optionalFieldWithDefault' "forward_client_headers" False .= _rsdForwardClientHeaders + <*> optionalField' "timeout_seconds" .= _rsdTimeoutSeconds + <*> optionalField' "customization" .= _rsdCustomization + $(J.deriveToJSON hasuraJSON {J.omitNothingFields = True} ''RemoteSchemaDef) instance J.FromJSON RemoteSchemaDef where @@ -85,6 +101,20 @@ data RemoteSchemaMetadataG r = RemoteSchemaMetadata } deriving (Show, Eq, Generic) +instance (HasCodec (RemoteRelationshipG r), Typeable r) => HasCodec (RemoteSchemaMetadataG r) where + codec = + object ("RemoteSchemaMetadata_" <> typeableName @r) $ + RemoteSchemaMetadata + <$> requiredField' "name" .= _rsmName + <*> requiredField' "definition" .= _rsmDefinition + <*> optionalField' "comment" .= _rsmComment + <*> optionalFieldWithDefault' "permissions" mempty .= _rsmPermissions + <*> optionalFieldWithDefaultWith' + "remote_relationships" + (insertionOrderedElemsCodec _rstrsName) + mempty + .= _rsmRemoteRelationships + instance J.FromJSON (RemoteRelationshipG r) => J.FromJSON (RemoteSchemaMetadataG r) where parseJSON = J.withObject "RemoteSchemaMetadata" \obj -> RemoteSchemaMetadata diff --git a/server/src-lib/Hasura/RemoteSchema/Metadata/Customization.hs b/server/src-lib/Hasura/RemoteSchema/Metadata/Customization.hs index 93f9a658d60..296531b73f7 100644 --- a/server/src-lib/Hasura/RemoteSchema/Metadata/Customization.hs +++ b/server/src-lib/Hasura/RemoteSchema/Metadata/Customization.hs @@ -7,6 +7,8 @@ module Hasura.RemoteSchema.Metadata.Customization ) where +import Autodocodec (HasCodec, codec, hashMapCodec, object, optionalField', optionalFieldWith', requiredFieldWith', (.=)) +import Autodocodec.Extended (graphQLFieldNameCodec) import Data.Aeson qualified as J import Data.Aeson.TH qualified as J import Hasura.Prelude @@ -25,6 +27,14 @@ instance NFData RemoteTypeCustomization instance Hashable RemoteTypeCustomization +instance HasCodec RemoteTypeCustomization where + codec = + object "RemoteTypeCustomization" $ + RemoteTypeCustomization + <$> optionalFieldWith' "prefix" graphQLFieldNameCodec .= _rtcPrefix + <*> optionalFieldWith' "suffix" graphQLFieldNameCodec .= _rtcSuffix + <*> requiredFieldWith' "mapping" (hashMapCodec graphQLFieldNameCodec) .= _rtcMapping + $(J.deriveToJSON hasuraJSON {J.omitNothingFields = True} ''RemoteTypeCustomization) instance J.FromJSON RemoteTypeCustomization where @@ -46,6 +56,15 @@ instance NFData RemoteFieldCustomization instance Hashable RemoteFieldCustomization +instance HasCodec RemoteFieldCustomization where + codec = + object "RemoteFieldCustomization" $ + RemoteFieldCustomization + <$> requiredFieldWith' "parent_type" graphQLFieldNameCodec .= _rfcParentType + <*> optionalFieldWith' "prefix" graphQLFieldNameCodec .= _rfcPrefix + <*> optionalFieldWith' "suffix" graphQLFieldNameCodec .= _rfcSuffix + <*> requiredFieldWith' "mapping" (hashMapCodec graphQLFieldNameCodec) .= _rfcMapping + $(J.deriveToJSON hasuraJSON {J.omitNothingFields = True} ''RemoteFieldCustomization) instance J.FromJSON RemoteFieldCustomization where @@ -67,4 +86,12 @@ instance NFData RemoteSchemaCustomization instance Hashable RemoteSchemaCustomization +instance HasCodec RemoteSchemaCustomization where + codec = + object "RemoteSchemaCustomization" $ + RemoteSchemaCustomization + <$> optionalFieldWith' "root_fields_namespace" graphQLFieldNameCodec .= _rscRootFieldsNamespace + <*> optionalField' "type_names" .= _rscTypeNames + <*> optionalField' "field_names" .= _rscFieldNames + $(J.deriveJSON hasuraJSON {J.omitNothingFields = True} ''RemoteSchemaCustomization) diff --git a/server/src-lib/Hasura/RemoteSchema/Metadata/Permission.hs b/server/src-lib/Hasura/RemoteSchema/Metadata/Permission.hs index 5b5b21f368c..9f93a495805 100644 --- a/server/src-lib/Hasura/RemoteSchema/Metadata/Permission.hs +++ b/server/src-lib/Hasura/RemoteSchema/Metadata/Permission.hs @@ -6,6 +6,8 @@ module Hasura.RemoteSchema.Metadata.Permission ) where +import Autodocodec (HasCodec (codec), object, optionalField', requiredField', requiredFieldWith, (.=)) +import Autodocodec.Extended (graphQLSchemaDocumentCodec) import Data.Aeson qualified as J import Data.Aeson.TH qualified as J import Hasura.Prelude @@ -23,6 +25,16 @@ instance NFData RemoteSchemaPermissionDefinition instance Hashable RemoteSchemaPermissionDefinition +instance HasCodec RemoteSchemaPermissionDefinition where + codec = + object "RemoteSchemaPermissionDefinition" $ + RemoteSchemaPermissionDefinition + <$> requiredFieldWith + "schema" + graphQLSchemaDocumentCodec + "GraphQL schema document, e.g. the content of schema.gql" + .= _rspdSchema + instance J.FromJSON RemoteSchemaPermissionDefinition where parseJSON = J.withObject "RemoteSchemaPermissionDefinition" $ \obj -> do fmap RemoteSchemaPermissionDefinition $ obj J..: "schema" @@ -38,4 +50,12 @@ data RemoteSchemaPermissionMetadata = RemoteSchemaPermissionMetadata } deriving (Show, Eq, Generic) +instance HasCodec RemoteSchemaPermissionMetadata where + codec = + object "RemoteSchemaPermissionMetadata" $ + RemoteSchemaPermissionMetadata + <$> requiredField' "role" .= _rspmRole + <*> requiredField' "definition" .= _rspmDefinition + <*> optionalField' "comment" .= _rspmComment + $(J.deriveJSON hasuraJSON {J.omitNothingFields = True} ''RemoteSchemaPermissionMetadata) diff --git a/server/src-lib/Hasura/RemoteSchema/Metadata/RemoteRelationship.hs b/server/src-lib/Hasura/RemoteSchema/Metadata/RemoteRelationship.hs index 65d651a8a95..a36c4a3e55b 100644 --- a/server/src-lib/Hasura/RemoteSchema/Metadata/RemoteRelationship.hs +++ b/server/src-lib/Hasura/RemoteSchema/Metadata/RemoteRelationship.hs @@ -18,7 +18,9 @@ module Hasura.RemoteSchema.Metadata.RemoteRelationship where import Autodocodec -import Autodocodec.Extended (graphQLValueCodec, hashSetCodec) +import Autodocodec qualified as AC +import Autodocodec.Extended (graphQLFieldNameCodec, graphQLValueCodec, hashSetCodec) +import Control.Exception.Safe (Typeable) import Control.Lens (makeLenses) import Data.Aeson qualified as J import Data.Aeson.Key qualified as K @@ -27,9 +29,11 @@ import Data.Aeson.TH qualified as J import Data.Aeson.Types (prependFailure) import Data.Bifunctor (bimap) import Data.HashMap.Strict qualified as HM +import Data.HashMap.Strict.InsOrd.Autodocodec (insertionOrderedElemsCodec) import Data.HashMap.Strict.InsOrd.Extended qualified as OM import Data.Scientific (floatingOrInteger) import Data.Text qualified as T +import Hasura.Metadata.DTO.Utils (typeableName) import Hasura.Prelude import Hasura.RQL.Types.Common import Hasura.RemoteSchema.Metadata.Base @@ -229,6 +233,17 @@ data RemoteSchemaTypeRelationships r = RemoteSchemaTypeRelationships } deriving (Show, Eq, Generic) +instance (HasCodec (RemoteRelationshipG r), Typeable r) => HasCodec (RemoteSchemaTypeRelationships r) where + codec = + AC.object ("RemoteSchemaMetadata_" <> typeableName @r) $ + RemoteSchemaTypeRelationships + <$> requiredFieldWith' "type_name" graphQLFieldNameCodec AC..= _rstrsName + <*> optionalFieldWithDefaultWith' + "relationships" + (insertionOrderedElemsCodec _rrName) + mempty + AC..= _rstrsRelationships + instance J.FromJSON (RemoteRelationshipG r) => J.FromJSON (RemoteSchemaTypeRelationships r) where parseJSON = J.withObject "RemoteSchemaMetadata" \obj -> RemoteSchemaTypeRelationships diff --git a/server/src-test/Hasura/Metadata/DTO/MetadataDTOSpec.hs b/server/src-test/Hasura/Metadata/DTO/MetadataDTOSpec.hs index ca9a76d7485..a8aa0d6d4fd 100644 --- a/server/src-test/Hasura/Metadata/DTO/MetadataDTOSpec.hs +++ b/server/src-test/Hasura/Metadata/DTO/MetadataDTOSpec.hs @@ -100,7 +100,7 @@ emptyMetadataV3 :: MetadataV3 emptyMetadataV3 = MetadataV3 { metaV3Sources = mempty, - metaV3RemoteSchemas = Nothing, + metaV3RemoteSchemas = mempty, metaV3QueryCollections = Nothing, metaV3Allowlist = Nothing, metaV3Actions = Nothing,