server: move Metadata code to avoid circular dependencies in upcoming work

A following PR moves serialization-related code out `Hasura.RQL.Types.Metadata` into a specialized submodule. To avoid circular dependencies a number of other definitions also need to be moved into their own submodule. This PR does that extra moving first so that we can keep each PR as small, and as easy to review as possible.

There are a lot of changed lines; but it's all moving code from one module to another.

I'm breaking up #5184 into smaller PRs, and this is the first PR in that effort.

The tracking issue is https://hasurahq.atlassian.net/browse/MM-35

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5210
GitOrigin-RevId: 6fb6e29a967ab5ad4724006c8e0addd2d63a3946
This commit is contained in:
Jesse Hallett 2022-07-29 20:14:07 -04:00 committed by hasura-bot
parent bc2480fb98
commit 4ed1fdb859
3 changed files with 528 additions and 485 deletions

View File

@ -674,6 +674,7 @@ library
, Hasura.RQL.Types.Instances
, Hasura.RQL.Types.Metadata
, Hasura.RQL.Types.Metadata.Backend
, Hasura.RQL.Types.Metadata.Common
, Hasura.RQL.Types.Metadata.Instances
, Hasura.RQL.Types.Metadata.Object
, Hasura.RQL.Types.Network

View File

@ -1,41 +1,11 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module Hasura.RQL.Types.Metadata
( Actions,
BackendConfigWrapper (..),
BackendSourceMetadata,
CatalogState (..),
CatalogStateType (..),
ComputedFieldMetadata (..),
ComputedFields,
CronTriggers,
Endpoints,
EventTriggers,
FunctionMetadata (..),
Functions,
GetCatalogState (..),
InheritedRoles,
Metadata (..),
( Metadata (..),
MetadataM (..),
MetadataModifier (..),
MetadataNoSources (..),
MetadataVersion (..),
Permissions,
QueryCollections,
Relationships,
SchemaRemoteRelationships,
RemoteSchemaTypeRelationships (..),
rstrsName,
rstrsRelationships,
RemoteSchemaMetadata (..),
RemoteSchemaPermissionMetadata (..),
RemoteSchemas,
SetCatalogState (..),
SourceMetadata (..),
Sources,
TableMetadata (..),
Tables,
currentMetadataVersion,
dropComputedFieldInMetadata,
dropEventTriggerInMetadata,
@ -48,12 +18,7 @@ module Hasura.RQL.Types.Metadata
dropRemoteSchemaPermissionInMetadata,
dropRemoteSchemaRemoteRelationshipInMetadata,
emptyMetadata,
fmComment,
fmConfiguration,
fmFunction,
fmPermissions,
functionMetadataSetter,
getSourceName,
metaActions,
metaAllowlist,
metaApiLimits,
@ -69,56 +34,19 @@ module Hasura.RQL.Types.Metadata
metaSetGraphqlIntrospectionOptions,
metaSources,
metadataToOrdJSON,
mkSourceMetadata,
mkTableMeta,
parseNonSourcesMetadata,
rsmComment,
rsmDefinition,
rsmName,
rsmPermissions,
rspmComment,
rspmDefinition,
rspmRole,
smConfiguration,
smFunctions,
smKind,
smName,
smQueryTags,
smTables,
smCustomization,
tableMetadataSetter,
tmArrayRelationships,
tmComputedFields,
tmConfiguration,
tmDeletePermissions,
tmApolloFederationConfig,
tmEventTriggers,
tmInsertPermissions,
tmIsEnum,
tmObjectRelationships,
tmRemoteRelationships,
tmSelectPermissions,
tmTable,
tmUpdatePermissions,
toSourceMetadata,
rsmRemoteRelationships,
module Hasura.RQL.Types.Metadata.Common,
)
where
import Control.Lens hiding (set, (.=))
import Data.Aeson.Casing
import Data.Aeson.Extended (FromJSONWithContext (..), mapWithJSONPath)
import Data.Aeson.KeyMap qualified as KM
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.HashSet qualified as HS
import Data.List.Extended qualified as L
import Data.Monoid (Dual (..), Endo (..))
import Data.Text qualified as T
import Data.Text.Extended qualified as T
import Hasura.Incremental (Cacheable)
import Hasura.Prelude
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.Allowlist
@ -132,10 +60,10 @@ import Hasura.RQL.Types.Endpoint
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.Network
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.QueryTags
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.Relationships.Remote
import Hasura.RQL.Types.RemoteSchema
@ -152,24 +80,6 @@ import Hasura.Session
import Hasura.Tracing (TraceT)
import Language.GraphQL.Draft.Syntax qualified as G
-- | Parse a list of objects into a map from a derived key,
-- failing if the list has duplicates.
parseListAsMap ::
(Hashable k, Eq k, T.ToTxt k) =>
Text ->
(a -> k) ->
Parser [a] ->
Parser (InsOrdHashMap k a)
parseListAsMap things mapFn listP = do
list <- listP
let duplicates = toList $ L.duplicates $ map mapFn list
unless (null duplicates) $
fail $
T.unpack $
"multiple declarations exist for the following " <> things <> ": "
<> T.commaSeparated duplicates
pure $ oMapFromL mapFn list
-- | Versioning the @'Metadata' JSON structure to track backwards incompatible changes.
-- This value is included in the metadata JSON object at top level 'version' key.
-- Always metadata is emitted in the latest version via export metadata API (@'runExportMetadata' handler).
@ -206,365 +116,6 @@ instance FromJSON MetadataVersion where
currentMetadataVersion :: MetadataVersion
currentMetadataVersion = MVVersion3
data ComputedFieldMetadata b = ComputedFieldMetadata
{ _cfmName :: !ComputedFieldName,
_cfmDefinition :: !(ComputedFieldDefinition b),
_cfmComment :: !Comment
}
deriving (Generic)
deriving instance (Backend b) => Show (ComputedFieldMetadata b)
deriving instance (Backend b) => Eq (ComputedFieldMetadata b)
instance (Backend b) => Cacheable (ComputedFieldMetadata b)
instance (Backend b) => ToJSON (ComputedFieldMetadata b) where
toJSON ComputedFieldMetadata {..} =
object
[ "name" .= _cfmName,
"definition" .= _cfmDefinition,
"comment" .= _cfmComment
]
instance (Backend b) => FromJSON (ComputedFieldMetadata b) where
parseJSON = withObject "ComputedFieldMetadata" $ \obj ->
ComputedFieldMetadata
<$> obj .: "name"
<*> obj .: "definition"
<*> obj .:? "comment" .!= Automatic
data RemoteSchemaPermissionMetadata = RemoteSchemaPermissionMetadata
{ _rspmRole :: !RoleName,
_rspmDefinition :: !RemoteSchemaPermissionDefinition,
_rspmComment :: !(Maybe Text)
}
deriving (Show, Eq, Generic)
instance Cacheable RemoteSchemaPermissionMetadata
$(deriveJSON hasuraJSON {omitNothingFields = True} ''RemoteSchemaPermissionMetadata)
$(makeLenses ''RemoteSchemaPermissionMetadata)
type Relationships a = InsOrdHashMap RelName a
type ComputedFields b = InsOrdHashMap ComputedFieldName (ComputedFieldMetadata b)
type RemoteRelationships = InsOrdHashMap RelName RemoteRelationship
type SchemaRemoteRelationships = InsOrdHashMap G.Name RemoteSchemaTypeRelationships
type Permissions a = InsOrdHashMap RoleName a
type EventTriggers b = InsOrdHashMap TriggerName (EventTriggerConf b)
data RemoteSchemaTypeRelationships = RemoteSchemaTypeRelationships
{ _rstrsName :: G.Name,
_rstrsRelationships :: RemoteRelationships
}
deriving (Show, Eq, Generic)
instance FromJSON RemoteSchemaTypeRelationships where
parseJSON = withObject "RemoteSchemaMetadata" \obj ->
RemoteSchemaTypeRelationships
<$> obj .: "type_name"
<*> (oMapFromL _rrName <$> obj .:? "relationships" .!= [])
instance ToJSON RemoteSchemaTypeRelationships where
toJSON RemoteSchemaTypeRelationships {..} =
object
[ "type_name" .= _rstrsName,
"relationships" .= OM.elems _rstrsRelationships
]
instance Cacheable RemoteSchemaTypeRelationships
data RemoteSchemaMetadata = RemoteSchemaMetadata
{ _rsmName :: RemoteSchemaName,
_rsmDefinition :: RemoteSchemaDef,
_rsmComment :: Maybe Text,
_rsmPermissions :: [RemoteSchemaPermissionMetadata],
_rsmRemoteRelationships :: SchemaRemoteRelationships
}
deriving (Show, Eq, Generic)
instance Cacheable RemoteSchemaMetadata
instance FromJSON RemoteSchemaMetadata where
parseJSON = withObject "RemoteSchemaMetadata" \obj ->
RemoteSchemaMetadata
<$> obj .: "name"
<*> obj .: "definition"
<*> obj .:? "comment"
<*> obj .:? "permissions" .!= mempty
<*> (oMapFromL _rstrsName <$> obj .:? "remote_relationships" .!= [])
instance ToJSON RemoteSchemaMetadata where
toJSON RemoteSchemaMetadata {..} =
object
[ "name" .= _rsmName,
"definition" .= _rsmDefinition,
"comment" .= _rsmComment,
"permissions" .= _rsmPermissions,
"remote_relationships" .= OM.elems _rsmRemoteRelationships
]
$(makeLenses ''RemoteSchemaTypeRelationships)
$(makeLenses ''RemoteSchemaMetadata)
data TableMetadata b = TableMetadata
{ _tmTable :: !(TableName b),
_tmIsEnum :: !Bool,
_tmConfiguration :: !(TableConfig b),
_tmObjectRelationships :: !(Relationships (ObjRelDef b)),
_tmArrayRelationships :: !(Relationships (ArrRelDef b)),
_tmComputedFields :: !(ComputedFields b),
_tmRemoteRelationships :: !RemoteRelationships,
_tmInsertPermissions :: !(Permissions (InsPermDef b)),
_tmSelectPermissions :: !(Permissions (SelPermDef b)),
_tmUpdatePermissions :: !(Permissions (UpdPermDef b)),
_tmDeletePermissions :: !(Permissions (DelPermDef b)),
_tmEventTriggers :: !(EventTriggers b),
_tmApolloFederationConfig :: !(Maybe ApolloFederationConfig)
}
deriving (Generic)
deriving instance (Backend b) => Show (TableMetadata b)
deriving instance (Backend b) => Eq (TableMetadata b)
instance (Backend b) => Cacheable (TableMetadata b)
instance (Backend b) => ToJSON (TableMetadata b) where
toJSON = genericToJSON hasuraJSON
$(makeLenses ''TableMetadata)
mkTableMeta :: TableName b -> Bool -> TableConfig b -> TableMetadata b
mkTableMeta qt isEnum config =
TableMetadata
qt
isEnum
config
mempty
mempty
mempty
mempty
mempty
mempty
mempty
mempty
mempty
Nothing
instance (Backend b) => FromJSON (TableMetadata b) where
parseJSON = withObject "Object" $ \o -> do
let unexpectedKeys = getUnexpectedKeys o
unless (null unexpectedKeys) $
fail $
"unexpected keys when parsing TableMetadata : "
<> show (HS.toList unexpectedKeys)
TableMetadata
<$> o .: tableKey
<*> o .:? isEnumKey .!= False
<*> o .:? configKey .!= emptyTableConfig
<*> parseListAsMap "object relationships" _rdName (o .:? orKey .!= [])
<*> parseListAsMap "array relationships" _rdName (o .:? arKey .!= [])
<*> parseListAsMap "computed fields" _cfmName (o .:? cfKey .!= [])
<*> parseListAsMap "remote relationships" _rrName (o .:? rrKey .!= [])
<*> parseListAsMap "insert permissions" _pdRole (o .:? ipKey .!= [])
<*> parseListAsMap "select permissions" _pdRole (o .:? spKey .!= [])
<*> parseListAsMap "update permissions" _pdRole (o .:? upKey .!= [])
<*> parseListAsMap "delete permissions" _pdRole (o .:? dpKey .!= [])
<*> parseListAsMap "event triggers" etcName (o .:? etKey .!= [])
<*> o .:? enableAFKey
where
tableKey = "table"
isEnumKey = "is_enum"
configKey = "configuration"
orKey = "object_relationships"
arKey = "array_relationships"
ipKey = "insert_permissions"
spKey = "select_permissions"
upKey = "update_permissions"
dpKey = "delete_permissions"
etKey = "event_triggers"
cfKey = "computed_fields"
rrKey = "remote_relationships"
enableAFKey = "apollo_federation_config"
getUnexpectedKeys o =
HS.fromList (KM.keys o) `HS.difference` expectedKeySet
expectedKeySet =
HS.fromList
[ tableKey,
isEnumKey,
configKey,
orKey,
arKey,
ipKey,
spKey,
upKey,
dpKey,
etKey,
cfKey,
rrKey,
enableAFKey
]
data FunctionMetadata b = FunctionMetadata
{ _fmFunction :: !(FunctionName b),
_fmConfiguration :: !FunctionConfig,
_fmPermissions :: ![FunctionPermissionInfo],
_fmComment :: !(Maybe Text)
}
deriving (Generic)
deriving instance (Backend b) => Show (FunctionMetadata b)
deriving instance (Backend b) => Eq (FunctionMetadata b)
instance (Backend b) => Cacheable (FunctionMetadata b)
instance (Backend b) => ToJSON (FunctionMetadata b) where
toJSON = genericToJSON hasuraJSON
$(makeLenses ''FunctionMetadata)
instance (Backend b) => FromJSON (FunctionMetadata b) where
parseJSON = withObject "FunctionMetadata" $ \o ->
FunctionMetadata
<$> o .: "function"
<*> o .:? "configuration" .!= emptyFunctionConfig
<*> o .:? "permissions" .!= []
<*> o .:? "comment"
type Tables b = InsOrdHashMap (TableName b) (TableMetadata b)
type Functions b = InsOrdHashMap (FunctionName b) (FunctionMetadata b)
type RemoteSchemas = InsOrdHashMap RemoteSchemaName RemoteSchemaMetadata
type Endpoints = InsOrdHashMap EndpointName CreateEndpoint
type Actions = InsOrdHashMap ActionName ActionMetadata
type CronTriggers = InsOrdHashMap TriggerName CronTriggerMetadata
type InheritedRoles = InsOrdHashMap RoleName InheritedRole
data SourceMetadata b = SourceMetadata
{ _smName :: !SourceName,
_smKind :: !(BackendSourceKind b),
_smTables :: !(Tables b),
_smFunctions :: !(Functions b),
_smConfiguration :: !(SourceConnConfiguration b),
_smQueryTags :: !(Maybe QueryTagsConfig),
_smCustomization :: !SourceCustomization
}
deriving (Generic)
$(makeLenses ''SourceMetadata)
deriving instance (Backend b) => Show (SourceMetadata b)
deriving instance (Backend b) => Eq (SourceMetadata b)
instance (Backend b) => Cacheable (SourceMetadata b)
instance (Backend b) => FromJSONWithContext (BackendSourceKind b) (SourceMetadata b) where
parseJSONWithContext _smKind = withObject "Object" $ \o -> do
_smName <- o .: "name"
_smTables <- oMapFromL _tmTable <$> o .: "tables"
_smFunctions <- oMapFromL _fmFunction <$> o .:? "functions" .!= []
_smConfiguration <- o .: "configuration"
_smQueryTags <- o .:? "query_tags"
_smCustomization <- o .:? "customization" .!= emptySourceCustomization
pure SourceMetadata {..}
mkSourceMetadata ::
forall (b :: BackendType).
Backend b =>
SourceName ->
BackendSourceKind b ->
SourceConnConfiguration b ->
SourceCustomization ->
BackendSourceMetadata
mkSourceMetadata name backendSourceKind config customization =
AB.mkAnyBackend $ SourceMetadata @b name backendSourceKind mempty mempty config Nothing customization
type BackendSourceMetadata = AB.AnyBackend SourceMetadata
toSourceMetadata :: forall b. (Backend b) => Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata = prism' AB.mkAnyBackend AB.unpackAnyBackend
getSourceName :: BackendSourceMetadata -> SourceName
getSourceName e = AB.dispatchAnyBackend @Backend e _smName
type Sources = InsOrdHashMap SourceName BackendSourceMetadata
parseNonSourcesMetadata ::
Object ->
Parser
( RemoteSchemas,
QueryCollections,
MetadataAllowlist,
CustomTypes,
Actions,
CronTriggers,
ApiLimit,
MetricsConfig,
InheritedRoles,
SetGraphqlIntrospectionOptions
)
parseNonSourcesMetadata o = do
remoteSchemas <-
parseListAsMap "remote schemas" _rsmName $
o .:? "remote_schemas" .!= []
queryCollections <-
parseListAsMap "query collections" _ccName $
o .:? "query_collections" .!= []
allowlist <- parseListAsMap "allowlist entries" aeCollection $ o .:? "allowlist" .!= []
customTypes <- o .:? "custom_types" .!= emptyCustomTypes
actions <- parseListAsMap "actions" _amName $ o .:? "actions" .!= []
cronTriggers <-
parseListAsMap "cron triggers" ctName $
o .:? "cron_triggers" .!= []
apiLimits <- o .:? "api_limits" .!= emptyApiLimit
metricsConfig <- o .:? "metrics_config" .!= emptyMetricsConfig
inheritedRoles <-
parseListAsMap "inherited roles" _rRoleName $
o .:? "inherited_roles" .!= []
introspectionDisabledForRoles <- o .:? "graphql_schema_introspection" .!= mempty
pure
( remoteSchemas,
queryCollections,
allowlist,
customTypes,
actions,
cronTriggers,
apiLimits,
metricsConfig,
inheritedRoles,
introspectionDisabledForRoles
)
-- | This newtype simply wraps the BackendConfig type family so that it can be used
-- with BackendMap in the Metadata type. GHC will not allow the type family to be
-- used directly. :(
newtype BackendConfigWrapper b = BackendConfigWrapper {unBackendConfigWrapper :: BackendConfig b}
deriving newtype instance (Backend b) => Show (BackendConfigWrapper b)
deriving newtype instance (Backend b) => Eq (BackendConfigWrapper b)
deriving newtype instance (Backend b) => ToJSON (BackendConfigWrapper b)
deriving newtype instance (Backend b) => FromJSON (BackendConfigWrapper b)
-- | A complete GraphQL Engine metadata representation to be stored,
-- exported/replaced via metadata queries.
data Metadata = Metadata
@ -1381,36 +932,3 @@ metadataToOrdJSON
instance ToJSON Metadata where
toJSON = AO.fromOrdered . metadataToOrdJSON
data CatalogStateType
= CSTCli
| CSTConsole
deriving (Show, Eq)
$(deriveJSON defaultOptions {constructorTagModifier = snakeCase . drop 3} ''CatalogStateType)
data SetCatalogState = SetCatalogState
{ _scsType :: !CatalogStateType,
_scsState :: !Value
}
deriving (Show, Eq)
$(deriveJSON hasuraJSON ''SetCatalogState)
data CatalogState = CatalogState
{ _csId :: !Text,
_csCliState :: !Value,
_csConsoleState :: !Value
}
deriving (Show, Eq)
$(deriveToJSON hasuraJSON ''CatalogState)
data GetCatalogState
= GetCatalogState
deriving (Show, Eq)
$(deriveToJSON defaultOptions ''GetCatalogState)
instance FromJSON GetCatalogState where
parseJSON _ = pure GetCatalogState

View File

@ -0,0 +1,524 @@
{-# LANGUAGE TemplateHaskell #-}
-- | In order to avoid circular dependencies while splitting
-- 'Hasura.RQL.Types.Metadata' into multiple modules, some definitions must be
-- moved out of that module. This module is the bucket for definitions that have
-- not been specifically moved elsewhere.
module Hasura.RQL.Types.Metadata.Common
( Actions,
BackendConfigWrapper (..),
BackendSourceMetadata,
CatalogState (..),
CatalogStateType (..),
ComputedFieldMetadata (..),
ComputedFields,
CronTriggers,
Endpoints,
EventTriggers,
FunctionMetadata (..),
Functions,
GetCatalogState (..),
InheritedRoles,
Permissions,
QueryCollections,
Relationships,
SchemaRemoteRelationships,
RemoteSchemaMetadata (..),
RemoteSchemaPermissionMetadata (..),
RemoteSchemas,
RemoteSchemaTypeRelationships (..),
SetCatalogState (..),
SourceMetadata (..),
Sources,
TableMetadata (..),
Tables,
fmComment,
fmConfiguration,
fmFunction,
fmPermissions,
getSourceName,
mkSourceMetadata,
mkTableMeta,
parseNonSourcesMetadata,
rsmComment,
rsmDefinition,
rsmName,
rsmPermissions,
rsmRemoteRelationships,
rspmComment,
rspmDefinition,
rspmRole,
rstrsName,
rstrsRelationships,
smConfiguration,
smFunctions,
smKind,
smName,
smQueryTags,
smTables,
smCustomization,
tmArrayRelationships,
tmComputedFields,
tmConfiguration,
tmDeletePermissions,
tmApolloFederationConfig,
tmEventTriggers,
tmInsertPermissions,
tmIsEnum,
tmObjectRelationships,
tmRemoteRelationships,
tmSelectPermissions,
tmTable,
tmUpdatePermissions,
toSourceMetadata,
)
where
import Control.Lens hiding (set, (.=))
import Data.Aeson.Casing
import Data.Aeson.Extended (FromJSONWithContext (..))
import Data.Aeson.KeyMap qualified as KM
import Data.Aeson.TH
import Data.Aeson.Types
import Data.HashMap.Strict.InsOrd.Extended qualified as OM
import Data.HashSet qualified as HS
import Data.List.Extended qualified as L
import Data.Text qualified as T
import Data.Text.Extended qualified as T
import Hasura.Incremental (Cacheable)
import Hasura.Prelude
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.Allowlist
import Hasura.RQL.Types.ApiLimit
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.CustomTypes
import Hasura.RQL.Types.Endpoint
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Function
import Hasura.RQL.Types.GraphqlSchemaIntrospection
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.QueryTags
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.Relationships.Remote
import Hasura.RQL.Types.RemoteSchema
import Hasura.RQL.Types.Roles
import Hasura.RQL.Types.ScheduledTrigger
import Hasura.RQL.Types.SourceCustomization
import Hasura.RQL.Types.Table
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.Backend
import Hasura.Session
import Language.GraphQL.Draft.Syntax qualified as G
-- | Parse a list of objects into a map from a derived key,
-- failing if the list has duplicates.
parseListAsMap ::
(Hashable k, Eq k, T.ToTxt k) =>
Text ->
(a -> k) ->
Parser [a] ->
Parser (InsOrdHashMap k a)
parseListAsMap things mapFn listP = do
list <- listP
let duplicates = toList $ L.duplicates $ map mapFn list
unless (null duplicates) $
fail $
T.unpack $
"multiple declarations exist for the following " <> things <> ": "
<> T.commaSeparated duplicates
pure $ oMapFromL mapFn list
data ComputedFieldMetadata b = ComputedFieldMetadata
{ _cfmName :: !ComputedFieldName,
_cfmDefinition :: !(ComputedFieldDefinition b),
_cfmComment :: !Comment
}
deriving (Generic)
deriving instance (Backend b) => Show (ComputedFieldMetadata b)
deriving instance (Backend b) => Eq (ComputedFieldMetadata b)
instance (Backend b) => Cacheable (ComputedFieldMetadata b)
instance (Backend b) => ToJSON (ComputedFieldMetadata b) where
toJSON ComputedFieldMetadata {..} =
object
[ "name" .= _cfmName,
"definition" .= _cfmDefinition,
"comment" .= _cfmComment
]
instance (Backend b) => FromJSON (ComputedFieldMetadata b) where
parseJSON = withObject "ComputedFieldMetadata" $ \obj ->
ComputedFieldMetadata
<$> obj .: "name"
<*> obj .: "definition"
<*> obj .:? "comment" .!= Automatic
data RemoteSchemaPermissionMetadata = RemoteSchemaPermissionMetadata
{ _rspmRole :: !RoleName,
_rspmDefinition :: !RemoteSchemaPermissionDefinition,
_rspmComment :: !(Maybe Text)
}
deriving (Show, Eq, Generic)
instance Cacheable RemoteSchemaPermissionMetadata
$(deriveJSON hasuraJSON {omitNothingFields = True} ''RemoteSchemaPermissionMetadata)
$(makeLenses ''RemoteSchemaPermissionMetadata)
type Relationships a = InsOrdHashMap RelName a
type ComputedFields b = InsOrdHashMap ComputedFieldName (ComputedFieldMetadata b)
type RemoteRelationships = InsOrdHashMap RelName RemoteRelationship
type SchemaRemoteRelationships = InsOrdHashMap G.Name RemoteSchemaTypeRelationships
type Permissions a = InsOrdHashMap RoleName a
type EventTriggers b = InsOrdHashMap TriggerName (EventTriggerConf b)
data RemoteSchemaTypeRelationships = RemoteSchemaTypeRelationships
{ _rstrsName :: G.Name,
_rstrsRelationships :: RemoteRelationships
}
deriving (Show, Eq, Generic)
instance FromJSON RemoteSchemaTypeRelationships where
parseJSON = withObject "RemoteSchemaMetadata" \obj ->
RemoteSchemaTypeRelationships
<$> obj .: "type_name"
<*> (oMapFromL _rrName <$> obj .:? "relationships" .!= [])
instance ToJSON RemoteSchemaTypeRelationships where
toJSON RemoteSchemaTypeRelationships {..} =
object
[ "type_name" .= _rstrsName,
"relationships" .= OM.elems _rstrsRelationships
]
instance Cacheable RemoteSchemaTypeRelationships
data RemoteSchemaMetadata = RemoteSchemaMetadata
{ _rsmName :: RemoteSchemaName,
_rsmDefinition :: RemoteSchemaDef,
_rsmComment :: Maybe Text,
_rsmPermissions :: [RemoteSchemaPermissionMetadata],
_rsmRemoteRelationships :: SchemaRemoteRelationships
}
deriving (Show, Eq, Generic)
instance Cacheable RemoteSchemaMetadata
instance FromJSON RemoteSchemaMetadata where
parseJSON = withObject "RemoteSchemaMetadata" \obj ->
RemoteSchemaMetadata
<$> obj .: "name"
<*> obj .: "definition"
<*> obj .:? "comment"
<*> obj .:? "permissions" .!= mempty
<*> (oMapFromL _rstrsName <$> obj .:? "remote_relationships" .!= [])
instance ToJSON RemoteSchemaMetadata where
toJSON RemoteSchemaMetadata {..} =
object
[ "name" .= _rsmName,
"definition" .= _rsmDefinition,
"comment" .= _rsmComment,
"permissions" .= _rsmPermissions,
"remote_relationships" .= OM.elems _rsmRemoteRelationships
]
$(makeLenses ''RemoteSchemaTypeRelationships)
$(makeLenses ''RemoteSchemaMetadata)
data TableMetadata b = TableMetadata
{ _tmTable :: !(TableName b),
_tmIsEnum :: !Bool,
_tmConfiguration :: !(TableConfig b),
_tmObjectRelationships :: !(Relationships (ObjRelDef b)),
_tmArrayRelationships :: !(Relationships (ArrRelDef b)),
_tmComputedFields :: !(ComputedFields b),
_tmRemoteRelationships :: !RemoteRelationships,
_tmInsertPermissions :: !(Permissions (InsPermDef b)),
_tmSelectPermissions :: !(Permissions (SelPermDef b)),
_tmUpdatePermissions :: !(Permissions (UpdPermDef b)),
_tmDeletePermissions :: !(Permissions (DelPermDef b)),
_tmEventTriggers :: !(EventTriggers b),
_tmApolloFederationConfig :: !(Maybe ApolloFederationConfig)
}
deriving (Generic)
deriving instance (Backend b) => Show (TableMetadata b)
deriving instance (Backend b) => Eq (TableMetadata b)
instance (Backend b) => Cacheable (TableMetadata b)
instance (Backend b) => ToJSON (TableMetadata b) where
toJSON = genericToJSON hasuraJSON
$(makeLenses ''TableMetadata)
mkTableMeta :: TableName b -> Bool -> TableConfig b -> TableMetadata b
mkTableMeta qt isEnum config =
TableMetadata
qt
isEnum
config
mempty
mempty
mempty
mempty
mempty
mempty
mempty
mempty
mempty
Nothing
instance (Backend b) => FromJSON (TableMetadata b) where
parseJSON = withObject "Object" $ \o -> do
let unexpectedKeys = getUnexpectedKeys o
unless (null unexpectedKeys) $
fail $
"unexpected keys when parsing TableMetadata : "
<> show (HS.toList unexpectedKeys)
TableMetadata
<$> o .: tableKey
<*> o .:? isEnumKey .!= False
<*> o .:? configKey .!= emptyTableConfig
<*> parseListAsMap "object relationships" _rdName (o .:? orKey .!= [])
<*> parseListAsMap "array relationships" _rdName (o .:? arKey .!= [])
<*> parseListAsMap "computed fields" _cfmName (o .:? cfKey .!= [])
<*> parseListAsMap "remote relationships" _rrName (o .:? rrKey .!= [])
<*> parseListAsMap "insert permissions" _pdRole (o .:? ipKey .!= [])
<*> parseListAsMap "select permissions" _pdRole (o .:? spKey .!= [])
<*> parseListAsMap "update permissions" _pdRole (o .:? upKey .!= [])
<*> parseListAsMap "delete permissions" _pdRole (o .:? dpKey .!= [])
<*> parseListAsMap "event triggers" etcName (o .:? etKey .!= [])
<*> o .:? enableAFKey
where
tableKey = "table"
isEnumKey = "is_enum"
configKey = "configuration"
orKey = "object_relationships"
arKey = "array_relationships"
ipKey = "insert_permissions"
spKey = "select_permissions"
upKey = "update_permissions"
dpKey = "delete_permissions"
etKey = "event_triggers"
cfKey = "computed_fields"
rrKey = "remote_relationships"
enableAFKey = "apollo_federation_config"
getUnexpectedKeys o =
HS.fromList (KM.keys o) `HS.difference` expectedKeySet
expectedKeySet =
HS.fromList
[ tableKey,
isEnumKey,
configKey,
orKey,
arKey,
ipKey,
spKey,
upKey,
dpKey,
etKey,
cfKey,
rrKey,
enableAFKey
]
data FunctionMetadata b = FunctionMetadata
{ _fmFunction :: !(FunctionName b),
_fmConfiguration :: !FunctionConfig,
_fmPermissions :: ![FunctionPermissionInfo],
_fmComment :: !(Maybe Text)
}
deriving (Generic)
deriving instance (Backend b) => Show (FunctionMetadata b)
deriving instance (Backend b) => Eq (FunctionMetadata b)
instance (Backend b) => Cacheable (FunctionMetadata b)
instance (Backend b) => ToJSON (FunctionMetadata b) where
toJSON = genericToJSON hasuraJSON
$(makeLenses ''FunctionMetadata)
instance (Backend b) => FromJSON (FunctionMetadata b) where
parseJSON = withObject "FunctionMetadata" $ \o ->
FunctionMetadata
<$> o .: "function"
<*> o .:? "configuration" .!= emptyFunctionConfig
<*> o .:? "permissions" .!= []
<*> o .:? "comment"
type Tables b = InsOrdHashMap (TableName b) (TableMetadata b)
type Functions b = InsOrdHashMap (FunctionName b) (FunctionMetadata b)
type RemoteSchemas = InsOrdHashMap RemoteSchemaName RemoteSchemaMetadata
type Endpoints = InsOrdHashMap EndpointName CreateEndpoint
type Actions = InsOrdHashMap ActionName ActionMetadata
type CronTriggers = InsOrdHashMap TriggerName CronTriggerMetadata
type InheritedRoles = InsOrdHashMap RoleName InheritedRole
data SourceMetadata b = SourceMetadata
{ _smName :: !SourceName,
_smKind :: !(BackendSourceKind b),
_smTables :: !(Tables b),
_smFunctions :: !(Functions b),
_smConfiguration :: !(SourceConnConfiguration b),
_smQueryTags :: !(Maybe QueryTagsConfig),
_smCustomization :: !SourceCustomization
}
deriving (Generic)
$(makeLenses ''SourceMetadata)
deriving instance (Backend b) => Show (SourceMetadata b)
deriving instance (Backend b) => Eq (SourceMetadata b)
instance (Backend b) => Cacheable (SourceMetadata b)
instance (Backend b) => FromJSONWithContext (BackendSourceKind b) (SourceMetadata b) where
parseJSONWithContext _smKind = withObject "Object" $ \o -> do
_smName <- o .: "name"
_smTables <- oMapFromL _tmTable <$> o .: "tables"
_smFunctions <- oMapFromL _fmFunction <$> o .:? "functions" .!= []
_smConfiguration <- o .: "configuration"
_smQueryTags <- o .:? "query_tags"
_smCustomization <- o .:? "customization" .!= emptySourceCustomization
pure SourceMetadata {..}
mkSourceMetadata ::
forall (b :: BackendType).
Backend b =>
SourceName ->
BackendSourceKind b ->
SourceConnConfiguration b ->
SourceCustomization ->
BackendSourceMetadata
mkSourceMetadata name backendSourceKind config customization =
AB.mkAnyBackend $ SourceMetadata @b name backendSourceKind mempty mempty config Nothing customization
type BackendSourceMetadata = AB.AnyBackend SourceMetadata
toSourceMetadata :: forall b. (Backend b) => Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata = prism' AB.mkAnyBackend AB.unpackAnyBackend
getSourceName :: BackendSourceMetadata -> SourceName
getSourceName e = AB.dispatchAnyBackend @Backend e _smName
type Sources = InsOrdHashMap SourceName BackendSourceMetadata
parseNonSourcesMetadata ::
Object ->
Parser
( RemoteSchemas,
QueryCollections,
MetadataAllowlist,
CustomTypes,
Actions,
CronTriggers,
ApiLimit,
MetricsConfig,
InheritedRoles,
SetGraphqlIntrospectionOptions
)
parseNonSourcesMetadata o = do
remoteSchemas <-
parseListAsMap "remote schemas" _rsmName $
o .:? "remote_schemas" .!= []
queryCollections <-
parseListAsMap "query collections" _ccName $
o .:? "query_collections" .!= []
allowlist <- parseListAsMap "allowlist entries" aeCollection $ o .:? "allowlist" .!= []
customTypes <- o .:? "custom_types" .!= emptyCustomTypes
actions <- parseListAsMap "actions" _amName $ o .:? "actions" .!= []
cronTriggers <-
parseListAsMap "cron triggers" ctName $
o .:? "cron_triggers" .!= []
apiLimits <- o .:? "api_limits" .!= emptyApiLimit
metricsConfig <- o .:? "metrics_config" .!= emptyMetricsConfig
inheritedRoles <-
parseListAsMap "inherited roles" _rRoleName $
o .:? "inherited_roles" .!= []
introspectionDisabledForRoles <- o .:? "graphql_schema_introspection" .!= mempty
pure
( remoteSchemas,
queryCollections,
allowlist,
customTypes,
actions,
cronTriggers,
apiLimits,
metricsConfig,
inheritedRoles,
introspectionDisabledForRoles
)
-- | This newtype simply wraps the BackendConfig type family so that it can be used
-- with BackendMap in the Metadata type. GHC will not allow the type family to be
-- used directly. :(
newtype BackendConfigWrapper b = BackendConfigWrapper {unBackendConfigWrapper :: BackendConfig b}
deriving newtype instance (Backend b) => Show (BackendConfigWrapper b)
deriving newtype instance (Backend b) => Eq (BackendConfigWrapper b)
deriving newtype instance (Backend b) => ToJSON (BackendConfigWrapper b)
deriving newtype instance (Backend b) => FromJSON (BackendConfigWrapper b)
data CatalogStateType
= CSTCli
| CSTConsole
deriving (Show, Eq)
$(deriveJSON defaultOptions {constructorTagModifier = snakeCase . drop 3} ''CatalogStateType)
data SetCatalogState = SetCatalogState
{ _scsType :: !CatalogStateType,
_scsState :: !Value
}
deriving (Show, Eq)
$(deriveJSON hasuraJSON ''SetCatalogState)
data CatalogState = CatalogState
{ _csId :: !Text,
_csCliState :: !Value,
_csConsoleState :: !Value
}
deriving (Show, Eq)
$(deriveToJSON hasuraJSON ''CatalogState)
data GetCatalogState
= GetCatalogState
deriving (Show, Eq)
$(deriveToJSON defaultOptions ''GetCatalogState)
instance FromJSON GetCatalogState where
parseJSON _ = pure GetCatalogState