mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-10-05 06:18:04 +03:00
server: split metadata serialization helpers into new module
Moves code from `Hasura.RQL.Types.Metadata` that is specific to serialization into a new module, `Hasura.RQL.Types.Metadata.Serialization`. I'm breaking up #5184 into smaller PRs. This is the third and final PR in that effort. This PR is stacked on #5210 and #5211. The tracking issue is https://hasurahq.atlassian.net/browse/MM-35 PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5212 GitOrigin-RevId: 6cde6d52173590fafe0969a06f2a3411db4fbc78
This commit is contained in:
parent
b9ec9b78dd
commit
ab59be86c3
@ -677,6 +677,7 @@ library
|
||||
, Hasura.RQL.Types.Metadata.Common
|
||||
, Hasura.RQL.Types.Metadata.Instances
|
||||
, Hasura.RQL.Types.Metadata.Object
|
||||
, Hasura.RQL.Types.Metadata.Serialization
|
||||
, Hasura.RQL.Types.Network
|
||||
, Hasura.RQL.Types.Permission
|
||||
, Hasura.RQL.Types.QueryCollection
|
||||
|
@ -41,30 +41,18 @@ module Hasura.RQL.Types.Metadata
|
||||
where
|
||||
|
||||
import Control.Lens hiding (set, (.=))
|
||||
import Data.Aeson qualified as JSON
|
||||
import Data.Aeson.Extended (FromJSONWithContext (..), mapWithJSONPath)
|
||||
import Data.Aeson.Ordered qualified as AO
|
||||
import Data.Aeson.TH
|
||||
import Data.Aeson.Types
|
||||
import Data.HashMap.Strict.InsOrd.Extended qualified as OM
|
||||
import Data.Monoid (Dual (..), Endo (..))
|
||||
import Data.Text.Extended qualified as T
|
||||
import Data.Vector qualified as Vector
|
||||
import Hasura.Metadata.DTO.MetadataV3 (MetadataV3 (..))
|
||||
import Hasura.Metadata.DTO.Placeholder (IsPlaceholder (placeholder))
|
||||
import Hasura.Prelude
|
||||
import Hasura.RQL.Types.Action
|
||||
( ActionDefinition (..),
|
||||
ActionDefinitionInput,
|
||||
ActionMetadata (..),
|
||||
ActionPermissionMetadata (..),
|
||||
ActionType (..),
|
||||
ArgumentDefinition (..),
|
||||
)
|
||||
import Hasura.RQL.Types.Allowlist
|
||||
import Hasura.RQL.Types.ApiLimit
|
||||
import Hasura.RQL.Types.Backend
|
||||
import Hasura.RQL.Types.Column (ColumnValues)
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.RQL.Types.ComputedField
|
||||
import Hasura.RQL.Types.CustomTypes
|
||||
@ -73,21 +61,13 @@ import Hasura.RQL.Types.EventTrigger
|
||||
import Hasura.RQL.Types.Function
|
||||
import Hasura.RQL.Types.GraphqlSchemaIntrospection
|
||||
import Hasura.RQL.Types.Metadata.Common
|
||||
import Hasura.RQL.Types.Metadata.Serialization
|
||||
import Hasura.RQL.Types.Network
|
||||
import Hasura.RQL.Types.Permission
|
||||
import Hasura.RQL.Types.QueryCollection (CreateCollection (..))
|
||||
import Hasura.RQL.Types.Relationships.Local (RelDef (..))
|
||||
import Hasura.RQL.Types.Relationships.Remote (RemoteRelationship (..))
|
||||
import Hasura.RQL.Types.RemoteSchema
|
||||
import Hasura.RQL.Types.Roles (InheritedRole, Role (..))
|
||||
import Hasura.RQL.Types.ScheduledTrigger (CronTriggerMetadata (..), defaultSTRetryConf)
|
||||
import Hasura.RQL.Types.SourceCustomization (emptySourceCustomization)
|
||||
import Hasura.RQL.Types.Table (emptyTableConfig)
|
||||
import Hasura.SQL.AnyBackend qualified as AB
|
||||
import Hasura.SQL.Backend
|
||||
import Hasura.SQL.BackendMap (BackendMap)
|
||||
import Hasura.SQL.BackendMap qualified as BackendMap
|
||||
import Hasura.SQL.Tag (HasTag (backendTag), reify)
|
||||
import Hasura.Session
|
||||
import Hasura.Tracing (TraceT)
|
||||
import Language.GraphQL.Draft.Syntax qualified as G
|
||||
@ -482,544 +462,3 @@ metadataToDTO
|
||||
-- This is a /partial/ function to unwrap a JSON object
|
||||
objectFromOrdJSON (AO.Object obj) = obj
|
||||
objectFromOrdJSON _ = error "expected an object"
|
||||
|
||||
sourcesToOrdJSONList :: Sources -> AO.Array
|
||||
sourcesToOrdJSONList sources =
|
||||
Vector.fromList $
|
||||
map sourceMetaToOrdJSON $ sortOn getSourceName $ OM.elems sources
|
||||
where
|
||||
sourceMetaToOrdJSON :: BackendSourceMetadata -> AO.Value
|
||||
sourceMetaToOrdJSON exists =
|
||||
AB.dispatchAnyBackend @Backend exists $ \(SourceMetadata {..} :: SourceMetadata b) ->
|
||||
let sourceNamePair = ("name", AO.toOrdered _smName)
|
||||
sourceKindPair = ("kind", AO.toOrdered _smKind)
|
||||
tablesPair = ("tables", AO.array $ map tableMetaToOrdJSON $ sortOn _tmTable $ OM.elems _smTables)
|
||||
functionsPair = listToMaybeOrdPairSort "functions" functionMetadataToOrdJSON _fmFunction _smFunctions
|
||||
configurationPair = [("configuration", AO.toOrdered _smConfiguration)]
|
||||
queryTagsConfigPair = maybe [] (\queryTagsConfig -> [("query_tags", AO.toOrdered queryTagsConfig)]) _smQueryTags
|
||||
|
||||
customizationPair =
|
||||
guard (_smCustomization /= emptySourceCustomization)
|
||||
*> [("customization", AO.toOrdered _smCustomization)]
|
||||
in AO.object $ [sourceNamePair, sourceKindPair, tablesPair] <> maybeToList functionsPair <> configurationPair <> queryTagsConfigPair <> customizationPair
|
||||
|
||||
tableMetaToOrdJSON :: (Backend b) => TableMetadata b -> AO.Value
|
||||
tableMetaToOrdJSON
|
||||
( TableMetadata
|
||||
table
|
||||
isEnum
|
||||
config
|
||||
objectRelationships
|
||||
arrayRelationships
|
||||
computedFields
|
||||
remoteRelationships
|
||||
insertPermissions
|
||||
selectPermissions
|
||||
updatePermissions
|
||||
deletePermissions
|
||||
eventTriggers
|
||||
enableApolloFed
|
||||
) =
|
||||
AO.object $
|
||||
[("table", AO.toOrdered table)]
|
||||
<> catMaybes
|
||||
[ isEnumPair,
|
||||
configPair,
|
||||
objectRelationshipsPair,
|
||||
arrayRelationshipsPair,
|
||||
computedFieldsPair,
|
||||
remoteRelationshipsPair,
|
||||
insertPermissionsPair,
|
||||
selectPermissionsPair,
|
||||
updatePermissionsPair,
|
||||
deletePermissionsPair,
|
||||
eventTriggersPair,
|
||||
apolloFedConfigPair
|
||||
]
|
||||
where
|
||||
isEnumPair = if isEnum then Just ("is_enum", AO.toOrdered isEnum) else Nothing
|
||||
apolloFedConfigPair = fmap (\afConfig -> ("apollo_federation_config", AO.toOrdered afConfig)) enableApolloFed
|
||||
configPair =
|
||||
if config == emptyTableConfig
|
||||
then Nothing
|
||||
else Just ("configuration", AO.toOrdered config)
|
||||
objectRelationshipsPair =
|
||||
listToMaybeOrdPairSort
|
||||
"object_relationships"
|
||||
relDefToOrdJSON
|
||||
_rdName
|
||||
objectRelationships
|
||||
arrayRelationshipsPair =
|
||||
listToMaybeOrdPairSort
|
||||
"array_relationships"
|
||||
relDefToOrdJSON
|
||||
_rdName
|
||||
arrayRelationships
|
||||
computedFieldsPair =
|
||||
listToMaybeOrdPairSort
|
||||
"computed_fields"
|
||||
computedFieldMetaToOrdJSON
|
||||
_cfmName
|
||||
computedFields
|
||||
remoteRelationshipsPair =
|
||||
listToMaybeOrdPairSort
|
||||
"remote_relationships"
|
||||
AO.toOrdered
|
||||
_rrName
|
||||
remoteRelationships
|
||||
insertPermissionsPair =
|
||||
listToMaybeOrdPairSort
|
||||
"insert_permissions"
|
||||
insPermDefToOrdJSON
|
||||
_pdRole
|
||||
insertPermissions
|
||||
selectPermissionsPair =
|
||||
listToMaybeOrdPairSort
|
||||
"select_permissions"
|
||||
selPermDefToOrdJSON
|
||||
_pdRole
|
||||
selectPermissions
|
||||
updatePermissionsPair =
|
||||
listToMaybeOrdPairSort
|
||||
"update_permissions"
|
||||
updPermDefToOrdJSON
|
||||
_pdRole
|
||||
updatePermissions
|
||||
deletePermissionsPair =
|
||||
listToMaybeOrdPairSort
|
||||
"delete_permissions"
|
||||
delPermDefToOrdJSON
|
||||
_pdRole
|
||||
deletePermissions
|
||||
eventTriggersPair =
|
||||
listToMaybeOrdPairSort
|
||||
"event_triggers"
|
||||
eventTriggerConfToOrdJSON
|
||||
etcName
|
||||
eventTriggers
|
||||
|
||||
relDefToOrdJSON :: (ToJSON a) => RelDef a -> AO.Value
|
||||
relDefToOrdJSON (RelDef name using comment) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered name),
|
||||
("using", AO.toOrdered using)
|
||||
]
|
||||
<> catMaybes [maybeCommentToMaybeOrdPair comment]
|
||||
|
||||
computedFieldMetaToOrdJSON :: (Backend b) => ComputedFieldMetadata b -> AO.Value
|
||||
computedFieldMetaToOrdJSON (ComputedFieldMetadata name definition comment) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered name),
|
||||
("definition", AO.toOrdered definition)
|
||||
]
|
||||
<> catMaybes [commentToMaybeOrdPair comment]
|
||||
|
||||
insPermDefToOrdJSON :: forall b. (Backend b) => InsPermDef b -> AO.Value
|
||||
insPermDefToOrdJSON = permDefToOrdJSON insPermToOrdJSON
|
||||
where
|
||||
insPermToOrdJSON (InsPerm check set columns backendOnly) =
|
||||
let columnsPair = ("columns",) . AO.toOrdered <$> columns
|
||||
backendOnlyPair =
|
||||
if backendOnly
|
||||
then Just ("backend_only", AO.toOrdered backendOnly)
|
||||
else Nothing
|
||||
in AO.object $
|
||||
[("check", AO.toOrdered check)]
|
||||
<> catMaybes [maybeSetToMaybeOrdPair @b set, columnsPair, backendOnlyPair]
|
||||
|
||||
selPermDefToOrdJSON :: Backend b => SelPermDef b -> AO.Value
|
||||
selPermDefToOrdJSON = permDefToOrdJSON selPermToOrdJSON
|
||||
where
|
||||
selPermToOrdJSON (SelPerm columns fltr limit allowAgg computedFieldsPerm allowedQueryRootFieldTypes allowedSubscriptionRootFieldTypes) =
|
||||
AO.object $
|
||||
catMaybes
|
||||
[ columnsPair,
|
||||
computedFieldsPermPair,
|
||||
filterPair,
|
||||
limitPair,
|
||||
allowAggPair,
|
||||
allowedQueryRootFieldsPair,
|
||||
allowedSubscriptionRootFieldsPair
|
||||
]
|
||||
where
|
||||
columnsPair = Just ("columns", AO.toOrdered columns)
|
||||
computedFieldsPermPair = listToMaybeOrdPair "computed_fields" AO.toOrdered computedFieldsPerm
|
||||
filterPair = Just ("filter", AO.toOrdered fltr)
|
||||
limitPair = maybeAnyToMaybeOrdPair "limit" AO.toOrdered limit
|
||||
allowAggPair =
|
||||
if allowAgg
|
||||
then Just ("allow_aggregations", AO.toOrdered allowAgg)
|
||||
else Nothing
|
||||
allowedQueryRootFieldsPair =
|
||||
case allowedQueryRootFieldTypes of
|
||||
ARFAllowAllRootFields -> Nothing
|
||||
ARFAllowConfiguredRootFields configuredRootFields ->
|
||||
Just ("query_root_fields", AO.toOrdered configuredRootFields)
|
||||
allowedSubscriptionRootFieldsPair =
|
||||
case allowedSubscriptionRootFieldTypes of
|
||||
ARFAllowAllRootFields -> Nothing
|
||||
ARFAllowConfiguredRootFields configuredRootFields ->
|
||||
Just ("subscription_root_fields", AO.toOrdered configuredRootFields)
|
||||
|
||||
updPermDefToOrdJSON :: forall b. Backend b => UpdPermDef b -> AO.Value
|
||||
updPermDefToOrdJSON = permDefToOrdJSON updPermToOrdJSON
|
||||
where
|
||||
updPermToOrdJSON (UpdPerm columns set fltr check backendOnly) =
|
||||
let backendOnlyPair =
|
||||
if backendOnly
|
||||
then Just ("backend_only", AO.toOrdered backendOnly)
|
||||
else Nothing
|
||||
in AO.object $
|
||||
[ ("columns", AO.toOrdered columns),
|
||||
("filter", AO.toOrdered fltr),
|
||||
("check", AO.toOrdered check)
|
||||
]
|
||||
<> catMaybes [maybeSetToMaybeOrdPair @b set, backendOnlyPair]
|
||||
|
||||
delPermDefToOrdJSON :: Backend b => DelPermDef b -> AO.Value
|
||||
delPermDefToOrdJSON = permDefToOrdJSON AO.toOrdered
|
||||
|
||||
permDefToOrdJSON :: (a b -> AO.Value) -> PermDef b a -> AO.Value
|
||||
permDefToOrdJSON permToOrdJSON (PermDef role permission comment) =
|
||||
AO.object $
|
||||
[ ("role", AO.toOrdered role),
|
||||
("permission", permToOrdJSON (unPermDefPermission permission))
|
||||
]
|
||||
<> catMaybes [maybeCommentToMaybeOrdPair comment]
|
||||
|
||||
eventTriggerConfToOrdJSON :: Backend b => EventTriggerConf b -> AO.Value
|
||||
eventTriggerConfToOrdJSON (EventTriggerConf name definition webhook webhookFromEnv retryConf headers reqTransform respTransform) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered name),
|
||||
("definition", AO.toOrdered definition),
|
||||
("retry_conf", AO.toOrdered retryConf)
|
||||
]
|
||||
<> catMaybes
|
||||
[ maybeAnyToMaybeOrdPair "webhook" AO.toOrdered webhook,
|
||||
maybeAnyToMaybeOrdPair "webhook_from_env" AO.toOrdered webhookFromEnv,
|
||||
headers >>= listToMaybeOrdPair "headers" AO.toOrdered,
|
||||
fmap (("request_transform",) . AO.toOrdered) reqTransform,
|
||||
fmap (("response_transform",) . AO.toOrdered) respTransform
|
||||
]
|
||||
|
||||
functionMetadataToOrdJSON :: Backend b => FunctionMetadata b -> AO.Value
|
||||
functionMetadataToOrdJSON FunctionMetadata {..} =
|
||||
let confKeyPair =
|
||||
if _fmConfiguration == emptyFunctionConfig
|
||||
then []
|
||||
else pure ("configuration", AO.toOrdered _fmConfiguration)
|
||||
permissionsKeyPair =
|
||||
if null _fmPermissions
|
||||
then []
|
||||
else pure ("permissions", AO.toOrdered _fmPermissions)
|
||||
commentKeyPair =
|
||||
if isNothing _fmComment
|
||||
then []
|
||||
else pure ("comment", AO.toOrdered _fmComment)
|
||||
in AO.object $ [("function", AO.toOrdered _fmFunction)] <> confKeyPair <> permissionsKeyPair <> commentKeyPair
|
||||
|
||||
remoteSchemasToOrdJSONList :: RemoteSchemas -> Maybe AO.Array
|
||||
remoteSchemasToOrdJSONList = listToMaybeArraySort remoteSchemaQToOrdJSON _rsmName
|
||||
where
|
||||
remoteSchemaQToOrdJSON :: RemoteSchemaMetadata -> AO.Value
|
||||
remoteSchemaQToOrdJSON (RemoteSchemaMetadata name definition comment permissions relationships) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered name),
|
||||
("definition", remoteSchemaDefToOrdJSON definition)
|
||||
]
|
||||
<> catMaybes
|
||||
[ maybeCommentToMaybeOrdPair comment,
|
||||
listToMaybeOrdPair
|
||||
"permissions"
|
||||
permsToMaybeOrdJSON
|
||||
permissions,
|
||||
listToMaybeOrdPair
|
||||
"remote_relationships"
|
||||
AO.toOrdered
|
||||
relationships
|
||||
]
|
||||
where
|
||||
permsToMaybeOrdJSON :: RemoteSchemaPermissionMetadata -> AO.Value
|
||||
permsToMaybeOrdJSON (RemoteSchemaPermissionMetadata role defn permComment) =
|
||||
AO.object $
|
||||
[ ("role", AO.toOrdered role),
|
||||
("definition", AO.toOrdered defn)
|
||||
]
|
||||
<> catMaybes [maybeCommentToMaybeOrdPair permComment]
|
||||
|
||||
remoteSchemaDefToOrdJSON :: RemoteSchemaDef -> AO.Value
|
||||
remoteSchemaDefToOrdJSON (RemoteSchemaDef url urlFromEnv headers frwrdClientHdrs timeout customization) =
|
||||
AO.object $
|
||||
catMaybes
|
||||
[ maybeToPair "url" url,
|
||||
maybeToPair "url_from_env" urlFromEnv,
|
||||
maybeToPair "timeout_seconds" timeout,
|
||||
maybeToPair "customization" customization,
|
||||
headers >>= listToMaybeOrdPair "headers" AO.toOrdered
|
||||
]
|
||||
<> [("forward_client_headers", AO.toOrdered frwrdClientHdrs) | frwrdClientHdrs]
|
||||
where
|
||||
maybeToPair n = maybeAnyToMaybeOrdPair n AO.toOrdered
|
||||
|
||||
backendConfigsToOrdJSON :: BackendMap BackendConfigWrapper -> Maybe AO.Value
|
||||
backendConfigsToOrdJSON = ifNotEmpty (== mempty) configsToOrdJSON
|
||||
where
|
||||
configsToOrdJSON :: BackendMap BackendConfigWrapper -> AO.Value
|
||||
configsToOrdJSON backendConfigs' =
|
||||
AO.object . sortOn fst $ backendConfigToOrdJSON <$> BackendMap.elems backendConfigs'
|
||||
|
||||
backendConfigToOrdJSON :: AB.AnyBackend BackendConfigWrapper -> (Text, AO.Value)
|
||||
backendConfigToOrdJSON backendConfig =
|
||||
AB.dispatchAnyBackend @Backend backendConfig $ \((BackendConfigWrapper backendConfig') :: BackendConfigWrapper b) ->
|
||||
let backendTypeStr = T.toTxt $ reify $ backendTag @b
|
||||
val = AO.toOrdered backendConfig'
|
||||
in (backendTypeStr, val)
|
||||
|
||||
inheritedRolesToOrdJSONList :: InheritedRoles -> Maybe AO.Array
|
||||
inheritedRolesToOrdJSONList = listToMaybeArraySort inheritedRolesQToOrdJSON _rRoleName
|
||||
where
|
||||
inheritedRolesQToOrdJSON :: InheritedRole -> AO.Value
|
||||
inheritedRolesQToOrdJSON (Role roleName roleSet) =
|
||||
AO.object
|
||||
[ ("role_name", AO.toOrdered roleName),
|
||||
("role_set", AO.toOrdered roleSet)
|
||||
]
|
||||
|
||||
queryCollectionsToOrdJSONList :: QueryCollections -> Maybe AO.Array
|
||||
queryCollectionsToOrdJSONList = listToMaybeArraySort createCollectionToOrdJSON _ccName
|
||||
where
|
||||
createCollectionToOrdJSON :: CreateCollection -> AO.Value
|
||||
createCollectionToOrdJSON (CreateCollection name definition comment) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered name),
|
||||
("definition", AO.toOrdered definition)
|
||||
]
|
||||
<> catMaybes [maybeCommentToMaybeOrdPair comment]
|
||||
|
||||
allowlistToOrdJSONList :: MetadataAllowlist -> Maybe AO.Array
|
||||
allowlistToOrdJSONList = listToMaybeArraySort (AO.toOrdered . toJSON @AllowlistEntry) aeCollection
|
||||
|
||||
apiLimitsToOrdJSON :: ApiLimit -> Maybe AO.Value
|
||||
apiLimitsToOrdJSON apiLimits
|
||||
| apiLimits == emptyApiLimit = Nothing
|
||||
| otherwise = Just $ AO.toOrdered apiLimits
|
||||
|
||||
cronTriggersToOrdJSONList :: CronTriggers -> Maybe AO.Array
|
||||
cronTriggersToOrdJSONList = listToMaybeArraySort crontriggerQToOrdJSON ctName
|
||||
where
|
||||
crontriggerQToOrdJSON :: CronTriggerMetadata -> AO.Value
|
||||
crontriggerQToOrdJSON
|
||||
(CronTriggerMetadata name webhook schedule payload retryConf headers includeInMetadata comment reqTransform respTransform) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered name),
|
||||
("webhook", AO.toOrdered webhook),
|
||||
("schedule", AO.toOrdered schedule),
|
||||
("include_in_metadata", AO.toOrdered includeInMetadata)
|
||||
]
|
||||
<> catMaybes
|
||||
[ maybeAnyToMaybeOrdPair "payload" AO.toOrdered payload,
|
||||
maybeAnyToMaybeOrdPair "retry_conf" AO.toOrdered (maybeRetryConfiguration retryConf),
|
||||
maybeAnyToMaybeOrdPair "headers" AO.toOrdered (maybeHeader headers),
|
||||
maybeAnyToMaybeOrdPair "comment" AO.toOrdered comment,
|
||||
fmap (("request_transform",) . AO.toOrdered) reqTransform,
|
||||
fmap (("response_transform",) . AO.toOrdered) respTransform
|
||||
]
|
||||
where
|
||||
maybeRetryConfiguration retryConfig
|
||||
| retryConfig == defaultSTRetryConf = Nothing
|
||||
| otherwise = Just retryConfig
|
||||
|
||||
maybeHeader headerConfig
|
||||
| null headerConfig = Nothing
|
||||
| otherwise = Just headerConfig
|
||||
|
||||
customTypesToOrdJSON :: CustomTypes -> Maybe AO.Object
|
||||
customTypesToOrdJSON customTypes@(CustomTypes inpObjs objs scalars enums)
|
||||
| customTypes == emptyCustomTypes = Nothing
|
||||
| otherwise =
|
||||
Just . AO.fromList . catMaybes $
|
||||
[ listToMaybeOrdPair "input_objects" inputObjectToOrdJSON inpObjs,
|
||||
listToMaybeOrdPair "objects" objectTypeToOrdJSON objs,
|
||||
listToMaybeOrdPair "scalars" scalarTypeToOrdJSON scalars,
|
||||
listToMaybeOrdPair "enums" enumTypeToOrdJSON enums
|
||||
]
|
||||
where
|
||||
inputObjectToOrdJSON :: InputObjectTypeDefinition -> AO.Value
|
||||
inputObjectToOrdJSON (InputObjectTypeDefinition tyName descM fields) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered tyName),
|
||||
("fields", AO.array $ map fieldDefinitionToOrdJSON $ toList fields)
|
||||
]
|
||||
<> catMaybes [maybeDescriptionToMaybeOrdPair descM]
|
||||
where
|
||||
fieldDefinitionToOrdJSON :: InputObjectFieldDefinition -> AO.Value
|
||||
fieldDefinitionToOrdJSON (InputObjectFieldDefinition fieldName fieldDescM ty) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered fieldName),
|
||||
("type", AO.toOrdered ty)
|
||||
]
|
||||
<> catMaybes [maybeDescriptionToMaybeOrdPair fieldDescM]
|
||||
|
||||
objectTypeToOrdJSON :: ObjectTypeDefinition -> AO.Value
|
||||
objectTypeToOrdJSON (ObjectTypeDefinition tyName descM fields rels) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered tyName),
|
||||
("fields", AO.array $ map fieldDefinitionToOrdJSON $ toList fields)
|
||||
]
|
||||
<> catMaybes
|
||||
[ maybeDescriptionToMaybeOrdPair descM,
|
||||
listToMaybeOrdPair "relationships" AO.toOrdered rels
|
||||
]
|
||||
where
|
||||
fieldDefinitionToOrdJSON :: ObjectFieldDefinition GraphQLType -> AO.Value
|
||||
fieldDefinitionToOrdJSON (ObjectFieldDefinition fieldName argsValM fieldDescM ty) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered fieldName),
|
||||
("type", AO.toOrdered ty)
|
||||
]
|
||||
<> catMaybes
|
||||
[ ("arguments",) . AO.toOrdered <$> argsValM,
|
||||
maybeDescriptionToMaybeOrdPair fieldDescM
|
||||
]
|
||||
|
||||
scalarTypeToOrdJSON :: ScalarTypeDefinition -> AO.Value
|
||||
scalarTypeToOrdJSON (ScalarTypeDefinition tyName descM) =
|
||||
AO.object $
|
||||
[("name", AO.toOrdered tyName)]
|
||||
<> catMaybes [maybeDescriptionToMaybeOrdPair descM]
|
||||
|
||||
enumTypeToOrdJSON :: EnumTypeDefinition -> AO.Value
|
||||
enumTypeToOrdJSON (EnumTypeDefinition tyName descM values) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered tyName),
|
||||
("values", AO.toOrdered values)
|
||||
]
|
||||
<> catMaybes [maybeDescriptionToMaybeOrdPair descM]
|
||||
|
||||
endpointsToOrdJSONList :: Endpoints -> Maybe AO.Array
|
||||
endpointsToOrdJSONList = listToMaybeArraySort AO.toOrdered _ceUrl
|
||||
|
||||
introspectionDisabledRolesToOrdJSON :: SetGraphqlIntrospectionOptions -> Maybe AO.Value
|
||||
introspectionDisabledRolesToOrdJSON = ifNotEmpty (== mempty) AO.toOrdered
|
||||
|
||||
metricsConfigToOrdJSON :: MetricsConfig -> Maybe AO.Value
|
||||
metricsConfigToOrdJSON = ifNotEmpty (== emptyMetricsConfig) AO.toOrdered
|
||||
|
||||
networkConfigToOrdJSON :: Network -> Maybe AO.Value
|
||||
networkConfigToOrdJSON = ifNotEmpty (== emptyNetwork) AO.toOrdered
|
||||
|
||||
actionMetadataToOrdJSONList :: Actions -> Maybe AO.Array
|
||||
actionMetadataToOrdJSONList = listToMaybeArraySort actionMetadataToOrdJSON _amName
|
||||
where
|
||||
actionMetadataToOrdJSON :: ActionMetadata -> AO.Value
|
||||
actionMetadataToOrdJSON (ActionMetadata name comment definition permissions) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered name),
|
||||
("definition", actionDefinitionToOrdJSON definition)
|
||||
]
|
||||
<> catMaybes
|
||||
[ maybeCommentToMaybeOrdPair comment,
|
||||
listToMaybeOrdPair "permissions" permToOrdJSON permissions
|
||||
]
|
||||
where
|
||||
argDefinitionToOrdJSON :: ArgumentDefinition GraphQLType -> AO.Value
|
||||
argDefinitionToOrdJSON (ArgumentDefinition argName ty descM) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered argName),
|
||||
("type", AO.toOrdered ty)
|
||||
]
|
||||
<> catMaybes [maybeAnyToMaybeOrdPair "description" AO.toOrdered descM]
|
||||
|
||||
actionDefinitionToOrdJSON :: ActionDefinitionInput -> AO.Value
|
||||
actionDefinitionToOrdJSON
|
||||
( ActionDefinition
|
||||
args
|
||||
outputType
|
||||
actionType
|
||||
headers
|
||||
frwrdClientHdrs
|
||||
timeout
|
||||
handler
|
||||
requestTransform
|
||||
responseTransform
|
||||
) =
|
||||
let typeAndKind = case actionType of
|
||||
ActionQuery -> [("type", AO.toOrdered ("query" :: String))]
|
||||
ActionMutation kind ->
|
||||
[ ("type", AO.toOrdered ("mutation" :: String)),
|
||||
("kind", AO.toOrdered kind)
|
||||
]
|
||||
in AO.object $
|
||||
[ ("handler", AO.toOrdered handler),
|
||||
("output_type", AO.toOrdered outputType)
|
||||
]
|
||||
<> [("forward_client_headers", AO.toOrdered frwrdClientHdrs) | frwrdClientHdrs]
|
||||
<> catMaybes
|
||||
[ listToMaybeOrdPair "headers" AO.toOrdered headers,
|
||||
listToMaybeOrdPair "arguments" argDefinitionToOrdJSON args,
|
||||
fmap (("request_transform",) . AO.toOrdered) requestTransform,
|
||||
fmap (("response_transform",) . AO.toOrdered) responseTransform
|
||||
]
|
||||
<> typeAndKind
|
||||
<> bool [("timeout", AO.toOrdered timeout)] mempty (timeout == defaultActionTimeoutSecs)
|
||||
|
||||
permToOrdJSON :: ActionPermissionMetadata -> AO.Value
|
||||
permToOrdJSON (ActionPermissionMetadata role permComment) =
|
||||
AO.object $ [("role", AO.toOrdered role)] <> catMaybes [maybeCommentToMaybeOrdPair permComment]
|
||||
|
||||
ifNotEmpty :: (a -> Bool) -> (a -> b) -> a -> Maybe b
|
||||
ifNotEmpty isEmpty f x
|
||||
| isEmpty x = Nothing
|
||||
| otherwise = Just $ f x
|
||||
|
||||
-- | Sort list before encoding to JSON value
|
||||
listToMaybeOrdPairSort ::
|
||||
(Foldable t, Ord b) =>
|
||||
Text ->
|
||||
(a -> AO.Value) ->
|
||||
(a -> b) ->
|
||||
t a ->
|
||||
Maybe (Text, AO.Value)
|
||||
listToMaybeOrdPairSort name f sortF ta = case toList ta of
|
||||
[] -> Nothing
|
||||
list -> Just $ (name,) $ AO.array $ map f $ sortOn sortF list
|
||||
|
||||
-- | Sort list before encoding to JSON array (not value)
|
||||
listToMaybeArraySort ::
|
||||
(Foldable t, Ord b) =>
|
||||
(a -> AO.Value) ->
|
||||
(a -> b) ->
|
||||
t a ->
|
||||
Maybe AO.Array
|
||||
listToMaybeArraySort f sortF ta = case toList ta of
|
||||
[] -> Nothing
|
||||
list -> Just $ Vector.fromList $ map f $ sortOn sortF list
|
||||
|
||||
listToMaybeOrdPair ::
|
||||
(Foldable t) =>
|
||||
Text ->
|
||||
(a -> AO.Value) ->
|
||||
t a ->
|
||||
Maybe (Text, AO.Value)
|
||||
listToMaybeOrdPair name f ta = case toList ta of
|
||||
[] -> Nothing
|
||||
list -> Just $ (name,) $ AO.array $ map f list
|
||||
|
||||
maybeSetToMaybeOrdPair :: (Backend b) => Maybe (ColumnValues b JSON.Value) -> Maybe (Text, AO.Value)
|
||||
maybeSetToMaybeOrdPair set =
|
||||
set >>= \colVals ->
|
||||
if colVals == mempty
|
||||
then Nothing
|
||||
else Just ("set", AO.toOrdered colVals)
|
||||
|
||||
maybeDescriptionToMaybeOrdPair :: Maybe G.Description -> Maybe (Text, AO.Value)
|
||||
maybeDescriptionToMaybeOrdPair = maybeAnyToMaybeOrdPair "description" AO.toOrdered
|
||||
|
||||
maybeCommentToMaybeOrdPair :: Maybe Text -> Maybe (Text, AO.Value)
|
||||
maybeCommentToMaybeOrdPair = maybeAnyToMaybeOrdPair "comment" AO.toOrdered
|
||||
|
||||
maybeAnyToMaybeOrdPair :: Text -> (a -> AO.Value) -> Maybe a -> Maybe (Text, AO.Value)
|
||||
maybeAnyToMaybeOrdPair name f = fmap ((name,) . f)
|
||||
|
||||
commentToMaybeOrdPair :: Comment -> Maybe (Text, AO.Value)
|
||||
commentToMaybeOrdPair comment = (\val -> ("comment", AO.toOrdered val)) <$> commentToMaybeText comment
|
||||
|
639
server/src-lib/Hasura/RQL/Types/Metadata/Serialization.hs
Normal file
639
server/src-lib/Hasura/RQL/Types/Metadata/Serialization.hs
Normal file
@ -0,0 +1,639 @@
|
||||
-- | Helpers used in the implementations of 'metadataToOrdJSON' and
|
||||
-- 'metadataToDTO'
|
||||
module Hasura.RQL.Types.Metadata.Serialization
|
||||
( actionMetadataToOrdJSONList,
|
||||
allowlistToOrdJSONList,
|
||||
apiLimitsToOrdJSON,
|
||||
backendConfigsToOrdJSON,
|
||||
cronTriggersToOrdJSONList,
|
||||
customTypesToOrdJSON,
|
||||
endpointsToOrdJSONList,
|
||||
inheritedRolesToOrdJSONList,
|
||||
introspectionDisabledRolesToOrdJSON,
|
||||
metricsConfigToOrdJSON,
|
||||
networkConfigToOrdJSON,
|
||||
queryCollectionsToOrdJSONList,
|
||||
remoteSchemasToOrdJSONList,
|
||||
sourcesToOrdJSONList,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson (ToJSON (..))
|
||||
import Data.Aeson qualified as JSON
|
||||
import Data.Aeson.Ordered qualified as AO
|
||||
import Data.HashMap.Strict.InsOrd.Extended qualified as OM
|
||||
import Data.Text.Extended qualified as T
|
||||
import Data.Vector qualified as Vector
|
||||
import Hasura.Prelude
|
||||
import Hasura.RQL.Types.Action
|
||||
( ActionDefinition (..),
|
||||
ActionDefinitionInput,
|
||||
ActionMetadata (..),
|
||||
ActionPermissionMetadata (..),
|
||||
ActionType (..),
|
||||
ArgumentDefinition (..),
|
||||
)
|
||||
import Hasura.RQL.Types.Allowlist (AllowlistEntry (..), MetadataAllowlist)
|
||||
import Hasura.RQL.Types.ApiLimit (ApiLimit, emptyApiLimit)
|
||||
import Hasura.RQL.Types.Backend (Backend)
|
||||
import Hasura.RQL.Types.Column (ColumnValues)
|
||||
import Hasura.RQL.Types.Common (Comment, MetricsConfig, commentToMaybeText, defaultActionTimeoutSecs, emptyMetricsConfig)
|
||||
import Hasura.RQL.Types.CustomTypes
|
||||
( CustomTypes (..),
|
||||
EnumTypeDefinition (..),
|
||||
GraphQLType (..),
|
||||
InputObjectFieldDefinition (..),
|
||||
InputObjectTypeDefinition (..),
|
||||
ObjectFieldDefinition (..),
|
||||
ObjectTypeDefinition (..),
|
||||
ScalarTypeDefinition (..),
|
||||
emptyCustomTypes,
|
||||
)
|
||||
import Hasura.RQL.Types.Endpoint (EndpointMetadata (..))
|
||||
import Hasura.RQL.Types.EventTrigger (EventTriggerConf (..))
|
||||
import Hasura.RQL.Types.Function (emptyFunctionConfig)
|
||||
import Hasura.RQL.Types.GraphqlSchemaIntrospection (SetGraphqlIntrospectionOptions)
|
||||
import Hasura.RQL.Types.Metadata.Common
|
||||
( Actions,
|
||||
BackendConfigWrapper (..),
|
||||
BackendSourceMetadata,
|
||||
ComputedFieldMetadata (..),
|
||||
CronTriggers,
|
||||
Endpoints,
|
||||
FunctionMetadata (..),
|
||||
InheritedRoles,
|
||||
RemoteSchemaMetadata (..),
|
||||
RemoteSchemaPermissionMetadata (..),
|
||||
RemoteSchemas,
|
||||
SourceMetadata (..),
|
||||
Sources,
|
||||
TableMetadata (..),
|
||||
getSourceName,
|
||||
)
|
||||
import Hasura.RQL.Types.Network (Network, emptyNetwork)
|
||||
import Hasura.RQL.Types.Permission
|
||||
( AllowedRootFields (..),
|
||||
DelPermDef,
|
||||
InsPerm (..),
|
||||
InsPermDef,
|
||||
PermDef (..),
|
||||
SelPerm (..),
|
||||
SelPermDef,
|
||||
UpdPerm (..),
|
||||
UpdPermDef,
|
||||
unPermDefPermission,
|
||||
)
|
||||
import Hasura.RQL.Types.QueryCollection (CreateCollection (..), QueryCollections)
|
||||
import Hasura.RQL.Types.Relationships.Local (RelDef (..))
|
||||
import Hasura.RQL.Types.Relationships.Remote (RemoteRelationship (..))
|
||||
import Hasura.RQL.Types.RemoteSchema (RemoteSchemaDef (..))
|
||||
import Hasura.RQL.Types.Roles (InheritedRole, Role (..))
|
||||
import Hasura.RQL.Types.ScheduledTrigger (CronTriggerMetadata (..), defaultSTRetryConf)
|
||||
import Hasura.RQL.Types.SourceCustomization (emptySourceCustomization)
|
||||
import Hasura.RQL.Types.Table (emptyTableConfig)
|
||||
import Hasura.SQL.AnyBackend qualified as AB
|
||||
import Hasura.SQL.BackendMap (BackendMap)
|
||||
import Hasura.SQL.BackendMap qualified as BackendMap
|
||||
import Hasura.SQL.Tag (HasTag (backendTag), reify)
|
||||
import Language.GraphQL.Draft.Syntax qualified as G
|
||||
|
||||
sourcesToOrdJSONList :: Sources -> AO.Array
|
||||
sourcesToOrdJSONList sources =
|
||||
Vector.fromList $
|
||||
map sourceMetaToOrdJSON $ sortOn getSourceName $ OM.elems sources
|
||||
where
|
||||
sourceMetaToOrdJSON :: BackendSourceMetadata -> AO.Value
|
||||
sourceMetaToOrdJSON exists =
|
||||
AB.dispatchAnyBackend @Backend exists $ \(SourceMetadata {..} :: SourceMetadata b) ->
|
||||
let sourceNamePair = ("name", AO.toOrdered _smName)
|
||||
sourceKindPair = ("kind", AO.toOrdered _smKind)
|
||||
tablesPair = ("tables", AO.array $ map tableMetaToOrdJSON $ sortOn _tmTable $ OM.elems _smTables)
|
||||
functionsPair = listToMaybeOrdPairSort "functions" functionMetadataToOrdJSON _fmFunction _smFunctions
|
||||
configurationPair = [("configuration", AO.toOrdered _smConfiguration)]
|
||||
queryTagsConfigPair = maybe [] (\queryTagsConfig -> [("query_tags", AO.toOrdered queryTagsConfig)]) _smQueryTags
|
||||
|
||||
customizationPair =
|
||||
guard (_smCustomization /= emptySourceCustomization)
|
||||
*> [("customization", AO.toOrdered _smCustomization)]
|
||||
in AO.object $ [sourceNamePair, sourceKindPair, tablesPair] <> maybeToList functionsPair <> configurationPair <> queryTagsConfigPair <> customizationPair
|
||||
|
||||
tableMetaToOrdJSON :: (Backend b) => TableMetadata b -> AO.Value
|
||||
tableMetaToOrdJSON
|
||||
( TableMetadata
|
||||
table
|
||||
isEnum
|
||||
config
|
||||
objectRelationships
|
||||
arrayRelationships
|
||||
computedFields
|
||||
remoteRelationships
|
||||
insertPermissions
|
||||
selectPermissions
|
||||
updatePermissions
|
||||
deletePermissions
|
||||
eventTriggers
|
||||
enableApolloFed
|
||||
) =
|
||||
AO.object $
|
||||
[("table", AO.toOrdered table)]
|
||||
<> catMaybes
|
||||
[ isEnumPair,
|
||||
configPair,
|
||||
objectRelationshipsPair,
|
||||
arrayRelationshipsPair,
|
||||
computedFieldsPair,
|
||||
remoteRelationshipsPair,
|
||||
insertPermissionsPair,
|
||||
selectPermissionsPair,
|
||||
updatePermissionsPair,
|
||||
deletePermissionsPair,
|
||||
eventTriggersPair,
|
||||
apolloFedConfigPair
|
||||
]
|
||||
where
|
||||
isEnumPair = if isEnum then Just ("is_enum", AO.toOrdered isEnum) else Nothing
|
||||
apolloFedConfigPair = fmap (\afConfig -> ("apollo_federation_config", AO.toOrdered afConfig)) enableApolloFed
|
||||
configPair =
|
||||
if config == emptyTableConfig
|
||||
then Nothing
|
||||
else Just ("configuration", AO.toOrdered config)
|
||||
objectRelationshipsPair =
|
||||
listToMaybeOrdPairSort
|
||||
"object_relationships"
|
||||
relDefToOrdJSON
|
||||
_rdName
|
||||
objectRelationships
|
||||
arrayRelationshipsPair =
|
||||
listToMaybeOrdPairSort
|
||||
"array_relationships"
|
||||
relDefToOrdJSON
|
||||
_rdName
|
||||
arrayRelationships
|
||||
computedFieldsPair =
|
||||
listToMaybeOrdPairSort
|
||||
"computed_fields"
|
||||
computedFieldMetaToOrdJSON
|
||||
_cfmName
|
||||
computedFields
|
||||
remoteRelationshipsPair =
|
||||
listToMaybeOrdPairSort
|
||||
"remote_relationships"
|
||||
AO.toOrdered
|
||||
_rrName
|
||||
remoteRelationships
|
||||
insertPermissionsPair =
|
||||
listToMaybeOrdPairSort
|
||||
"insert_permissions"
|
||||
insPermDefToOrdJSON
|
||||
_pdRole
|
||||
insertPermissions
|
||||
selectPermissionsPair =
|
||||
listToMaybeOrdPairSort
|
||||
"select_permissions"
|
||||
selPermDefToOrdJSON
|
||||
_pdRole
|
||||
selectPermissions
|
||||
updatePermissionsPair =
|
||||
listToMaybeOrdPairSort
|
||||
"update_permissions"
|
||||
updPermDefToOrdJSON
|
||||
_pdRole
|
||||
updatePermissions
|
||||
deletePermissionsPair =
|
||||
listToMaybeOrdPairSort
|
||||
"delete_permissions"
|
||||
delPermDefToOrdJSON
|
||||
_pdRole
|
||||
deletePermissions
|
||||
eventTriggersPair =
|
||||
listToMaybeOrdPairSort
|
||||
"event_triggers"
|
||||
eventTriggerConfToOrdJSON
|
||||
etcName
|
||||
eventTriggers
|
||||
|
||||
relDefToOrdJSON :: (ToJSON a) => RelDef a -> AO.Value
|
||||
relDefToOrdJSON (RelDef name using comment) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered name),
|
||||
("using", AO.toOrdered using)
|
||||
]
|
||||
<> catMaybes [maybeCommentToMaybeOrdPair comment]
|
||||
|
||||
computedFieldMetaToOrdJSON :: (Backend b) => ComputedFieldMetadata b -> AO.Value
|
||||
computedFieldMetaToOrdJSON (ComputedFieldMetadata name definition comment) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered name),
|
||||
("definition", AO.toOrdered definition)
|
||||
]
|
||||
<> catMaybes [commentToMaybeOrdPair comment]
|
||||
|
||||
insPermDefToOrdJSON :: forall b. (Backend b) => InsPermDef b -> AO.Value
|
||||
insPermDefToOrdJSON = permDefToOrdJSON insPermToOrdJSON
|
||||
where
|
||||
insPermToOrdJSON (InsPerm check set columns backendOnly) =
|
||||
let columnsPair = ("columns",) . AO.toOrdered <$> columns
|
||||
backendOnlyPair =
|
||||
if backendOnly
|
||||
then Just ("backend_only", AO.toOrdered backendOnly)
|
||||
else Nothing
|
||||
in AO.object $
|
||||
[("check", AO.toOrdered check)]
|
||||
<> catMaybes [maybeSetToMaybeOrdPair @b set, columnsPair, backendOnlyPair]
|
||||
|
||||
selPermDefToOrdJSON :: Backend b => SelPermDef b -> AO.Value
|
||||
selPermDefToOrdJSON = permDefToOrdJSON selPermToOrdJSON
|
||||
where
|
||||
selPermToOrdJSON (SelPerm columns fltr limit allowAgg computedFieldsPerm allowedQueryRootFieldTypes allowedSubscriptionRootFieldTypes) =
|
||||
AO.object $
|
||||
catMaybes
|
||||
[ columnsPair,
|
||||
computedFieldsPermPair,
|
||||
filterPair,
|
||||
limitPair,
|
||||
allowAggPair,
|
||||
allowedQueryRootFieldsPair,
|
||||
allowedSubscriptionRootFieldsPair
|
||||
]
|
||||
where
|
||||
columnsPair = Just ("columns", AO.toOrdered columns)
|
||||
computedFieldsPermPair = listToMaybeOrdPair "computed_fields" AO.toOrdered computedFieldsPerm
|
||||
filterPair = Just ("filter", AO.toOrdered fltr)
|
||||
limitPair = maybeAnyToMaybeOrdPair "limit" AO.toOrdered limit
|
||||
allowAggPair =
|
||||
if allowAgg
|
||||
then Just ("allow_aggregations", AO.toOrdered allowAgg)
|
||||
else Nothing
|
||||
allowedQueryRootFieldsPair =
|
||||
case allowedQueryRootFieldTypes of
|
||||
ARFAllowAllRootFields -> Nothing
|
||||
ARFAllowConfiguredRootFields configuredRootFields ->
|
||||
Just ("query_root_fields", AO.toOrdered configuredRootFields)
|
||||
allowedSubscriptionRootFieldsPair =
|
||||
case allowedSubscriptionRootFieldTypes of
|
||||
ARFAllowAllRootFields -> Nothing
|
||||
ARFAllowConfiguredRootFields configuredRootFields ->
|
||||
Just ("subscription_root_fields", AO.toOrdered configuredRootFields)
|
||||
|
||||
updPermDefToOrdJSON :: forall b. Backend b => UpdPermDef b -> AO.Value
|
||||
updPermDefToOrdJSON = permDefToOrdJSON updPermToOrdJSON
|
||||
where
|
||||
updPermToOrdJSON (UpdPerm columns set fltr check backendOnly) =
|
||||
let backendOnlyPair =
|
||||
if backendOnly
|
||||
then Just ("backend_only", AO.toOrdered backendOnly)
|
||||
else Nothing
|
||||
in AO.object $
|
||||
[ ("columns", AO.toOrdered columns),
|
||||
("filter", AO.toOrdered fltr),
|
||||
("check", AO.toOrdered check)
|
||||
]
|
||||
<> catMaybes [maybeSetToMaybeOrdPair @b set, backendOnlyPair]
|
||||
|
||||
delPermDefToOrdJSON :: Backend b => DelPermDef b -> AO.Value
|
||||
delPermDefToOrdJSON = permDefToOrdJSON AO.toOrdered
|
||||
|
||||
permDefToOrdJSON :: (a b -> AO.Value) -> PermDef b a -> AO.Value
|
||||
permDefToOrdJSON permToOrdJSON (PermDef role permission comment) =
|
||||
AO.object $
|
||||
[ ("role", AO.toOrdered role),
|
||||
("permission", permToOrdJSON (unPermDefPermission permission))
|
||||
]
|
||||
<> catMaybes [maybeCommentToMaybeOrdPair comment]
|
||||
|
||||
eventTriggerConfToOrdJSON :: Backend b => EventTriggerConf b -> AO.Value
|
||||
eventTriggerConfToOrdJSON (EventTriggerConf name definition webhook webhookFromEnv retryConf headers reqTransform respTransform) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered name),
|
||||
("definition", AO.toOrdered definition),
|
||||
("retry_conf", AO.toOrdered retryConf)
|
||||
]
|
||||
<> catMaybes
|
||||
[ maybeAnyToMaybeOrdPair "webhook" AO.toOrdered webhook,
|
||||
maybeAnyToMaybeOrdPair "webhook_from_env" AO.toOrdered webhookFromEnv,
|
||||
headers >>= listToMaybeOrdPair "headers" AO.toOrdered,
|
||||
fmap (("request_transform",) . AO.toOrdered) reqTransform,
|
||||
fmap (("response_transform",) . AO.toOrdered) respTransform
|
||||
]
|
||||
|
||||
functionMetadataToOrdJSON :: Backend b => FunctionMetadata b -> AO.Value
|
||||
functionMetadataToOrdJSON FunctionMetadata {..} =
|
||||
let confKeyPair =
|
||||
if _fmConfiguration == emptyFunctionConfig
|
||||
then []
|
||||
else pure ("configuration", AO.toOrdered _fmConfiguration)
|
||||
permissionsKeyPair =
|
||||
if null _fmPermissions
|
||||
then []
|
||||
else pure ("permissions", AO.toOrdered _fmPermissions)
|
||||
commentKeyPair =
|
||||
if isNothing _fmComment
|
||||
then []
|
||||
else pure ("comment", AO.toOrdered _fmComment)
|
||||
in AO.object $ [("function", AO.toOrdered _fmFunction)] <> confKeyPair <> permissionsKeyPair <> commentKeyPair
|
||||
|
||||
remoteSchemasToOrdJSONList :: RemoteSchemas -> Maybe AO.Array
|
||||
remoteSchemasToOrdJSONList = listToMaybeArraySort remoteSchemaQToOrdJSON _rsmName
|
||||
where
|
||||
remoteSchemaQToOrdJSON :: RemoteSchemaMetadata -> AO.Value
|
||||
remoteSchemaQToOrdJSON (RemoteSchemaMetadata name definition comment permissions relationships) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered name),
|
||||
("definition", remoteSchemaDefToOrdJSON definition)
|
||||
]
|
||||
<> catMaybes
|
||||
[ maybeCommentToMaybeOrdPair comment,
|
||||
listToMaybeOrdPair
|
||||
"permissions"
|
||||
permsToMaybeOrdJSON
|
||||
permissions,
|
||||
listToMaybeOrdPair
|
||||
"remote_relationships"
|
||||
AO.toOrdered
|
||||
relationships
|
||||
]
|
||||
where
|
||||
permsToMaybeOrdJSON :: RemoteSchemaPermissionMetadata -> AO.Value
|
||||
permsToMaybeOrdJSON (RemoteSchemaPermissionMetadata role defn permComment) =
|
||||
AO.object $
|
||||
[ ("role", AO.toOrdered role),
|
||||
("definition", AO.toOrdered defn)
|
||||
]
|
||||
<> catMaybes [maybeCommentToMaybeOrdPair permComment]
|
||||
|
||||
remoteSchemaDefToOrdJSON :: RemoteSchemaDef -> AO.Value
|
||||
remoteSchemaDefToOrdJSON (RemoteSchemaDef url urlFromEnv headers frwrdClientHdrs timeout customization) =
|
||||
AO.object $
|
||||
catMaybes
|
||||
[ maybeToPair "url" url,
|
||||
maybeToPair "url_from_env" urlFromEnv,
|
||||
maybeToPair "timeout_seconds" timeout,
|
||||
maybeToPair "customization" customization,
|
||||
headers >>= listToMaybeOrdPair "headers" AO.toOrdered
|
||||
]
|
||||
<> [("forward_client_headers", AO.toOrdered frwrdClientHdrs) | frwrdClientHdrs]
|
||||
where
|
||||
maybeToPair n = maybeAnyToMaybeOrdPair n AO.toOrdered
|
||||
|
||||
backendConfigsToOrdJSON :: BackendMap BackendConfigWrapper -> Maybe AO.Value
|
||||
backendConfigsToOrdJSON = ifNotEmpty (== mempty) configsToOrdJSON
|
||||
where
|
||||
configsToOrdJSON :: BackendMap BackendConfigWrapper -> AO.Value
|
||||
configsToOrdJSON backendConfigs' =
|
||||
AO.object . sortOn fst $ backendConfigToOrdJSON <$> BackendMap.elems backendConfigs'
|
||||
|
||||
backendConfigToOrdJSON :: AB.AnyBackend BackendConfigWrapper -> (Text, AO.Value)
|
||||
backendConfigToOrdJSON backendConfig =
|
||||
AB.dispatchAnyBackend @Backend backendConfig $ \((BackendConfigWrapper backendConfig') :: BackendConfigWrapper b) ->
|
||||
let backendTypeStr = T.toTxt $ reify $ backendTag @b
|
||||
val = AO.toOrdered backendConfig'
|
||||
in (backendTypeStr, val)
|
||||
|
||||
inheritedRolesToOrdJSONList :: InheritedRoles -> Maybe AO.Array
|
||||
inheritedRolesToOrdJSONList = listToMaybeArraySort inheritedRolesQToOrdJSON _rRoleName
|
||||
where
|
||||
inheritedRolesQToOrdJSON :: InheritedRole -> AO.Value
|
||||
inheritedRolesQToOrdJSON (Role roleName roleSet) =
|
||||
AO.object
|
||||
[ ("role_name", AO.toOrdered roleName),
|
||||
("role_set", AO.toOrdered roleSet)
|
||||
]
|
||||
|
||||
queryCollectionsToOrdJSONList :: QueryCollections -> Maybe AO.Array
|
||||
queryCollectionsToOrdJSONList = listToMaybeArraySort createCollectionToOrdJSON _ccName
|
||||
where
|
||||
createCollectionToOrdJSON :: CreateCollection -> AO.Value
|
||||
createCollectionToOrdJSON (CreateCollection name definition comment) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered name),
|
||||
("definition", AO.toOrdered definition)
|
||||
]
|
||||
<> catMaybes [maybeCommentToMaybeOrdPair comment]
|
||||
|
||||
allowlistToOrdJSONList :: MetadataAllowlist -> Maybe AO.Array
|
||||
allowlistToOrdJSONList = listToMaybeArraySort (AO.toOrdered . toJSON @AllowlistEntry) aeCollection
|
||||
|
||||
apiLimitsToOrdJSON :: ApiLimit -> Maybe AO.Value
|
||||
apiLimitsToOrdJSON apiLimits
|
||||
| apiLimits == emptyApiLimit = Nothing
|
||||
| otherwise = Just $ AO.toOrdered apiLimits
|
||||
|
||||
cronTriggersToOrdJSONList :: CronTriggers -> Maybe AO.Array
|
||||
cronTriggersToOrdJSONList = listToMaybeArraySort crontriggerQToOrdJSON ctName
|
||||
where
|
||||
crontriggerQToOrdJSON :: CronTriggerMetadata -> AO.Value
|
||||
crontriggerQToOrdJSON
|
||||
(CronTriggerMetadata name webhook schedule payload retryConf headers includeInMetadata comment reqTransform respTransform) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered name),
|
||||
("webhook", AO.toOrdered webhook),
|
||||
("schedule", AO.toOrdered schedule),
|
||||
("include_in_metadata", AO.toOrdered includeInMetadata)
|
||||
]
|
||||
<> catMaybes
|
||||
[ maybeAnyToMaybeOrdPair "payload" AO.toOrdered payload,
|
||||
maybeAnyToMaybeOrdPair "retry_conf" AO.toOrdered (maybeRetryConfiguration retryConf),
|
||||
maybeAnyToMaybeOrdPair "headers" AO.toOrdered (maybeHeader headers),
|
||||
maybeAnyToMaybeOrdPair "comment" AO.toOrdered comment,
|
||||
fmap (("request_transform",) . AO.toOrdered) reqTransform,
|
||||
fmap (("response_transform",) . AO.toOrdered) respTransform
|
||||
]
|
||||
where
|
||||
maybeRetryConfiguration retryConfig
|
||||
| retryConfig == defaultSTRetryConf = Nothing
|
||||
| otherwise = Just retryConfig
|
||||
|
||||
maybeHeader headerConfig
|
||||
| null headerConfig = Nothing
|
||||
| otherwise = Just headerConfig
|
||||
|
||||
customTypesToOrdJSON :: CustomTypes -> Maybe AO.Object
|
||||
customTypesToOrdJSON customTypes@(CustomTypes inpObjs objs scalars enums)
|
||||
| customTypes == emptyCustomTypes = Nothing
|
||||
| otherwise =
|
||||
Just . AO.fromList . catMaybes $
|
||||
[ listToMaybeOrdPair "input_objects" inputObjectToOrdJSON inpObjs,
|
||||
listToMaybeOrdPair "objects" objectTypeToOrdJSON objs,
|
||||
listToMaybeOrdPair "scalars" scalarTypeToOrdJSON scalars,
|
||||
listToMaybeOrdPair "enums" enumTypeToOrdJSON enums
|
||||
]
|
||||
where
|
||||
inputObjectToOrdJSON :: InputObjectTypeDefinition -> AO.Value
|
||||
inputObjectToOrdJSON (InputObjectTypeDefinition tyName descM fields) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered tyName),
|
||||
("fields", AO.array $ map fieldDefinitionToOrdJSON $ toList fields)
|
||||
]
|
||||
<> catMaybes [maybeDescriptionToMaybeOrdPair descM]
|
||||
where
|
||||
fieldDefinitionToOrdJSON :: InputObjectFieldDefinition -> AO.Value
|
||||
fieldDefinitionToOrdJSON (InputObjectFieldDefinition fieldName fieldDescM ty) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered fieldName),
|
||||
("type", AO.toOrdered ty)
|
||||
]
|
||||
<> catMaybes [maybeDescriptionToMaybeOrdPair fieldDescM]
|
||||
|
||||
objectTypeToOrdJSON :: ObjectTypeDefinition -> AO.Value
|
||||
objectTypeToOrdJSON (ObjectTypeDefinition tyName descM fields rels) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered tyName),
|
||||
("fields", AO.array $ map fieldDefinitionToOrdJSON $ toList fields)
|
||||
]
|
||||
<> catMaybes
|
||||
[ maybeDescriptionToMaybeOrdPair descM,
|
||||
listToMaybeOrdPair "relationships" AO.toOrdered rels
|
||||
]
|
||||
where
|
||||
fieldDefinitionToOrdJSON :: ObjectFieldDefinition GraphQLType -> AO.Value
|
||||
fieldDefinitionToOrdJSON (ObjectFieldDefinition fieldName argsValM fieldDescM ty) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered fieldName),
|
||||
("type", AO.toOrdered ty)
|
||||
]
|
||||
<> catMaybes
|
||||
[ ("arguments",) . AO.toOrdered <$> argsValM,
|
||||
maybeDescriptionToMaybeOrdPair fieldDescM
|
||||
]
|
||||
|
||||
scalarTypeToOrdJSON :: ScalarTypeDefinition -> AO.Value
|
||||
scalarTypeToOrdJSON (ScalarTypeDefinition tyName descM) =
|
||||
AO.object $
|
||||
[("name", AO.toOrdered tyName)]
|
||||
<> catMaybes [maybeDescriptionToMaybeOrdPair descM]
|
||||
|
||||
enumTypeToOrdJSON :: EnumTypeDefinition -> AO.Value
|
||||
enumTypeToOrdJSON (EnumTypeDefinition tyName descM values) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered tyName),
|
||||
("values", AO.toOrdered values)
|
||||
]
|
||||
<> catMaybes [maybeDescriptionToMaybeOrdPair descM]
|
||||
|
||||
endpointsToOrdJSONList :: Endpoints -> Maybe AO.Array
|
||||
endpointsToOrdJSONList = listToMaybeArraySort AO.toOrdered _ceUrl
|
||||
|
||||
introspectionDisabledRolesToOrdJSON :: SetGraphqlIntrospectionOptions -> Maybe AO.Value
|
||||
introspectionDisabledRolesToOrdJSON = ifNotEmpty (== mempty) AO.toOrdered
|
||||
|
||||
metricsConfigToOrdJSON :: MetricsConfig -> Maybe AO.Value
|
||||
metricsConfigToOrdJSON = ifNotEmpty (== emptyMetricsConfig) AO.toOrdered
|
||||
|
||||
networkConfigToOrdJSON :: Network -> Maybe AO.Value
|
||||
networkConfigToOrdJSON = ifNotEmpty (== emptyNetwork) AO.toOrdered
|
||||
|
||||
actionMetadataToOrdJSONList :: Actions -> Maybe AO.Array
|
||||
actionMetadataToOrdJSONList = listToMaybeArraySort actionMetadataToOrdJSON _amName
|
||||
where
|
||||
actionMetadataToOrdJSON :: ActionMetadata -> AO.Value
|
||||
actionMetadataToOrdJSON (ActionMetadata name comment definition permissions) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered name),
|
||||
("definition", actionDefinitionToOrdJSON definition)
|
||||
]
|
||||
<> catMaybes
|
||||
[ maybeCommentToMaybeOrdPair comment,
|
||||
listToMaybeOrdPair "permissions" permToOrdJSON permissions
|
||||
]
|
||||
where
|
||||
argDefinitionToOrdJSON :: ArgumentDefinition GraphQLType -> AO.Value
|
||||
argDefinitionToOrdJSON (ArgumentDefinition argName ty descM) =
|
||||
AO.object $
|
||||
[ ("name", AO.toOrdered argName),
|
||||
("type", AO.toOrdered ty)
|
||||
]
|
||||
<> catMaybes [maybeAnyToMaybeOrdPair "description" AO.toOrdered descM]
|
||||
|
||||
actionDefinitionToOrdJSON :: ActionDefinitionInput -> AO.Value
|
||||
actionDefinitionToOrdJSON
|
||||
( ActionDefinition
|
||||
args
|
||||
outputType
|
||||
actionType
|
||||
headers
|
||||
frwrdClientHdrs
|
||||
timeout
|
||||
handler
|
||||
requestTransform
|
||||
responseTransform
|
||||
) =
|
||||
let typeAndKind = case actionType of
|
||||
ActionQuery -> [("type", AO.toOrdered ("query" :: String))]
|
||||
ActionMutation kind ->
|
||||
[ ("type", AO.toOrdered ("mutation" :: String)),
|
||||
("kind", AO.toOrdered kind)
|
||||
]
|
||||
in AO.object $
|
||||
[ ("handler", AO.toOrdered handler),
|
||||
("output_type", AO.toOrdered outputType)
|
||||
]
|
||||
<> [("forward_client_headers", AO.toOrdered frwrdClientHdrs) | frwrdClientHdrs]
|
||||
<> catMaybes
|
||||
[ listToMaybeOrdPair "headers" AO.toOrdered headers,
|
||||
listToMaybeOrdPair "arguments" argDefinitionToOrdJSON args,
|
||||
fmap (("request_transform",) . AO.toOrdered) requestTransform,
|
||||
fmap (("response_transform",) . AO.toOrdered) responseTransform
|
||||
]
|
||||
<> typeAndKind
|
||||
<> bool [("timeout", AO.toOrdered timeout)] mempty (timeout == defaultActionTimeoutSecs)
|
||||
|
||||
permToOrdJSON :: ActionPermissionMetadata -> AO.Value
|
||||
permToOrdJSON (ActionPermissionMetadata role permComment) =
|
||||
AO.object $ [("role", AO.toOrdered role)] <> catMaybes [maybeCommentToMaybeOrdPair permComment]
|
||||
|
||||
ifNotEmpty :: (a -> Bool) -> (a -> b) -> a -> Maybe b
|
||||
ifNotEmpty isEmpty f x
|
||||
| isEmpty x = Nothing
|
||||
| otherwise = Just $ f x
|
||||
|
||||
-- | Sort list before encoding to JSON value
|
||||
listToMaybeOrdPairSort ::
|
||||
(Foldable t, Ord b) =>
|
||||
Text ->
|
||||
(a -> AO.Value) ->
|
||||
(a -> b) ->
|
||||
t a ->
|
||||
Maybe (Text, AO.Value)
|
||||
listToMaybeOrdPairSort name f sortF ta = case toList ta of
|
||||
[] -> Nothing
|
||||
list -> Just $ (name,) $ AO.array $ map f $ sortOn sortF list
|
||||
|
||||
-- | Sort list before encoding to JSON array (not value)
|
||||
listToMaybeArraySort ::
|
||||
(Foldable t, Ord b) =>
|
||||
(a -> AO.Value) ->
|
||||
(a -> b) ->
|
||||
t a ->
|
||||
Maybe AO.Array
|
||||
listToMaybeArraySort f sortF ta = case toList ta of
|
||||
[] -> Nothing
|
||||
list -> Just $ Vector.fromList $ map f $ sortOn sortF list
|
||||
|
||||
listToMaybeOrdPair ::
|
||||
(Foldable t) =>
|
||||
Text ->
|
||||
(a -> AO.Value) ->
|
||||
t a ->
|
||||
Maybe (Text, AO.Value)
|
||||
listToMaybeOrdPair name f ta = case toList ta of
|
||||
[] -> Nothing
|
||||
list -> Just $ (name,) $ AO.array $ map f list
|
||||
|
||||
maybeSetToMaybeOrdPair :: (Backend b) => Maybe (ColumnValues b JSON.Value) -> Maybe (Text, AO.Value)
|
||||
maybeSetToMaybeOrdPair set =
|
||||
set >>= \colVals ->
|
||||
if colVals == mempty
|
||||
then Nothing
|
||||
else Just ("set", AO.toOrdered colVals)
|
||||
|
||||
maybeDescriptionToMaybeOrdPair :: Maybe G.Description -> Maybe (Text, AO.Value)
|
||||
maybeDescriptionToMaybeOrdPair = maybeAnyToMaybeOrdPair "description" AO.toOrdered
|
||||
|
||||
maybeCommentToMaybeOrdPair :: Maybe Text -> Maybe (Text, AO.Value)
|
||||
maybeCommentToMaybeOrdPair = maybeAnyToMaybeOrdPair "comment" AO.toOrdered
|
||||
|
||||
maybeAnyToMaybeOrdPair :: Text -> (a -> AO.Value) -> Maybe a -> Maybe (Text, AO.Value)
|
||||
maybeAnyToMaybeOrdPair name f = fmap ((name,) . f)
|
||||
|
||||
commentToMaybeOrdPair :: Comment -> Maybe (Text, AO.Value)
|
||||
commentToMaybeOrdPair comment = (\val -> ("comment", AO.toOrdered val)) <$> commentToMaybeText comment
|
Loading…
Reference in New Issue
Block a user