graphql-engine/server/src-lib/Hasura/RemoteSchema/Metadata/Customization.hs
Jesse Hallett c265e303f6 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
2022-12-15 17:39:22 +00:00

98 lines
3.4 KiB
Haskell

{-# LANGUAGE TemplateHaskell #-}
module Hasura.RemoteSchema.Metadata.Customization
( RemoteTypeCustomization (..),
RemoteFieldCustomization (..),
RemoteSchemaCustomization (..),
)
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
import Language.GraphQL.Draft.Syntax qualified as G
-- NOTE: Prefix and suffix use 'G.Name' so that we can '<>' to form a new valid
-- by-construction 'G.Name'.
data RemoteTypeCustomization = RemoteTypeCustomization
{ _rtcPrefix :: Maybe G.Name,
_rtcSuffix :: Maybe G.Name,
_rtcMapping :: HashMap G.Name G.Name
}
deriving (Show, Eq, Generic)
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
parseJSON = J.withObject "RemoteTypeCustomization" $ \o ->
RemoteTypeCustomization
<$> o J..:? "prefix"
<*> o J..:? "suffix"
<*> o J..:? "mapping" J..!= mempty
data RemoteFieldCustomization = RemoteFieldCustomization
{ _rfcParentType :: G.Name,
_rfcPrefix :: Maybe G.Name,
_rfcSuffix :: Maybe G.Name,
_rfcMapping :: HashMap G.Name G.Name
}
deriving (Show, Eq, Generic)
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
parseJSON = J.withObject "RemoteFieldCustomization" $ \o ->
RemoteFieldCustomization
<$> o J..: "parent_type"
<*> o J..:? "prefix"
<*> o J..:? "suffix"
<*> o J..:? "mapping" J..!= mempty
data RemoteSchemaCustomization = RemoteSchemaCustomization
{ _rscRootFieldsNamespace :: Maybe G.Name,
_rscTypeNames :: Maybe RemoteTypeCustomization,
_rscFieldNames :: Maybe [RemoteFieldCustomization]
}
deriving (Show, Eq, Generic)
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)