{-# LANGUAGE TemplateHaskell #-}

module Hasura.RQL.Types.Metadata
  ( Metadata (..),
    MetadataM (..),
    MetadataModifier (..),
    MetadataNoSources (..),
    MetadataVersion (..),
    MetadataDefaults (..),
    currentMetadataVersion,
    dropComputedFieldInMetadata,
    dropEventTriggerInMetadata,
    dropFunctionInMetadata,
    dropPermissionInMetadata,
    dropLogicalModelPermissionInMetadata,
    dropRelationshipInMetadata,
    dropNativeQueryRelationshipInMetadata,
    dropRemoteRelationshipInMetadata,
    dropTableInMetadata,
    dropRemoteSchemaInMetadata,
    dropRemoteSchemaPermissionInMetadata,
    dropRemoteSchemaRemoteRelationshipInMetadata,
    emptyMetadata,
    emptyMetadataDefaults,
    functionMetadataSetter,
    logicalModelMetadataSetter,
    nativeQueryMetadataSetter,
    storedProcedureMetadataSetter,
    metaActions,
    metaAllowlist,
    metaApiLimits,
    metaBackendConfigs,
    metaCronTriggers,
    metaCustomTypes,
    metaInheritedRoles,
    metaMetricsConfig,
    metaNetwork,
    metaOpenTelemetryConfig,
    metaQueryCollections,
    metaRemoteSchemas,
    metaRestEndpoints,
    metaSetGraphqlIntrospectionOptions,
    metaSources,
    metadataToDTO,
    metadataToOrdJSON,
    overrideMetadataDefaults,
    tableMetadataSetter,
    module Hasura.RQL.Types.Metadata.Common,
  )
where

import Control.Lens hiding (set, (.=))
import Data.Aeson.Extended (FromJSONWithContext (..), mapWithJSONPath)
import Data.Aeson.KeyMap (singleton)
import Data.Aeson.Ordered qualified as AO
import Data.Aeson.Types
import Data.HashMap.Strict.InsOrd.Extended qualified as InsOrdHashMap
import Data.Monoid (Dual (..), Endo (..))
import Hasura.Function.Cache
import Hasura.Function.Metadata (FunctionMetadata (..))
import Hasura.Incremental qualified as Inc
import Hasura.LogicalModel.Lenses (lmmSelectPermissions)
import Hasura.LogicalModel.Metadata (LogicalModelMetadata, LogicalModelName)
import Hasura.Metadata.DTO.MetadataV3 (MetadataV3 (..))
import Hasura.NativeQuery.Lenses (nqmArrayRelationships)
import Hasura.NativeQuery.Metadata (NativeQueryMetadata, NativeQueryName)
import Hasura.Prelude
import Hasura.RQL.Types.Allowlist
import Hasura.RQL.Types.ApiLimit
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
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.GraphqlSchemaIntrospection
import Hasura.RQL.Types.Metadata.Common
import Hasura.RQL.Types.Metadata.Serialization
import Hasura.RQL.Types.OpenTelemetry
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.Roles (RoleName)
import Hasura.RemoteSchema.Metadata
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.BackendMap (BackendMap)
import Hasura.SQL.BackendMap qualified as BackendMap
import Hasura.StoredProcedure.Metadata (StoredProcedureMetadata)
import Hasura.Table.Metadata
  ( TableMetadata (..),
    tmArrayRelationships,
    tmComputedFields,
    tmDeletePermissions,
    tmEventTriggers,
    tmInsertPermissions,
    tmObjectRelationships,
    tmRemoteRelationships,
    tmSelectPermissions,
    tmUpdatePermissions,
  )
import Hasura.Tracing (TraceT)
import Language.GraphQL.Draft.Syntax qualified as G
import Network.Types.Extended

-- | 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).
-- Adding a new value constructor to @'MetadataVersion' type bumps the metadata version.
--
-- NOTE: When metadata version is bumped:
-- 1. The Hasura CLI and Console actively use export metadata API to read metadata.
--    Hence, it is necessary to update CLI and Console to read latest metadata.
--    All changes SHOULD be released hand in hand (preferebly in one pull request)
-- 2. There might be other third party services (developed by Hasura users) which use
--    the export metadata API. Apart from changelog, we need to establish the metadata
--    version update by bumping up the minor version of the GraphQL Engine.
data MetadataVersion
  = MVVersion1
  | MVVersion2
  | MVVersion3
  deriving (Int -> MetadataVersion -> ShowS
[MetadataVersion] -> ShowS
MetadataVersion -> String
(Int -> MetadataVersion -> ShowS)
-> (MetadataVersion -> String)
-> ([MetadataVersion] -> ShowS)
-> Show MetadataVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetadataVersion -> ShowS
showsPrec :: Int -> MetadataVersion -> ShowS
$cshow :: MetadataVersion -> String
show :: MetadataVersion -> String
$cshowList :: [MetadataVersion] -> ShowS
showList :: [MetadataVersion] -> ShowS
Show, MetadataVersion -> MetadataVersion -> Bool
(MetadataVersion -> MetadataVersion -> Bool)
-> (MetadataVersion -> MetadataVersion -> Bool)
-> Eq MetadataVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetadataVersion -> MetadataVersion -> Bool
== :: MetadataVersion -> MetadataVersion -> Bool
$c/= :: MetadataVersion -> MetadataVersion -> Bool
/= :: MetadataVersion -> MetadataVersion -> Bool
Eq, (forall x. MetadataVersion -> Rep MetadataVersion x)
-> (forall x. Rep MetadataVersion x -> MetadataVersion)
-> Generic MetadataVersion
forall x. Rep MetadataVersion x -> MetadataVersion
forall x. MetadataVersion -> Rep MetadataVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MetadataVersion -> Rep MetadataVersion x
from :: forall x. MetadataVersion -> Rep MetadataVersion x
$cto :: forall x. Rep MetadataVersion x -> MetadataVersion
to :: forall x. Rep MetadataVersion x -> MetadataVersion
Generic)

instance ToJSON MetadataVersion where
  toJSON :: MetadataVersion -> Value
toJSON = \case
    MetadataVersion
MVVersion1 -> forall a. ToJSON a => a -> Value
toJSON @Int Int
1
    MetadataVersion
MVVersion2 -> forall a. ToJSON a => a -> Value
toJSON @Int Int
2
    MetadataVersion
MVVersion3 -> forall a. ToJSON a => a -> Value
toJSON @Int Int
3

instance FromJSON MetadataVersion where
  parseJSON :: Value -> Parser MetadataVersion
parseJSON Value
v = do
    Int
version :: Int <- Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    case Int
version of
      Int
1 -> MetadataVersion -> Parser MetadataVersion
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MetadataVersion
MVVersion1
      Int
2 -> MetadataVersion -> Parser MetadataVersion
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MetadataVersion
MVVersion2
      Int
3 -> MetadataVersion -> Parser MetadataVersion
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MetadataVersion
MVVersion3
      Int
i -> String -> Parser MetadataVersion
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser MetadataVersion)
-> String -> Parser MetadataVersion
forall a b. (a -> b) -> a -> b
$ String
"expected 1, 2 or 3, encountered " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i

currentMetadataVersion :: MetadataVersion
currentMetadataVersion :: MetadataVersion
currentMetadataVersion = MetadataVersion
MVVersion3

-- | A complete GraphQL Engine metadata representation to be stored,
-- exported/replaced via metadata queries.
data Metadata = Metadata
  { Metadata -> Sources
_metaSources :: Sources,
    Metadata -> RemoteSchemas
_metaRemoteSchemas :: RemoteSchemas,
    Metadata -> QueryCollections
_metaQueryCollections :: QueryCollections,
    Metadata -> MetadataAllowlist
_metaAllowlist :: MetadataAllowlist,
    Metadata -> CustomTypes
_metaCustomTypes :: CustomTypes,
    Metadata -> Actions
_metaActions :: Actions,
    Metadata -> CronTriggers
_metaCronTriggers :: CronTriggers,
    Metadata -> Endpoints
_metaRestEndpoints :: Endpoints,
    Metadata -> ApiLimit
_metaApiLimits :: ApiLimit,
    Metadata -> MetricsConfig
_metaMetricsConfig :: MetricsConfig,
    Metadata -> InheritedRoles
_metaInheritedRoles :: InheritedRoles,
    Metadata -> SetGraphqlIntrospectionOptions
_metaSetGraphqlIntrospectionOptions :: SetGraphqlIntrospectionOptions,
    Metadata -> Network
_metaNetwork :: Network,
    Metadata -> BackendMap BackendConfigWrapper
_metaBackendConfigs :: BackendMap BackendConfigWrapper,
    Metadata -> OpenTelemetryConfig
_metaOpenTelemetryConfig :: OpenTelemetryConfig
  }
  deriving (Int -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> String
(Int -> Metadata -> ShowS)
-> (Metadata -> String) -> ([Metadata] -> ShowS) -> Show Metadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Metadata -> ShowS
showsPrec :: Int -> Metadata -> ShowS
$cshow :: Metadata -> String
show :: Metadata -> String
$cshowList :: [Metadata] -> ShowS
showList :: [Metadata] -> ShowS
Show, Metadata -> Metadata -> Bool
(Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool) -> Eq Metadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
/= :: Metadata -> Metadata -> Bool
Eq, (forall x. Metadata -> Rep Metadata x)
-> (forall x. Rep Metadata x -> Metadata) -> Generic Metadata
forall x. Rep Metadata x -> Metadata
forall x. Metadata -> Rep Metadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Metadata -> Rep Metadata x
from :: forall x. Metadata -> Rep Metadata x
$cto :: forall x. Rep Metadata x -> Metadata
to :: forall x. Rep Metadata x -> Metadata
Generic)

instance Inc.Select Metadata

$(makeLenses ''Metadata)

instance FromJSON Metadata where
  parseJSON :: Value -> Parser Metadata
parseJSON = String -> (Object -> Parser Metadata) -> Value -> Parser Metadata
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Metadata" ((Object -> Parser Metadata) -> Value -> Parser Metadata)
-> (Object -> Parser Metadata) -> Value -> Parser Metadata
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    MetadataVersion
version <- Object
o Object -> Key -> Parser (Maybe MetadataVersion)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"version" Parser (Maybe MetadataVersion)
-> MetadataVersion -> Parser MetadataVersion
forall a. Parser (Maybe a) -> a -> Parser a
.!= MetadataVersion
MVVersion1
    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MetadataVersion
version MetadataVersion -> MetadataVersion -> Bool
forall a. Eq a => a -> a -> Bool
/= MetadataVersion
MVVersion3)
      (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
      (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"unexpected metadata version from storage: "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> MetadataVersion -> String
forall a. Show a => a -> String
show MetadataVersion
version
    [Value]
rawSources <- Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sources"
    BackendMap BackendConfigWrapper
backendConfigs <- Object
o Object -> Key -> Parser (Maybe (BackendMap BackendConfigWrapper))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"backend_configs" Parser (Maybe (BackendMap BackendConfigWrapper))
-> BackendMap BackendConfigWrapper
-> Parser (BackendMap BackendConfigWrapper)
forall a. Parser (Maybe a) -> a -> Parser a
.!= BackendMap BackendConfigWrapper
forall a. Monoid a => a
mempty
    Sources
sources <- (BackendSourceMetadata -> SourceName)
-> [BackendSourceMetadata] -> Sources
forall k a. Hashable k => (a -> k) -> [a] -> InsOrdHashMap k a
oMapFromL BackendSourceMetadata -> SourceName
getSourceName ([BackendSourceMetadata] -> Sources)
-> Parser [BackendSourceMetadata] -> Parser Sources
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser BackendSourceMetadata)
-> [Value] -> Parser [BackendSourceMetadata]
forall a b. (a -> Parser b) -> [a] -> Parser [b]
mapWithJSONPath Value -> Parser BackendSourceMetadata
parseSourceMetadata [Value]
rawSources Parser [BackendSourceMetadata]
-> JSONPathElement -> Parser [BackendSourceMetadata]
forall a. Parser a -> JSONPathElement -> Parser a
<?> Key -> JSONPathElement
Key Key
"sources"
    Endpoints
endpoints <- (EndpointMetadata QueryReference -> EndpointName)
-> [EndpointMetadata QueryReference] -> Endpoints
forall k a. Hashable k => (a -> k) -> [a] -> InsOrdHashMap k a
oMapFromL EndpointMetadata QueryReference -> EndpointName
forall query. EndpointMetadata query -> EndpointName
_ceName ([EndpointMetadata QueryReference] -> Endpoints)
-> Parser [EndpointMetadata QueryReference] -> Parser Endpoints
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe [EndpointMetadata QueryReference])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rest_endpoints" Parser (Maybe [EndpointMetadata QueryReference])
-> [EndpointMetadata QueryReference]
-> Parser [EndpointMetadata QueryReference]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
    Network
network <- Object
o Object -> Key -> Parser (Maybe Network)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"network" Parser (Maybe Network) -> Network -> Parser Network
forall a. Parser (Maybe a) -> a -> Parser a
.!= Network
emptyNetwork
    OpenTelemetryConfig
openTelemetry <- Object
o Object -> Key -> Parser (Maybe OpenTelemetryConfig)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"opentelemetry" Parser (Maybe OpenTelemetryConfig)
-> OpenTelemetryConfig -> Parser OpenTelemetryConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= OpenTelemetryConfig
emptyOpenTelemetryConfig
    ( RemoteSchemas
remoteSchemas,
      QueryCollections
queryCollections,
      MetadataAllowlist
allowlist,
      CustomTypes
customTypes,
      Actions
actions,
      CronTriggers
cronTriggers,
      ApiLimit
apiLimits,
      MetricsConfig
metricsConfig,
      InheritedRoles
inheritedRoles,
      SetGraphqlIntrospectionOptions
disabledSchemaIntrospectionRoles
      ) <-
      Object
-> Parser
     (RemoteSchemas, QueryCollections, MetadataAllowlist, CustomTypes,
      Actions, CronTriggers, ApiLimit, MetricsConfig, InheritedRoles,
      SetGraphqlIntrospectionOptions)
parseNonSourcesMetadata Object
o
    Metadata -> Parser Metadata
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Metadata -> Parser Metadata) -> Metadata -> Parser Metadata
forall a b. (a -> b) -> a -> b
$ Sources
-> RemoteSchemas
-> QueryCollections
-> MetadataAllowlist
-> CustomTypes
-> Actions
-> CronTriggers
-> Endpoints
-> ApiLimit
-> MetricsConfig
-> InheritedRoles
-> SetGraphqlIntrospectionOptions
-> Network
-> BackendMap BackendConfigWrapper
-> OpenTelemetryConfig
-> Metadata
Metadata
        Sources
sources
        RemoteSchemas
remoteSchemas
        QueryCollections
queryCollections
        MetadataAllowlist
allowlist
        CustomTypes
customTypes
        Actions
actions
        CronTriggers
cronTriggers
        Endpoints
endpoints
        ApiLimit
apiLimits
        MetricsConfig
metricsConfig
        InheritedRoles
inheritedRoles
        SetGraphqlIntrospectionOptions
disabledSchemaIntrospectionRoles
        Network
network
        BackendMap BackendConfigWrapper
backendConfigs
        OpenTelemetryConfig
openTelemetry
    where
      parseSourceMetadata :: Value -> Parser BackendSourceMetadata
      parseSourceMetadata :: Value -> Parser BackendSourceMetadata
parseSourceMetadata = String
-> (Object -> Parser BackendSourceMetadata)
-> Value
-> Parser BackendSourceMetadata
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SourceMetadata" \Object
o -> do
        AnyBackend BackendSourceKind
backendSourceKind <- (Value -> Parser (AnyBackend BackendSourceKind))
-> Object -> Key -> Parser (Maybe (AnyBackend BackendSourceKind))
forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
explicitParseFieldMaybe Value -> Parser (AnyBackend BackendSourceKind)
AB.parseBackendSourceKindFromJSON Object
o Key
"kind" Parser (Maybe (AnyBackend BackendSourceKind))
-> AnyBackend BackendSourceKind
-> Parser (AnyBackend BackendSourceKind)
forall a. Parser (Maybe a) -> a -> Parser a
.!= BackendSourceKind ('Postgres 'Vanilla)
-> AnyBackend BackendSourceKind
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend BackendSourceKind ('Postgres 'Vanilla)
PostgresVanillaKind
        forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend
          AnyBackend BackendSourceKind
backendSourceKind
          ( \(BackendSourceKind b
kind :: BackendSourceKind b) ->
              AnyBackend SourceMetadata -> BackendSourceMetadata
BackendSourceMetadata (AnyBackend SourceMetadata -> BackendSourceMetadata)
-> (SourceMetadata b -> AnyBackend SourceMetadata)
-> SourceMetadata b
-> BackendSourceMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend @b (SourceMetadata b -> BackendSourceMetadata)
-> Parser (SourceMetadata b) -> Parser BackendSourceMetadata
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackendSourceKind b -> Value -> Parser (SourceMetadata b)
forall ctx a. FromJSONWithContext ctx a => ctx -> Value -> Parser a
parseJSONWithContext BackendSourceKind b
kind (Object -> Value
Object Object
o)
          )

emptyMetadata :: Metadata
emptyMetadata :: Metadata
emptyMetadata =
  Metadata
    { _metaSources :: Sources
_metaSources = Sources
forall a. Monoid a => a
mempty,
      _metaRemoteSchemas :: RemoteSchemas
_metaRemoteSchemas = RemoteSchemas
forall a. Monoid a => a
mempty,
      _metaQueryCollections :: QueryCollections
_metaQueryCollections = QueryCollections
forall a. Monoid a => a
mempty,
      _metaAllowlist :: MetadataAllowlist
_metaAllowlist = MetadataAllowlist
forall a. Monoid a => a
mempty,
      _metaActions :: Actions
_metaActions = Actions
forall a. Monoid a => a
mempty,
      _metaCronTriggers :: CronTriggers
_metaCronTriggers = CronTriggers
forall a. Monoid a => a
mempty,
      _metaRestEndpoints :: Endpoints
_metaRestEndpoints = Endpoints
forall a. Monoid a => a
mempty,
      _metaInheritedRoles :: InheritedRoles
_metaInheritedRoles = InheritedRoles
forall a. Monoid a => a
mempty,
      _metaSetGraphqlIntrospectionOptions :: SetGraphqlIntrospectionOptions
_metaSetGraphqlIntrospectionOptions = SetGraphqlIntrospectionOptions
forall a. Monoid a => a
mempty,
      _metaCustomTypes :: CustomTypes
_metaCustomTypes = CustomTypes
emptyCustomTypes,
      _metaApiLimits :: ApiLimit
_metaApiLimits = ApiLimit
emptyApiLimit,
      _metaMetricsConfig :: MetricsConfig
_metaMetricsConfig = MetricsConfig
emptyMetricsConfig,
      _metaNetwork :: Network
_metaNetwork = Network
emptyNetwork,
      _metaBackendConfigs :: BackendMap BackendConfigWrapper
_metaBackendConfigs = BackendMap BackendConfigWrapper
forall a. Monoid a => a
mempty,
      _metaOpenTelemetryConfig :: OpenTelemetryConfig
_metaOpenTelemetryConfig = OpenTelemetryConfig
emptyOpenTelemetryConfig
    }

-- | This type serves to allow Metadata arguments to be distinguished
newtype MetadataDefaults = MetadataDefaults Metadata
  deriving (MetadataDefaults -> MetadataDefaults -> Bool
(MetadataDefaults -> MetadataDefaults -> Bool)
-> (MetadataDefaults -> MetadataDefaults -> Bool)
-> Eq MetadataDefaults
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetadataDefaults -> MetadataDefaults -> Bool
== :: MetadataDefaults -> MetadataDefaults -> Bool
$c/= :: MetadataDefaults -> MetadataDefaults -> Bool
/= :: MetadataDefaults -> MetadataDefaults -> Bool
Eq, Int -> MetadataDefaults -> ShowS
[MetadataDefaults] -> ShowS
MetadataDefaults -> String
(Int -> MetadataDefaults -> ShowS)
-> (MetadataDefaults -> String)
-> ([MetadataDefaults] -> ShowS)
-> Show MetadataDefaults
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetadataDefaults -> ShowS
showsPrec :: Int -> MetadataDefaults -> ShowS
$cshow :: MetadataDefaults -> String
show :: MetadataDefaults -> String
$cshowList :: [MetadataDefaults] -> ShowS
showList :: [MetadataDefaults] -> ShowS
Show)

-- | The metadata instance first defaults the version and sources fields, then defers to the Metadata FromJSON instance
instance FromJSON MetadataDefaults where
  parseJSON :: Value -> Parser MetadataDefaults
parseJSON Value
o = Metadata -> MetadataDefaults
MetadataDefaults (Metadata -> MetadataDefaults)
-> Parser Metadata -> Parser MetadataDefaults
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser Metadata
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser Metadata) -> Parser Value -> Parser Metadata
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Value
defaultVersionAndSources Value
o)
    where
      defaultVersionAndSources :: Value -> Parser Value
defaultVersionAndSources = \case
        (Object Object
o') -> Value -> Parser Value
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Value
Object (Object
o' Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
versionSingleton Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
sourcesSingleton))
        Value
_ -> String -> Parser Value
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Was expecting an Object for Metadata"
        where
          versionSingleton :: Object
versionSingleton = Key -> Value -> Object
forall v. Key -> v -> KeyMap v
singleton Key
"version" (Scientific -> Value
Number Scientific
3)
          sourcesSingleton :: Object
sourcesSingleton = Key -> Value -> Object
forall v. Key -> v -> KeyMap v
singleton Key
"sources" (Array -> Value
Array Array
forall a. Monoid a => a
mempty)

emptyMetadataDefaults :: MetadataDefaults
emptyMetadataDefaults :: MetadataDefaults
emptyMetadataDefaults = Metadata -> MetadataDefaults
MetadataDefaults Metadata
emptyMetadata

-- | This acts like a Semigroup instance for Metadata, favouring the non-default Metadata
overrideMetadataDefaults :: Metadata -> MetadataDefaults -> Metadata
overrideMetadataDefaults :: Metadata -> MetadataDefaults -> Metadata
overrideMetadataDefaults Metadata
md (MetadataDefaults Metadata
defs) =
  Metadata
    { _metaSources :: Sources
_metaSources = (Metadata -> Sources
_metaSources Metadata
md) Sources -> Sources -> Sources
forall a. Semigroup a => a -> a -> a
<> (Metadata -> Sources
_metaSources Metadata
defs),
      _metaRemoteSchemas :: RemoteSchemas
_metaRemoteSchemas = (Metadata -> RemoteSchemas
_metaRemoteSchemas Metadata
md) RemoteSchemas -> RemoteSchemas -> RemoteSchemas
forall a. Semigroup a => a -> a -> a
<> (Metadata -> RemoteSchemas
_metaRemoteSchemas Metadata
defs),
      _metaQueryCollections :: QueryCollections
_metaQueryCollections = (Metadata -> QueryCollections
_metaQueryCollections Metadata
md) QueryCollections -> QueryCollections -> QueryCollections
forall a. Semigroup a => a -> a -> a
<> (Metadata -> QueryCollections
_metaQueryCollections Metadata
defs),
      _metaAllowlist :: MetadataAllowlist
_metaAllowlist = (Metadata -> MetadataAllowlist
_metaAllowlist Metadata
md) MetadataAllowlist -> MetadataAllowlist -> MetadataAllowlist
forall a. Semigroup a => a -> a -> a
<> (Metadata -> MetadataAllowlist
_metaAllowlist Metadata
defs),
      _metaActions :: Actions
_metaActions = (Metadata -> Actions
_metaActions Metadata
md) Actions -> Actions -> Actions
forall a. Semigroup a => a -> a -> a
<> (Metadata -> Actions
_metaActions Metadata
defs),
      _metaCronTriggers :: CronTriggers
_metaCronTriggers = (Metadata -> CronTriggers
_metaCronTriggers Metadata
md) CronTriggers -> CronTriggers -> CronTriggers
forall a. Semigroup a => a -> a -> a
<> (Metadata -> CronTriggers
_metaCronTriggers Metadata
defs),
      _metaRestEndpoints :: Endpoints
_metaRestEndpoints = (Metadata -> Endpoints
_metaRestEndpoints Metadata
md) Endpoints -> Endpoints -> Endpoints
forall a. Semigroup a => a -> a -> a
<> (Metadata -> Endpoints
_metaRestEndpoints Metadata
defs),
      _metaInheritedRoles :: InheritedRoles
_metaInheritedRoles = (Metadata -> InheritedRoles
_metaInheritedRoles Metadata
md) InheritedRoles -> InheritedRoles -> InheritedRoles
forall a. Semigroup a => a -> a -> a
<> (Metadata -> InheritedRoles
_metaInheritedRoles Metadata
defs),
      _metaSetGraphqlIntrospectionOptions :: SetGraphqlIntrospectionOptions
_metaSetGraphqlIntrospectionOptions = (Metadata -> SetGraphqlIntrospectionOptions
_metaSetGraphqlIntrospectionOptions Metadata
md) SetGraphqlIntrospectionOptions
-> SetGraphqlIntrospectionOptions -> SetGraphqlIntrospectionOptions
forall a. Semigroup a => a -> a -> a
<> (Metadata -> SetGraphqlIntrospectionOptions
_metaSetGraphqlIntrospectionOptions Metadata
defs),
      _metaCustomTypes :: CustomTypes
_metaCustomTypes = (Metadata -> CustomTypes
_metaCustomTypes Metadata
md) CustomTypes -> CustomTypes -> CustomTypes
`overrideCustomTypesDefaults` (Metadata -> CustomTypes
_metaCustomTypes Metadata
defs),
      _metaApiLimits :: ApiLimit
_metaApiLimits = (Metadata -> ApiLimit
_metaApiLimits Metadata
md) ApiLimit -> ApiLimit -> ApiLimit
`overrideApiLimitsDefaults` (Metadata -> ApiLimit
_metaApiLimits Metadata
defs),
      _metaMetricsConfig :: MetricsConfig
_metaMetricsConfig = (Metadata -> MetricsConfig
_metaMetricsConfig Metadata
md) MetricsConfig -> MetricsConfig -> MetricsConfig
`overrideMetricsConfigDefaults` (Metadata -> MetricsConfig
_metaMetricsConfig Metadata
defs),
      _metaNetwork :: Network
_metaNetwork = (Metadata -> Network
_metaNetwork Metadata
md) Network -> Network -> Network
`overrideNetworkDefaults` (Metadata -> Network
_metaNetwork Metadata
defs),
      _metaBackendConfigs :: BackendMap BackendConfigWrapper
_metaBackendConfigs = Metadata -> BackendMap BackendConfigWrapper
_metaBackendConfigs Metadata
md BackendMap BackendConfigWrapper
-> BackendMap BackendConfigWrapper
-> BackendMap BackendConfigWrapper
forall (i :: BackendType -> *).
SatisfiesForAllBackends i Semigroup =>
BackendMap i -> BackendMap i -> BackendMap i
`BackendMap.overridesDeeply` Metadata -> BackendMap BackendConfigWrapper
_metaBackendConfigs Metadata
defs,
      _metaOpenTelemetryConfig :: OpenTelemetryConfig
_metaOpenTelemetryConfig = Metadata -> OpenTelemetryConfig
_metaOpenTelemetryConfig Metadata
md -- no merge strategy implemented
    }
  where
    overrideCustomTypesDefaults :: CustomTypes -> CustomTypes -> CustomTypes
overrideCustomTypesDefaults (CustomTypes [InputObjectTypeDefinition]
a1 [ObjectTypeDefinition]
a2 [ScalarTypeDefinition]
a3 [EnumTypeDefinition]
a4) (CustomTypes [InputObjectTypeDefinition]
b1 [ObjectTypeDefinition]
b2 [ScalarTypeDefinition]
b3 [EnumTypeDefinition]
b4) = [InputObjectTypeDefinition]
-> [ObjectTypeDefinition]
-> [ScalarTypeDefinition]
-> [EnumTypeDefinition]
-> CustomTypes
CustomTypes ([InputObjectTypeDefinition]
a1 [InputObjectTypeDefinition]
-> [InputObjectTypeDefinition] -> [InputObjectTypeDefinition]
forall a. Semigroup a => a -> a -> a
<> [InputObjectTypeDefinition]
b1) ([ObjectTypeDefinition]
a2 [ObjectTypeDefinition]
-> [ObjectTypeDefinition] -> [ObjectTypeDefinition]
forall a. Semigroup a => a -> a -> a
<> [ObjectTypeDefinition]
b2) ([ScalarTypeDefinition]
a3 [ScalarTypeDefinition]
-> [ScalarTypeDefinition] -> [ScalarTypeDefinition]
forall a. Semigroup a => a -> a -> a
<> [ScalarTypeDefinition]
b3) ([EnumTypeDefinition]
a4 [EnumTypeDefinition]
-> [EnumTypeDefinition] -> [EnumTypeDefinition]
forall a. Semigroup a => a -> a -> a
<> [EnumTypeDefinition]
b4)
    overrideApiLimitsDefaults :: ApiLimit -> ApiLimit -> ApiLimit
overrideApiLimitsDefaults (ApiLimit Maybe RateLimit
a1 Maybe DepthLimit
a2 Maybe NodeLimit
a3 Maybe TimeLimit
a4 Maybe BatchLimit
a5 Bool
a6) (ApiLimit Maybe RateLimit
b1 Maybe DepthLimit
b2 Maybe NodeLimit
b3 Maybe TimeLimit
b4 Maybe BatchLimit
b5 Bool
b6) = Maybe RateLimit
-> Maybe DepthLimit
-> Maybe NodeLimit
-> Maybe TimeLimit
-> Maybe BatchLimit
-> Bool
-> ApiLimit
ApiLimit (Maybe RateLimit
a1 Maybe RateLimit -> Maybe RateLimit -> Maybe RateLimit
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe RateLimit
b1) (Maybe DepthLimit
a2 Maybe DepthLimit -> Maybe DepthLimit -> Maybe DepthLimit
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe DepthLimit
b2) (Maybe NodeLimit
a3 Maybe NodeLimit -> Maybe NodeLimit -> Maybe NodeLimit
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe NodeLimit
b3) (Maybe TimeLimit
a4 Maybe TimeLimit -> Maybe TimeLimit -> Maybe TimeLimit
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe TimeLimit
b4) (Maybe BatchLimit
a5 Maybe BatchLimit -> Maybe BatchLimit -> Maybe BatchLimit
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe BatchLimit
b5) (Bool
a6 Bool -> Bool -> Bool
|| Bool
b6)
    overrideMetricsConfigDefaults :: MetricsConfig -> MetricsConfig -> MetricsConfig
overrideMetricsConfigDefaults (MetricsConfig Bool
a1 Bool
a2) (MetricsConfig Bool
b1 Bool
b2) = Bool -> Bool -> MetricsConfig
MetricsConfig (Bool
a1 Bool -> Bool -> Bool
|| Bool
b1) (Bool
a2 Bool -> Bool -> Bool
|| Bool
b2)
    overrideNetworkDefaults :: Network -> Network -> Network
overrideNetworkDefaults (Network [TlsAllow]
a1) (Network [TlsAllow]
b1) = [TlsAllow] -> Network
Network ([TlsAllow]
a1 [TlsAllow] -> [TlsAllow] -> [TlsAllow]
forall a. Semigroup a => a -> a -> a
<> [TlsAllow]
b1)

tableMetadataSetter ::
  (Backend b) =>
  SourceName ->
  TableName b ->
  ASetter' Metadata (TableMetadata b)
tableMetadataSetter :: forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter SourceName
source TableName b
table =
  (Sources -> Identity Sources) -> Metadata -> Identity Metadata
Lens' Metadata Sources
metaSources ((Sources -> Identity Sources) -> Metadata -> Identity Metadata)
-> ((TableMetadata b -> Identity (TableMetadata b))
    -> Sources -> Identity Sources)
-> (TableMetadata b -> Identity (TableMetadata b))
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Sources
SourceName
source ((BackendSourceMetadata -> Identity BackendSourceMetadata)
 -> Sources -> Identity Sources)
-> ((TableMetadata b -> Identity (TableMetadata b))
    -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> (TableMetadata b -> Identity (TableMetadata b))
-> Sources
-> Identity Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceMetadata b -> Identity (SourceMetadata b))
-> BackendSourceMetadata -> Identity BackendSourceMetadata
forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata ((SourceMetadata b -> Identity (SourceMetadata b))
 -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> ((TableMetadata b -> Identity (TableMetadata b))
    -> SourceMetadata b -> Identity (SourceMetadata b))
-> (TableMetadata b -> Identity (TableMetadata b))
-> BackendSourceMetadata
-> Identity BackendSourceMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InsOrdHashMap (TableName b) (TableMetadata b)
 -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
-> SourceMetadata b -> Identity (SourceMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Tables b -> f (Tables b))
-> SourceMetadata b -> f (SourceMetadata b)
smTables ((InsOrdHashMap (TableName b) (TableMetadata b)
  -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
 -> SourceMetadata b -> Identity (SourceMetadata b))
-> ((TableMetadata b -> Identity (TableMetadata b))
    -> InsOrdHashMap (TableName b) (TableMetadata b)
    -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
-> (TableMetadata b -> Identity (TableMetadata b))
-> SourceMetadata b
-> Identity (SourceMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap (TableName b) (TableMetadata b))
-> Traversal'
     (InsOrdHashMap (TableName b) (TableMetadata b))
     (IxValue (InsOrdHashMap (TableName b) (TableMetadata b)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (InsOrdHashMap (TableName b) (TableMetadata b))
TableName b
table

-- | A lens setter for the metadata of a specific function as identified by
--   the source name and function name.
functionMetadataSetter ::
  (Backend b) =>
  SourceName ->
  FunctionName b ->
  ASetter' Metadata (FunctionMetadata b)
functionMetadataSetter :: forall (b :: BackendType).
Backend b =>
SourceName
-> FunctionName b -> ASetter' Metadata (FunctionMetadata b)
functionMetadataSetter SourceName
source FunctionName b
function =
  (Sources -> Identity Sources) -> Metadata -> Identity Metadata
Lens' Metadata Sources
metaSources ((Sources -> Identity Sources) -> Metadata -> Identity Metadata)
-> ((FunctionMetadata b -> Identity (FunctionMetadata b))
    -> Sources -> Identity Sources)
-> (FunctionMetadata b -> Identity (FunctionMetadata b))
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Sources
SourceName
source ((BackendSourceMetadata -> Identity BackendSourceMetadata)
 -> Sources -> Identity Sources)
-> ((FunctionMetadata b -> Identity (FunctionMetadata b))
    -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> (FunctionMetadata b -> Identity (FunctionMetadata b))
-> Sources
-> Identity Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceMetadata b -> Identity (SourceMetadata b))
-> BackendSourceMetadata -> Identity BackendSourceMetadata
forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata ((SourceMetadata b -> Identity (SourceMetadata b))
 -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> ((FunctionMetadata b -> Identity (FunctionMetadata b))
    -> SourceMetadata b -> Identity (SourceMetadata b))
-> (FunctionMetadata b -> Identity (FunctionMetadata b))
-> BackendSourceMetadata
-> Identity BackendSourceMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InsOrdHashMap (FunctionName b) (FunctionMetadata b)
 -> Identity (InsOrdHashMap (FunctionName b) (FunctionMetadata b)))
-> SourceMetadata b -> Identity (SourceMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Functions b -> f (Functions b))
-> SourceMetadata b -> f (SourceMetadata b)
smFunctions ((InsOrdHashMap (FunctionName b) (FunctionMetadata b)
  -> Identity (InsOrdHashMap (FunctionName b) (FunctionMetadata b)))
 -> SourceMetadata b -> Identity (SourceMetadata b))
-> ((FunctionMetadata b -> Identity (FunctionMetadata b))
    -> InsOrdHashMap (FunctionName b) (FunctionMetadata b)
    -> Identity (InsOrdHashMap (FunctionName b) (FunctionMetadata b)))
-> (FunctionMetadata b -> Identity (FunctionMetadata b))
-> SourceMetadata b
-> Identity (SourceMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap (FunctionName b) (FunctionMetadata b))
-> Traversal'
     (InsOrdHashMap (FunctionName b) (FunctionMetadata b))
     (IxValue (InsOrdHashMap (FunctionName b) (FunctionMetadata b)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (InsOrdHashMap (FunctionName b) (FunctionMetadata b))
FunctionName b
function

-- | A lens setter for the metadata of a logical model as identified by the
-- source name and root field name.
logicalModelMetadataSetter ::
  (Backend b) =>
  SourceName ->
  LogicalModelName ->
  ASetter' Metadata (LogicalModelMetadata b)
logicalModelMetadataSetter :: forall (b :: BackendType).
Backend b =>
SourceName
-> LogicalModelName -> ASetter' Metadata (LogicalModelMetadata b)
logicalModelMetadataSetter SourceName
source LogicalModelName
name =
  (Sources -> Identity Sources) -> Metadata -> Identity Metadata
Lens' Metadata Sources
metaSources ((Sources -> Identity Sources) -> Metadata -> Identity Metadata)
-> ((LogicalModelMetadata b -> Identity (LogicalModelMetadata b))
    -> Sources -> Identity Sources)
-> (LogicalModelMetadata b -> Identity (LogicalModelMetadata b))
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Sources
SourceName
source ((BackendSourceMetadata -> Identity BackendSourceMetadata)
 -> Sources -> Identity Sources)
-> ((LogicalModelMetadata b -> Identity (LogicalModelMetadata b))
    -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> (LogicalModelMetadata b -> Identity (LogicalModelMetadata b))
-> Sources
-> Identity Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceMetadata b -> Identity (SourceMetadata b))
-> BackendSourceMetadata -> Identity BackendSourceMetadata
forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata ((SourceMetadata b -> Identity (SourceMetadata b))
 -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> ((LogicalModelMetadata b -> Identity (LogicalModelMetadata b))
    -> SourceMetadata b -> Identity (SourceMetadata b))
-> (LogicalModelMetadata b -> Identity (LogicalModelMetadata b))
-> BackendSourceMetadata
-> Identity BackendSourceMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogicalModels b -> Identity (LogicalModels b))
-> SourceMetadata b -> Identity (SourceMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(LogicalModels b -> f (LogicalModels b))
-> SourceMetadata b -> f (SourceMetadata b)
smLogicalModels ((LogicalModels b -> Identity (LogicalModels b))
 -> SourceMetadata b -> Identity (SourceMetadata b))
-> ((LogicalModelMetadata b -> Identity (LogicalModelMetadata b))
    -> LogicalModels b -> Identity (LogicalModels b))
-> (LogicalModelMetadata b -> Identity (LogicalModelMetadata b))
-> SourceMetadata b
-> Identity (SourceMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (LogicalModels b)
-> Traversal' (LogicalModels b) (IxValue (LogicalModels b))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (LogicalModels b)
LogicalModelName
name

-- | A lens setter for the metadata of a native query as identified by the
-- source name and root field name.
nativeQueryMetadataSetter ::
  (Backend b) =>
  SourceName ->
  NativeQueryName ->
  ASetter' Metadata (NativeQueryMetadata b)
nativeQueryMetadataSetter :: forall (b :: BackendType).
Backend b =>
SourceName
-> NativeQueryName -> ASetter' Metadata (NativeQueryMetadata b)
nativeQueryMetadataSetter SourceName
source NativeQueryName
nativeQueryName =
  (Sources -> Identity Sources) -> Metadata -> Identity Metadata
Lens' Metadata Sources
metaSources ((Sources -> Identity Sources) -> Metadata -> Identity Metadata)
-> ((NativeQueryMetadata b -> Identity (NativeQueryMetadata b))
    -> Sources -> Identity Sources)
-> (NativeQueryMetadata b -> Identity (NativeQueryMetadata b))
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Sources
SourceName
source ((BackendSourceMetadata -> Identity BackendSourceMetadata)
 -> Sources -> Identity Sources)
-> ((NativeQueryMetadata b -> Identity (NativeQueryMetadata b))
    -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> (NativeQueryMetadata b -> Identity (NativeQueryMetadata b))
-> Sources
-> Identity Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceMetadata b -> Identity (SourceMetadata b))
-> BackendSourceMetadata -> Identity BackendSourceMetadata
forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata ((SourceMetadata b -> Identity (SourceMetadata b))
 -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> ((NativeQueryMetadata b -> Identity (NativeQueryMetadata b))
    -> SourceMetadata b -> Identity (SourceMetadata b))
-> (NativeQueryMetadata b -> Identity (NativeQueryMetadata b))
-> BackendSourceMetadata
-> Identity BackendSourceMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NativeQueries b -> Identity (NativeQueries b))
-> SourceMetadata b -> Identity (SourceMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(NativeQueries b -> f (NativeQueries b))
-> SourceMetadata b -> f (SourceMetadata b)
smNativeQueries ((NativeQueries b -> Identity (NativeQueries b))
 -> SourceMetadata b -> Identity (SourceMetadata b))
-> ((NativeQueryMetadata b -> Identity (NativeQueryMetadata b))
    -> NativeQueries b -> Identity (NativeQueries b))
-> (NativeQueryMetadata b -> Identity (NativeQueryMetadata b))
-> SourceMetadata b
-> Identity (SourceMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (NativeQueries b)
-> Traversal' (NativeQueries b) (IxValue (NativeQueries b))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (NativeQueries b)
NativeQueryName
nativeQueryName

-- | A lens setter for the metadata of a stored procedure as identified by the
-- source name and root field name.
storedProcedureMetadataSetter ::
  (Backend b) =>
  SourceName ->
  FunctionName b ->
  ASetter' Metadata (StoredProcedureMetadata b)
storedProcedureMetadataSetter :: forall (b :: BackendType).
Backend b =>
SourceName
-> FunctionName b -> ASetter' Metadata (StoredProcedureMetadata b)
storedProcedureMetadataSetter SourceName
source FunctionName b
storedProcedureName =
  (Sources -> Identity Sources) -> Metadata -> Identity Metadata
Lens' Metadata Sources
metaSources ((Sources -> Identity Sources) -> Metadata -> Identity Metadata)
-> ((StoredProcedureMetadata b
     -> Identity (StoredProcedureMetadata b))
    -> Sources -> Identity Sources)
-> (StoredProcedureMetadata b
    -> Identity (StoredProcedureMetadata b))
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Sources
SourceName
source ((BackendSourceMetadata -> Identity BackendSourceMetadata)
 -> Sources -> Identity Sources)
-> ((StoredProcedureMetadata b
     -> Identity (StoredProcedureMetadata b))
    -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> (StoredProcedureMetadata b
    -> Identity (StoredProcedureMetadata b))
-> Sources
-> Identity Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceMetadata b -> Identity (SourceMetadata b))
-> BackendSourceMetadata -> Identity BackendSourceMetadata
forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata ((SourceMetadata b -> Identity (SourceMetadata b))
 -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> ((StoredProcedureMetadata b
     -> Identity (StoredProcedureMetadata b))
    -> SourceMetadata b -> Identity (SourceMetadata b))
-> (StoredProcedureMetadata b
    -> Identity (StoredProcedureMetadata b))
-> BackendSourceMetadata
-> Identity BackendSourceMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
 -> Identity
      (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)))
-> SourceMetadata b -> Identity (SourceMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(StoredProcedures b -> f (StoredProcedures b))
-> SourceMetadata b -> f (SourceMetadata b)
smStoredProcedures ((InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
  -> Identity
       (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)))
 -> SourceMetadata b -> Identity (SourceMetadata b))
-> ((StoredProcedureMetadata b
     -> Identity (StoredProcedureMetadata b))
    -> InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
    -> Identity
         (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)))
-> (StoredProcedureMetadata b
    -> Identity (StoredProcedureMetadata b))
-> SourceMetadata b
-> Identity (SourceMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b))
-> Traversal'
     (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b))
     (IxValue
        (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b))
FunctionName b
storedProcedureName

-- | A simple monad class which enables fetching and setting @'Metadata'
-- in the state.
class (Monad m) => MetadataM m where
  getMetadata :: m Metadata
  putMetadata :: Metadata -> m ()

instance (MetadataM m) => MetadataM (ReaderT r m) where
  getMetadata :: ReaderT r m Metadata
getMetadata = m Metadata -> ReaderT r m Metadata
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  putMetadata :: Metadata -> ReaderT r m ()
putMetadata = m () -> ReaderT r m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ())
-> (Metadata -> m ()) -> Metadata -> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> m ()
forall (m :: * -> *). MetadataM m => Metadata -> m ()
putMetadata

instance (MetadataM m) => MetadataM (StateT r m) where
  getMetadata :: StateT r m Metadata
getMetadata = m Metadata -> StateT r m Metadata
forall (m :: * -> *) a. Monad m => m a -> StateT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  putMetadata :: Metadata -> StateT r m ()
putMetadata = m () -> StateT r m ()
forall (m :: * -> *) a. Monad m => m a -> StateT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT r m ())
-> (Metadata -> m ()) -> Metadata -> StateT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> m ()
forall (m :: * -> *). MetadataM m => Metadata -> m ()
putMetadata

instance (MetadataM m) => MetadataM (TraceT m) where
  getMetadata :: TraceT m Metadata
getMetadata = m Metadata -> TraceT m Metadata
forall (m :: * -> *) a. Monad m => m a -> TraceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  putMetadata :: Metadata -> TraceT m ()
putMetadata = m () -> TraceT m ()
forall (m :: * -> *) a. Monad m => m a -> TraceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> TraceT m ())
-> (Metadata -> m ()) -> Metadata -> TraceT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> m ()
forall (m :: * -> *). MetadataM m => Metadata -> m ()
putMetadata

data MetadataNoSources = MetadataNoSources
  { MetadataNoSources -> Tables ('Postgres 'Vanilla)
_mnsTables :: Tables ('Postgres 'Vanilla),
    MetadataNoSources -> Functions ('Postgres 'Vanilla)
_mnsFunctions :: Functions ('Postgres 'Vanilla),
    MetadataNoSources -> RemoteSchemas
_mnsRemoteSchemas :: RemoteSchemas,
    MetadataNoSources -> QueryCollections
_mnsQueryCollections :: QueryCollections,
    MetadataNoSources -> MetadataAllowlist
_mnsAllowlist :: MetadataAllowlist,
    MetadataNoSources -> CustomTypes
_mnsCustomTypes :: CustomTypes,
    MetadataNoSources -> Actions
_mnsActions :: Actions,
    MetadataNoSources -> CronTriggers
_mnsCronTriggers :: CronTriggers
  }
  deriving stock (MetadataNoSources -> MetadataNoSources -> Bool
(MetadataNoSources -> MetadataNoSources -> Bool)
-> (MetadataNoSources -> MetadataNoSources -> Bool)
-> Eq MetadataNoSources
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetadataNoSources -> MetadataNoSources -> Bool
== :: MetadataNoSources -> MetadataNoSources -> Bool
$c/= :: MetadataNoSources -> MetadataNoSources -> Bool
/= :: MetadataNoSources -> MetadataNoSources -> Bool
Eq, (forall x. MetadataNoSources -> Rep MetadataNoSources x)
-> (forall x. Rep MetadataNoSources x -> MetadataNoSources)
-> Generic MetadataNoSources
forall x. Rep MetadataNoSources x -> MetadataNoSources
forall x. MetadataNoSources -> Rep MetadataNoSources x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MetadataNoSources -> Rep MetadataNoSources x
from :: forall x. MetadataNoSources -> Rep MetadataNoSources x
$cto :: forall x. Rep MetadataNoSources x -> MetadataNoSources
to :: forall x. Rep MetadataNoSources x -> MetadataNoSources
Generic)

instance ToJSON MetadataNoSources where
  toJSON :: MetadataNoSources -> Value
toJSON = Options -> MetadataNoSources -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

instance FromJSON MetadataNoSources where
  parseJSON :: Value -> Parser MetadataNoSources
parseJSON = String
-> (Object -> Parser MetadataNoSources)
-> Value
-> Parser MetadataNoSources
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"MetadataNoSources" ((Object -> Parser MetadataNoSources)
 -> Value -> Parser MetadataNoSources)
-> (Object -> Parser MetadataNoSources)
-> Value
-> Parser MetadataNoSources
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    MetadataVersion
version <- Object
o Object -> Key -> Parser (Maybe MetadataVersion)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"version" Parser (Maybe MetadataVersion)
-> MetadataVersion -> Parser MetadataVersion
forall a. Parser (Maybe a) -> a -> Parser a
.!= MetadataVersion
MVVersion1
    (InsOrdHashMap QualifiedTable (TableMetadata ('Postgres 'Vanilla))
tables, InsOrdHashMap
  QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla))
functions) <-
      case MetadataVersion
version of
        MetadataVersion
MVVersion1 -> do
          InsOrdHashMap QualifiedTable (TableMetadata ('Postgres 'Vanilla))
tables <- (TableMetadata ('Postgres 'Vanilla) -> QualifiedTable)
-> [TableMetadata ('Postgres 'Vanilla)]
-> InsOrdHashMap
     QualifiedTable (TableMetadata ('Postgres 'Vanilla))
forall k a. Hashable k => (a -> k) -> [a] -> InsOrdHashMap k a
oMapFromL TableMetadata ('Postgres 'Vanilla)
-> TableName ('Postgres 'Vanilla)
TableMetadata ('Postgres 'Vanilla) -> QualifiedTable
forall (b :: BackendType). TableMetadata b -> TableName b
_tmTable ([TableMetadata ('Postgres 'Vanilla)]
 -> InsOrdHashMap
      QualifiedTable (TableMetadata ('Postgres 'Vanilla)))
-> Parser [TableMetadata ('Postgres 'Vanilla)]
-> Parser
     (InsOrdHashMap QualifiedTable (TableMetadata ('Postgres 'Vanilla)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [TableMetadata ('Postgres 'Vanilla)]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tables"
          [QualifiedFunction]
functionList <- Object
o Object -> Key -> Parser (Maybe [QualifiedFunction])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"functions" Parser (Maybe [QualifiedFunction])
-> [QualifiedFunction] -> Parser [QualifiedFunction]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
          let functions :: InsOrdHashMap
  QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla))
functions = [(QualifiedFunction, FunctionMetadata ('Postgres 'Vanilla))]
-> InsOrdHashMap
     QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla))
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList
                ([(QualifiedFunction, FunctionMetadata ('Postgres 'Vanilla))]
 -> InsOrdHashMap
      QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla)))
-> [(QualifiedFunction, FunctionMetadata ('Postgres 'Vanilla))]
-> InsOrdHashMap
     QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ ((QualifiedFunction
  -> (QualifiedFunction, FunctionMetadata ('Postgres 'Vanilla)))
 -> [QualifiedFunction]
 -> [(QualifiedFunction, FunctionMetadata ('Postgres 'Vanilla))])
-> [QualifiedFunction]
-> (QualifiedFunction
    -> (QualifiedFunction, FunctionMetadata ('Postgres 'Vanilla)))
-> [(QualifiedFunction, FunctionMetadata ('Postgres 'Vanilla))]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (QualifiedFunction
 -> (QualifiedFunction, FunctionMetadata ('Postgres 'Vanilla)))
-> [QualifiedFunction]
-> [(QualifiedFunction, FunctionMetadata ('Postgres 'Vanilla))]
forall a b. (a -> b) -> [a] -> [b]
map [QualifiedFunction]
functionList
                ((QualifiedFunction
  -> (QualifiedFunction, FunctionMetadata ('Postgres 'Vanilla)))
 -> [(QualifiedFunction, FunctionMetadata ('Postgres 'Vanilla))])
-> (QualifiedFunction
    -> (QualifiedFunction, FunctionMetadata ('Postgres 'Vanilla)))
-> [(QualifiedFunction, FunctionMetadata ('Postgres 'Vanilla))]
forall a b. (a -> b) -> a -> b
$ \QualifiedFunction
function -> (QualifiedFunction
function, FunctionName ('Postgres 'Vanilla)
-> FunctionConfig ('Postgres 'Vanilla)
-> [FunctionPermissionInfo]
-> Maybe Text
-> FunctionMetadata ('Postgres 'Vanilla)
forall (b :: BackendType).
FunctionName b
-> FunctionConfig b
-> [FunctionPermissionInfo]
-> Maybe Text
-> FunctionMetadata b
FunctionMetadata FunctionName ('Postgres 'Vanilla)
QualifiedFunction
function FunctionConfig ('Postgres 'Vanilla)
forall (b :: BackendType). FunctionConfig b
emptyFunctionConfig [FunctionPermissionInfo]
forall a. Monoid a => a
mempty Maybe Text
forall a. Maybe a
Nothing)
          (InsOrdHashMap QualifiedTable (TableMetadata ('Postgres 'Vanilla)),
 InsOrdHashMap
   QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla)))
-> Parser
     (InsOrdHashMap QualifiedTable (TableMetadata ('Postgres 'Vanilla)),
      InsOrdHashMap
        QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla)))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InsOrdHashMap QualifiedTable (TableMetadata ('Postgres 'Vanilla))
tables, InsOrdHashMap
  QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla))
functions)
        MetadataVersion
MVVersion2 -> do
          InsOrdHashMap QualifiedTable (TableMetadata ('Postgres 'Vanilla))
tables <- (TableMetadata ('Postgres 'Vanilla) -> QualifiedTable)
-> [TableMetadata ('Postgres 'Vanilla)]
-> InsOrdHashMap
     QualifiedTable (TableMetadata ('Postgres 'Vanilla))
forall k a. Hashable k => (a -> k) -> [a] -> InsOrdHashMap k a
oMapFromL TableMetadata ('Postgres 'Vanilla)
-> TableName ('Postgres 'Vanilla)
TableMetadata ('Postgres 'Vanilla) -> QualifiedTable
forall (b :: BackendType). TableMetadata b -> TableName b
_tmTable ([TableMetadata ('Postgres 'Vanilla)]
 -> InsOrdHashMap
      QualifiedTable (TableMetadata ('Postgres 'Vanilla)))
-> Parser [TableMetadata ('Postgres 'Vanilla)]
-> Parser
     (InsOrdHashMap QualifiedTable (TableMetadata ('Postgres 'Vanilla)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [TableMetadata ('Postgres 'Vanilla)]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tables"
          InsOrdHashMap
  QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla))
functions <- (FunctionMetadata ('Postgres 'Vanilla) -> QualifiedFunction)
-> [FunctionMetadata ('Postgres 'Vanilla)]
-> InsOrdHashMap
     QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla))
forall k a. Hashable k => (a -> k) -> [a] -> InsOrdHashMap k a
oMapFromL FunctionMetadata ('Postgres 'Vanilla)
-> FunctionName ('Postgres 'Vanilla)
FunctionMetadata ('Postgres 'Vanilla) -> QualifiedFunction
forall (b :: BackendType). FunctionMetadata b -> FunctionName b
_fmFunction ([FunctionMetadata ('Postgres 'Vanilla)]
 -> InsOrdHashMap
      QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla)))
-> Parser [FunctionMetadata ('Postgres 'Vanilla)]
-> Parser
     (InsOrdHashMap
        QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object
-> Key -> Parser (Maybe [FunctionMetadata ('Postgres 'Vanilla)])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"functions" Parser (Maybe [FunctionMetadata ('Postgres 'Vanilla)])
-> [FunctionMetadata ('Postgres 'Vanilla)]
-> Parser [FunctionMetadata ('Postgres 'Vanilla)]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
          (InsOrdHashMap QualifiedTable (TableMetadata ('Postgres 'Vanilla)),
 InsOrdHashMap
   QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla)))
-> Parser
     (InsOrdHashMap QualifiedTable (TableMetadata ('Postgres 'Vanilla)),
      InsOrdHashMap
        QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla)))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InsOrdHashMap QualifiedTable (TableMetadata ('Postgres 'Vanilla))
tables, InsOrdHashMap
  QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla))
functions)
        MetadataVersion
MVVersion3 -> String
-> Parser
     (InsOrdHashMap QualifiedTable (TableMetadata ('Postgres 'Vanilla)),
      InsOrdHashMap
        QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla)))
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unexpected version for metadata without sources: 3"
    ( RemoteSchemas
remoteSchemas,
      QueryCollections
queryCollections,
      MetadataAllowlist
allowlist,
      CustomTypes
customTypes,
      Actions
actions,
      CronTriggers
cronTriggers,
      ApiLimit
_,
      MetricsConfig
_,
      InheritedRoles
_,
      SetGraphqlIntrospectionOptions
_
      ) <-
      Object
-> Parser
     (RemoteSchemas, QueryCollections, MetadataAllowlist, CustomTypes,
      Actions, CronTriggers, ApiLimit, MetricsConfig, InheritedRoles,
      SetGraphqlIntrospectionOptions)
parseNonSourcesMetadata Object
o
    MetadataNoSources -> Parser MetadataNoSources
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (MetadataNoSources -> Parser MetadataNoSources)
-> MetadataNoSources -> Parser MetadataNoSources
forall a b. (a -> b) -> a -> b
$ Tables ('Postgres 'Vanilla)
-> Functions ('Postgres 'Vanilla)
-> RemoteSchemas
-> QueryCollections
-> MetadataAllowlist
-> CustomTypes
-> Actions
-> CronTriggers
-> MetadataNoSources
MetadataNoSources
        Tables ('Postgres 'Vanilla)
InsOrdHashMap QualifiedTable (TableMetadata ('Postgres 'Vanilla))
tables
        Functions ('Postgres 'Vanilla)
InsOrdHashMap
  QualifiedFunction (FunctionMetadata ('Postgres 'Vanilla))
functions
        RemoteSchemas
remoteSchemas
        QueryCollections
queryCollections
        MetadataAllowlist
allowlist
        CustomTypes
customTypes
        Actions
actions
        CronTriggers
cronTriggers

newtype MetadataModifier = MetadataModifier {MetadataModifier -> Metadata -> Metadata
runMetadataModifier :: Metadata -> Metadata}
  deriving (NonEmpty MetadataModifier -> MetadataModifier
MetadataModifier -> MetadataModifier -> MetadataModifier
(MetadataModifier -> MetadataModifier -> MetadataModifier)
-> (NonEmpty MetadataModifier -> MetadataModifier)
-> (forall b.
    Integral b =>
    b -> MetadataModifier -> MetadataModifier)
-> Semigroup MetadataModifier
forall b. Integral b => b -> MetadataModifier -> MetadataModifier
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: MetadataModifier -> MetadataModifier -> MetadataModifier
<> :: MetadataModifier -> MetadataModifier -> MetadataModifier
$csconcat :: NonEmpty MetadataModifier -> MetadataModifier
sconcat :: NonEmpty MetadataModifier -> MetadataModifier
$cstimes :: forall b. Integral b => b -> MetadataModifier -> MetadataModifier
stimes :: forall b. Integral b => b -> MetadataModifier -> MetadataModifier
Semigroup, Semigroup MetadataModifier
MetadataModifier
Semigroup MetadataModifier
-> MetadataModifier
-> (MetadataModifier -> MetadataModifier -> MetadataModifier)
-> ([MetadataModifier] -> MetadataModifier)
-> Monoid MetadataModifier
[MetadataModifier] -> MetadataModifier
MetadataModifier -> MetadataModifier -> MetadataModifier
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: MetadataModifier
mempty :: MetadataModifier
$cmappend :: MetadataModifier -> MetadataModifier -> MetadataModifier
mappend :: MetadataModifier -> MetadataModifier -> MetadataModifier
$cmconcat :: [MetadataModifier] -> MetadataModifier
mconcat :: [MetadataModifier] -> MetadataModifier
Monoid) via (Dual (Endo Metadata))

dropTableInMetadata ::
  forall b. (Backend b) => SourceName -> TableName b -> MetadataModifier
dropTableInMetadata :: forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> MetadataModifier
dropTableInMetadata SourceName
source TableName b
table =
  (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (Sources -> Identity Sources) -> Metadata -> Identity Metadata
Lens' Metadata Sources
metaSources ((Sources -> Identity Sources) -> Metadata -> Identity Metadata)
-> ((InsOrdHashMap (TableName b) (TableMetadata b)
     -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
    -> Sources -> Identity Sources)
-> (InsOrdHashMap (TableName b) (TableMetadata b)
    -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Sources
SourceName
source ((BackendSourceMetadata -> Identity BackendSourceMetadata)
 -> Sources -> Identity Sources)
-> ((InsOrdHashMap (TableName b) (TableMetadata b)
     -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
    -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> (InsOrdHashMap (TableName b) (TableMetadata b)
    -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
-> Sources
-> Identity Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata @b) ((SourceMetadata b -> Identity (SourceMetadata b))
 -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> ((InsOrdHashMap (TableName b) (TableMetadata b)
     -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
    -> SourceMetadata b -> Identity (SourceMetadata b))
-> (InsOrdHashMap (TableName b) (TableMetadata b)
    -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
-> BackendSourceMetadata
-> Identity BackendSourceMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InsOrdHashMap (TableName b) (TableMetadata b)
 -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
-> SourceMetadata b -> Identity (SourceMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Tables b -> f (Tables b))
-> SourceMetadata b -> f (SourceMetadata b)
smTables ((InsOrdHashMap (TableName b) (TableMetadata b)
  -> Identity (InsOrdHashMap (TableName b) (TableMetadata b)))
 -> Metadata -> Identity Metadata)
-> (InsOrdHashMap (TableName b) (TableMetadata b)
    -> InsOrdHashMap (TableName b) (TableMetadata b))
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TableName b
-> InsOrdHashMap (TableName b) (TableMetadata b)
-> InsOrdHashMap (TableName b) (TableMetadata b)
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete TableName b
table

dropRelationshipInMetadata ::
  RelName -> TableMetadata b -> TableMetadata b
dropRelationshipInMetadata :: forall (b :: BackendType).
RelName -> TableMetadata b -> TableMetadata b
dropRelationshipInMetadata RelName
relName =
  -- Since the name of a relationship is unique in a table, the relationship
  -- with given name may present in either array or object relationships but
  -- not in both.
  ((Relationships (ObjRelDef b)
 -> Identity (Relationships (ObjRelDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Relationships (ObjRelDef b) -> f (Relationships (ObjRelDef b)))
-> TableMetadata b -> f (TableMetadata b)
tmObjectRelationships ((Relationships (ObjRelDef b)
  -> Identity (Relationships (ObjRelDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> (Relationships (ObjRelDef b) -> Relationships (ObjRelDef b))
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RelName
-> Relationships (ObjRelDef b) -> Relationships (ObjRelDef b)
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete RelName
relName)
    (TableMetadata b -> TableMetadata b)
-> (TableMetadata b -> TableMetadata b)
-> TableMetadata b
-> TableMetadata b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Relationships (ArrRelDef b)
 -> Identity (Relationships (ArrRelDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Relationships (ArrRelDef b) -> f (Relationships (ArrRelDef b)))
-> TableMetadata b -> f (TableMetadata b)
tmArrayRelationships ((Relationships (ArrRelDef b)
  -> Identity (Relationships (ArrRelDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> (Relationships (ArrRelDef b) -> Relationships (ArrRelDef b))
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RelName
-> Relationships (ArrRelDef b) -> Relationships (ArrRelDef b)
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete RelName
relName)

dropNativeQueryRelationshipInMetadata :: RelName -> NativeQueryMetadata b -> NativeQueryMetadata b
dropNativeQueryRelationshipInMetadata :: forall (b :: BackendType).
RelName -> NativeQueryMetadata b -> NativeQueryMetadata b
dropNativeQueryRelationshipInMetadata RelName
relName =
  (Relationships (RelDef (RelManualNativeQueryConfig b))
 -> Identity
      (Relationships (RelDef (RelManualNativeQueryConfig b))))
-> NativeQueryMetadata b -> Identity (NativeQueryMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Relationships (RelDef (RelManualNativeQueryConfig b))
 -> f (Relationships (RelDef (RelManualNativeQueryConfig b))))
-> NativeQueryMetadata b -> f (NativeQueryMetadata b)
nqmArrayRelationships ((Relationships (RelDef (RelManualNativeQueryConfig b))
  -> Identity
       (Relationships (RelDef (RelManualNativeQueryConfig b))))
 -> NativeQueryMetadata b -> Identity (NativeQueryMetadata b))
-> (Relationships (RelDef (RelManualNativeQueryConfig b))
    -> Relationships (RelDef (RelManualNativeQueryConfig b)))
-> NativeQueryMetadata b
-> NativeQueryMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RelName
-> Relationships (RelDef (RelManualNativeQueryConfig b))
-> Relationships (RelDef (RelManualNativeQueryConfig b))
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete RelName
relName

dropPermissionInMetadata ::
  RoleName -> PermType -> TableMetadata b -> TableMetadata b
dropPermissionInMetadata :: forall (b :: BackendType).
RoleName -> PermType -> TableMetadata b -> TableMetadata b
dropPermissionInMetadata RoleName
rn = \case
  PermType
PTInsert -> (Permissions (InsPermDef b)
 -> Identity (Permissions (InsPermDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Permissions (InsPermDef b) -> f (Permissions (InsPermDef b)))
-> TableMetadata b -> f (TableMetadata b)
tmInsertPermissions ((Permissions (InsPermDef b)
  -> Identity (Permissions (InsPermDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> (Permissions (InsPermDef b) -> Permissions (InsPermDef b))
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RoleName
-> Permissions (InsPermDef b) -> Permissions (InsPermDef b)
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete RoleName
rn
  PermType
PTSelect -> (Permissions (SelPermDef b)
 -> Identity (Permissions (SelPermDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Permissions (SelPermDef b) -> f (Permissions (SelPermDef b)))
-> TableMetadata b -> f (TableMetadata b)
tmSelectPermissions ((Permissions (SelPermDef b)
  -> Identity (Permissions (SelPermDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> (Permissions (SelPermDef b) -> Permissions (SelPermDef b))
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RoleName
-> Permissions (SelPermDef b) -> Permissions (SelPermDef b)
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete RoleName
rn
  PermType
PTDelete -> (Permissions (DelPermDef b)
 -> Identity (Permissions (DelPermDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Permissions (DelPermDef b) -> f (Permissions (DelPermDef b)))
-> TableMetadata b -> f (TableMetadata b)
tmDeletePermissions ((Permissions (DelPermDef b)
  -> Identity (Permissions (DelPermDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> (Permissions (DelPermDef b) -> Permissions (DelPermDef b))
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RoleName
-> Permissions (DelPermDef b) -> Permissions (DelPermDef b)
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete RoleName
rn
  PermType
PTUpdate -> (Permissions (UpdPermDef b)
 -> Identity (Permissions (UpdPermDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Permissions (UpdPermDef b) -> f (Permissions (UpdPermDef b)))
-> TableMetadata b -> f (TableMetadata b)
tmUpdatePermissions ((Permissions (UpdPermDef b)
  -> Identity (Permissions (UpdPermDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> (Permissions (UpdPermDef b) -> Permissions (UpdPermDef b))
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RoleName
-> Permissions (UpdPermDef b) -> Permissions (UpdPermDef b)
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete RoleName
rn

dropLogicalModelPermissionInMetadata ::
  RoleName -> PermType -> LogicalModelMetadata b -> LogicalModelMetadata b
dropLogicalModelPermissionInMetadata :: forall (b :: BackendType).
RoleName
-> PermType -> LogicalModelMetadata b -> LogicalModelMetadata b
dropLogicalModelPermissionInMetadata RoleName
rn = \case
  PermType
PTSelect -> (InsOrdHashMap RoleName (SelPermDef b)
 -> Identity (InsOrdHashMap RoleName (SelPermDef b)))
-> LogicalModelMetadata b -> Identity (LogicalModelMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(InsOrdHashMap RoleName (SelPermDef b)
 -> f (InsOrdHashMap RoleName (SelPermDef b)))
-> LogicalModelMetadata b -> f (LogicalModelMetadata b)
lmmSelectPermissions ((InsOrdHashMap RoleName (SelPermDef b)
  -> Identity (InsOrdHashMap RoleName (SelPermDef b)))
 -> LogicalModelMetadata b -> Identity (LogicalModelMetadata b))
-> (InsOrdHashMap RoleName (SelPermDef b)
    -> InsOrdHashMap RoleName (SelPermDef b))
-> LogicalModelMetadata b
-> LogicalModelMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RoleName
-> InsOrdHashMap RoleName (SelPermDef b)
-> InsOrdHashMap RoleName (SelPermDef b)
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete RoleName
rn
  PermType
PTInsert -> String -> LogicalModelMetadata b -> LogicalModelMetadata b
forall a. HasCallStack => String -> a
error String
"Not implemented yet"
  PermType
PTDelete -> String -> LogicalModelMetadata b -> LogicalModelMetadata b
forall a. HasCallStack => String -> a
error String
"Not implemented yet"
  PermType
PTUpdate -> String -> LogicalModelMetadata b -> LogicalModelMetadata b
forall a. HasCallStack => String -> a
error String
"Not implemented yet"

dropComputedFieldInMetadata ::
  ComputedFieldName -> TableMetadata b -> TableMetadata b
dropComputedFieldInMetadata :: forall (b :: BackendType).
ComputedFieldName -> TableMetadata b -> TableMetadata b
dropComputedFieldInMetadata ComputedFieldName
name =
  (ComputedFields b -> Identity (ComputedFields b))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(ComputedFields b -> f (ComputedFields b))
-> TableMetadata b -> f (TableMetadata b)
tmComputedFields ((ComputedFields b -> Identity (ComputedFields b))
 -> TableMetadata b -> Identity (TableMetadata b))
-> (ComputedFields b -> ComputedFields b)
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ComputedFieldName -> ComputedFields b -> ComputedFields b
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete ComputedFieldName
name

dropEventTriggerInMetadata :: TriggerName -> TableMetadata b -> TableMetadata b
dropEventTriggerInMetadata :: forall (b :: BackendType).
TriggerName -> TableMetadata b -> TableMetadata b
dropEventTriggerInMetadata TriggerName
name =
  (EventTriggers b -> Identity (EventTriggers b))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(EventTriggers b -> f (EventTriggers b))
-> TableMetadata b -> f (TableMetadata b)
tmEventTriggers ((EventTriggers b -> Identity (EventTriggers b))
 -> TableMetadata b -> Identity (TableMetadata b))
-> (EventTriggers b -> EventTriggers b)
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TriggerName -> EventTriggers b -> EventTriggers b
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete TriggerName
name

dropRemoteRelationshipInMetadata ::
  RelName -> TableMetadata b -> TableMetadata b
dropRemoteRelationshipInMetadata :: forall (b :: BackendType).
RelName -> TableMetadata b -> TableMetadata b
dropRemoteRelationshipInMetadata RelName
name =
  (RemoteRelationships -> Identity RemoteRelationships)
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(RemoteRelationships -> f RemoteRelationships)
-> TableMetadata b -> f (TableMetadata b)
tmRemoteRelationships ((RemoteRelationships -> Identity RemoteRelationships)
 -> TableMetadata b -> Identity (TableMetadata b))
-> (RemoteRelationships -> RemoteRelationships)
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RelName -> RemoteRelationships -> RemoteRelationships
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete RelName
name

dropFunctionInMetadata ::
  forall b. (Backend b) => SourceName -> FunctionName b -> MetadataModifier
dropFunctionInMetadata :: forall (b :: BackendType).
Backend b =>
SourceName -> FunctionName b -> MetadataModifier
dropFunctionInMetadata SourceName
source FunctionName b
function =
  (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (Sources -> Identity Sources) -> Metadata -> Identity Metadata
Lens' Metadata Sources
metaSources
    ((Sources -> Identity Sources) -> Metadata -> Identity Metadata)
-> ((InsOrdHashMap (FunctionName b) (FunctionMetadata b)
     -> Identity (InsOrdHashMap (FunctionName b) (FunctionMetadata b)))
    -> Sources -> Identity Sources)
-> (InsOrdHashMap (FunctionName b) (FunctionMetadata b)
    -> Identity (InsOrdHashMap (FunctionName b) (FunctionMetadata b)))
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Sources
SourceName
source
    ((BackendSourceMetadata -> Identity BackendSourceMetadata)
 -> Sources -> Identity Sources)
-> ((InsOrdHashMap (FunctionName b) (FunctionMetadata b)
     -> Identity (InsOrdHashMap (FunctionName b) (FunctionMetadata b)))
    -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> (InsOrdHashMap (FunctionName b) (FunctionMetadata b)
    -> Identity (InsOrdHashMap (FunctionName b) (FunctionMetadata b)))
-> Sources
-> Identity Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceMetadata b -> Identity (SourceMetadata b))
-> BackendSourceMetadata -> Identity BackendSourceMetadata
forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata
    ((SourceMetadata b -> Identity (SourceMetadata b))
 -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> ((InsOrdHashMap (FunctionName b) (FunctionMetadata b)
     -> Identity (InsOrdHashMap (FunctionName b) (FunctionMetadata b)))
    -> SourceMetadata b -> Identity (SourceMetadata b))
-> (InsOrdHashMap (FunctionName b) (FunctionMetadata b)
    -> Identity (InsOrdHashMap (FunctionName b) (FunctionMetadata b)))
-> BackendSourceMetadata
-> Identity BackendSourceMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Functions b -> f (Functions b))
-> SourceMetadata b -> f (SourceMetadata b)
smFunctions @b)
    ((InsOrdHashMap (FunctionName b) (FunctionMetadata b)
  -> Identity (InsOrdHashMap (FunctionName b) (FunctionMetadata b)))
 -> Metadata -> Identity Metadata)
-> (InsOrdHashMap (FunctionName b) (FunctionMetadata b)
    -> InsOrdHashMap (FunctionName b) (FunctionMetadata b))
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ FunctionName b
-> InsOrdHashMap (FunctionName b) (FunctionMetadata b)
-> InsOrdHashMap (FunctionName b) (FunctionMetadata b)
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete FunctionName b
function

dropRemoteSchemaInMetadata :: RemoteSchemaName -> MetadataModifier
dropRemoteSchemaInMetadata :: RemoteSchemaName -> MetadataModifier
dropRemoteSchemaInMetadata RemoteSchemaName
name =
  (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (RemoteSchemas -> Identity RemoteSchemas)
-> Metadata -> Identity Metadata
Lens' Metadata RemoteSchemas
metaRemoteSchemas ((RemoteSchemas -> Identity RemoteSchemas)
 -> Metadata -> Identity Metadata)
-> (RemoteSchemas -> RemoteSchemas) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RemoteSchemaName -> RemoteSchemas -> RemoteSchemas
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete RemoteSchemaName
name

dropRemoteSchemaPermissionInMetadata :: RemoteSchemaName -> RoleName -> MetadataModifier
dropRemoteSchemaPermissionInMetadata :: RemoteSchemaName -> RoleName -> MetadataModifier
dropRemoteSchemaPermissionInMetadata RemoteSchemaName
remoteSchemaName RoleName
roleName =
  (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (RemoteSchemas -> Identity RemoteSchemas)
-> Metadata -> Identity Metadata
Lens' Metadata RemoteSchemas
metaRemoteSchemas ((RemoteSchemas -> Identity RemoteSchemas)
 -> Metadata -> Identity Metadata)
-> (([RemoteSchemaPermissionMetadata]
     -> Identity [RemoteSchemaPermissionMetadata])
    -> RemoteSchemas -> Identity RemoteSchemas)
-> ([RemoteSchemaPermissionMetadata]
    -> Identity [RemoteSchemaPermissionMetadata])
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index RemoteSchemas
-> Traversal' RemoteSchemas (IxValue RemoteSchemas)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index RemoteSchemas
RemoteSchemaName
remoteSchemaName ((RemoteSchemaMetadataG RemoteRelationshipDefinition
  -> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition))
 -> RemoteSchemas -> Identity RemoteSchemas)
-> (([RemoteSchemaPermissionMetadata]
     -> Identity [RemoteSchemaPermissionMetadata])
    -> RemoteSchemaMetadataG RemoteRelationshipDefinition
    -> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition))
-> ([RemoteSchemaPermissionMetadata]
    -> Identity [RemoteSchemaPermissionMetadata])
-> RemoteSchemas
-> Identity RemoteSchemas
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([RemoteSchemaPermissionMetadata]
 -> Identity [RemoteSchemaPermissionMetadata])
-> RemoteSchemaMetadataG RemoteRelationshipDefinition
-> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition)
forall r (f :: * -> *).
Functor f =>
([RemoteSchemaPermissionMetadata]
 -> f [RemoteSchemaPermissionMetadata])
-> RemoteSchemaMetadataG r -> f (RemoteSchemaMetadataG r)
rsmPermissions (([RemoteSchemaPermissionMetadata]
  -> Identity [RemoteSchemaPermissionMetadata])
 -> Metadata -> Identity Metadata)
-> ([RemoteSchemaPermissionMetadata]
    -> [RemoteSchemaPermissionMetadata])
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (RemoteSchemaPermissionMetadata -> Bool)
-> [RemoteSchemaPermissionMetadata]
-> [RemoteSchemaPermissionMetadata]
forall a. (a -> Bool) -> [a] -> [a]
filter (RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
(/=) RoleName
roleName (RoleName -> Bool)
-> (RemoteSchemaPermissionMetadata -> RoleName)
-> RemoteSchemaPermissionMetadata
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteSchemaPermissionMetadata -> RoleName
_rspmRole)

dropRemoteSchemaRemoteRelationshipInMetadata :: RemoteSchemaName -> G.Name -> RelName -> MetadataModifier
dropRemoteSchemaRemoteRelationshipInMetadata :: RemoteSchemaName -> Name -> RelName -> MetadataModifier
dropRemoteSchemaRemoteRelationshipInMetadata RemoteSchemaName
remoteSchemaName Name
typeName RelName
relationshipName =
  (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (RemoteSchemas -> Identity RemoteSchemas)
-> Metadata -> Identity Metadata
Lens' Metadata RemoteSchemas
metaRemoteSchemas
    ((RemoteSchemas -> Identity RemoteSchemas)
 -> Metadata -> Identity Metadata)
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> RemoteSchemas -> Identity RemoteSchemas)
-> (RemoteRelationships -> Identity RemoteRelationships)
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index RemoteSchemas
-> Traversal' RemoteSchemas (IxValue RemoteSchemas)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index RemoteSchemas
RemoteSchemaName
remoteSchemaName
    ((RemoteSchemaMetadataG RemoteRelationshipDefinition
  -> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition))
 -> RemoteSchemas -> Identity RemoteSchemas)
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> RemoteSchemaMetadataG RemoteRelationshipDefinition
    -> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition))
-> (RemoteRelationships -> Identity RemoteRelationships)
-> RemoteSchemas
-> Identity RemoteSchemas
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SchemaRemoteRelationships RemoteRelationshipDefinition
 -> Identity
      (SchemaRemoteRelationships RemoteRelationshipDefinition))
-> RemoteSchemaMetadataG RemoteRelationshipDefinition
-> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition)
forall r1 r2 (f :: * -> *).
Functor f =>
(SchemaRemoteRelationships r1 -> f (SchemaRemoteRelationships r2))
-> RemoteSchemaMetadataG r1 -> f (RemoteSchemaMetadataG r2)
rsmRemoteRelationships
    ((SchemaRemoteRelationships RemoteRelationshipDefinition
  -> Identity
       (SchemaRemoteRelationships RemoteRelationshipDefinition))
 -> RemoteSchemaMetadataG RemoteRelationshipDefinition
 -> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition))
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> SchemaRemoteRelationships RemoteRelationshipDefinition
    -> Identity
         (SchemaRemoteRelationships RemoteRelationshipDefinition))
-> (RemoteRelationships -> Identity RemoteRelationships)
-> RemoteSchemaMetadataG RemoteRelationshipDefinition
-> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SchemaRemoteRelationships RemoteRelationshipDefinition)
-> Traversal'
     (SchemaRemoteRelationships RemoteRelationshipDefinition)
     (IxValue (SchemaRemoteRelationships RemoteRelationshipDefinition))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Name
Index (SchemaRemoteRelationships RemoteRelationshipDefinition)
typeName
    ((RemoteSchemaTypeRelationships RemoteRelationshipDefinition
  -> Identity
       (RemoteSchemaTypeRelationships RemoteRelationshipDefinition))
 -> SchemaRemoteRelationships RemoteRelationshipDefinition
 -> Identity
      (SchemaRemoteRelationships RemoteRelationshipDefinition))
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> RemoteSchemaTypeRelationships RemoteRelationshipDefinition
    -> Identity
         (RemoteSchemaTypeRelationships RemoteRelationshipDefinition))
-> (RemoteRelationships -> Identity RemoteRelationships)
-> SchemaRemoteRelationships RemoteRelationshipDefinition
-> Identity
     (SchemaRemoteRelationships RemoteRelationshipDefinition)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteRelationships -> Identity RemoteRelationships)
-> RemoteSchemaTypeRelationships RemoteRelationshipDefinition
-> Identity
     (RemoteSchemaTypeRelationships RemoteRelationshipDefinition)
forall r1 r2 (f :: * -> *).
Functor f =>
(RemoteRelationships r1 -> f (RemoteRelationships r2))
-> RemoteSchemaTypeRelationships r1
-> f (RemoteSchemaTypeRelationships r2)
rstrsRelationships
    ((RemoteRelationships -> Identity RemoteRelationships)
 -> Metadata -> Identity Metadata)
-> (RemoteRelationships -> RemoteRelationships)
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RelName -> RemoteRelationships -> RemoteRelationships
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete RelName
relationshipName

-- | Encode 'Metadata' to JSON with deterministic ordering (e.g. "version" being at the top).
-- The CLI system stores metadata in files and has option to show changes in git diff style.
-- The diff shouldn't appear different for no metadata changes. So, the ordering of object keys and
-- array elements should  remain consistent across versions of graphql-engine if possible.
--
-- Note: While modifying any part of the code below, make sure the encoded JSON of each type is
-- parsable via its 'FromJSON' instance.
--
-- TODO: we can use 'aeson-pretty' to serialize in a consistent way, and to specify a (partial)
-- order of keys, while getting the benefits of auto-generated To/FromJSON instances.
-- `FromJSON TableMetadata` complicates this though...
--
-- See: https://github.com/hasura/graphql-engine/issues/6348
metadataToOrdJSON :: Metadata -> AO.Value
metadataToOrdJSON :: Metadata -> Value
metadataToOrdJSON
  ( Metadata
      Sources
sources
      RemoteSchemas
remoteSchemas
      QueryCollections
queryCollections
      MetadataAllowlist
allowlist
      CustomTypes
customTypes
      Actions
actions
      CronTriggers
cronTriggers
      Endpoints
endpoints
      ApiLimit
apiLimits
      MetricsConfig
metricsConfig
      InheritedRoles
inheritedRoles
      SetGraphqlIntrospectionOptions
introspectionDisabledRoles
      Network
networkConfig
      BackendMap BackendConfigWrapper
backendConfigs
      OpenTelemetryConfig
openTelemetryConfig
    ) =
    [(Text, Value)] -> Value
AO.object
      ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [(Text, Value)
versionPair, (Text, Value)
sourcesPair]
      [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> [Maybe (Text, Value)] -> [(Text, Value)]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes
        [ Maybe (Text, Value)
remoteSchemasPair,
          Maybe (Text, Value)
queryCollectionsPair,
          Maybe (Text, Value)
allowlistPair,
          Maybe (Text, Value)
actionsPair,
          Maybe (Text, Value)
customTypesPair,
          Maybe (Text, Value)
cronTriggersPair,
          Maybe (Text, Value)
endpointsPair,
          Maybe (Text, Value)
apiLimitsPair,
          Maybe (Text, Value)
metricsConfigPair,
          Maybe (Text, Value)
inheritedRolesPair,
          Maybe (Text, Value)
introspectionDisabledRolesPair,
          Maybe (Text, Value)
networkPair,
          Maybe (Text, Value)
backendConfigsPair,
          Maybe (Text, Value)
openTelemetryConfigPair
        ]
    where
      versionPair :: (Text, Value)
versionPair = (Text
"version", MetadataVersion -> Value
forall a. ToJSON a => a -> Value
AO.toOrdered MetadataVersion
currentMetadataVersion)
      sourcesPair :: (Text, Value)
sourcesPair = (Text
"sources", Array -> Value
AO.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ Sources -> Array
sourcesToOrdJSONList Sources
sources)
      remoteSchemasPair :: Maybe (Text, Value)
remoteSchemasPair = (Text
"remote_schemas",) (Value -> (Text, Value))
-> (Array -> Value) -> Array -> (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Value
AO.Array (Array -> (Text, Value)) -> Maybe Array -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RemoteSchemas -> Maybe Array
remoteSchemasToOrdJSONList RemoteSchemas
remoteSchemas
      queryCollectionsPair :: Maybe (Text, Value)
queryCollectionsPair = (Text
"query_collections",) (Value -> (Text, Value))
-> (Array -> Value) -> Array -> (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Value
AO.Array (Array -> (Text, Value)) -> Maybe Array -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryCollections -> Maybe Array
queryCollectionsToOrdJSONList QueryCollections
queryCollections
      allowlistPair :: Maybe (Text, Value)
allowlistPair = (Text
"allowlist",) (Value -> (Text, Value))
-> (Array -> Value) -> Array -> (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Value
AO.Array (Array -> (Text, Value)) -> Maybe Array -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MetadataAllowlist -> Maybe Array
allowlistToOrdJSONList MetadataAllowlist
allowlist
      customTypesPair :: Maybe (Text, Value)
customTypesPair = (Text
"custom_types",) (Value -> (Text, Value))
-> (Object -> Value) -> Object -> (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Value
AO.Object (Object -> (Text, Value)) -> Maybe Object -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CustomTypes -> Maybe Object
customTypesToOrdJSON CustomTypes
customTypes
      actionsPair :: Maybe (Text, Value)
actionsPair = (Text
"actions",) (Value -> (Text, Value))
-> (Array -> Value) -> Array -> (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Value
AO.Array (Array -> (Text, Value)) -> Maybe Array -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Actions -> Maybe Array
actionMetadataToOrdJSONList Actions
actions
      cronTriggersPair :: Maybe (Text, Value)
cronTriggersPair = (Text
"cron_triggers",) (Value -> (Text, Value))
-> (Array -> Value) -> Array -> (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Value
AO.Array (Array -> (Text, Value)) -> Maybe Array -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CronTriggers -> Maybe Array
cronTriggersToOrdJSONList CronTriggers
cronTriggers
      inheritedRolesPair :: Maybe (Text, Value)
inheritedRolesPair = (Text
"inherited_roles",) (Value -> (Text, Value))
-> (Array -> Value) -> Array -> (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Value
AO.Array (Array -> (Text, Value)) -> Maybe Array -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InheritedRoles -> Maybe Array
inheritedRolesToOrdJSONList InheritedRoles
inheritedRoles
      endpointsPair :: Maybe (Text, Value)
endpointsPair = (Text
"rest_endpoints",) (Value -> (Text, Value))
-> (Array -> Value) -> Array -> (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> Value
AO.Array (Array -> (Text, Value)) -> Maybe Array -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Endpoints -> Maybe Array
endpointsToOrdJSONList Endpoints
endpoints
      apiLimitsPair :: Maybe (Text, Value)
apiLimitsPair = (Text
"api_limits",) (Value -> (Text, Value)) -> Maybe Value -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiLimit -> Maybe Value
apiLimitsToOrdJSON ApiLimit
apiLimits
      metricsConfigPair :: Maybe (Text, Value)
metricsConfigPair = (Text
"metrics_config",) (Value -> (Text, Value)) -> Maybe Value -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MetricsConfig -> Maybe Value
metricsConfigToOrdJSON MetricsConfig
metricsConfig
      introspectionDisabledRolesPair :: Maybe (Text, Value)
introspectionDisabledRolesPair =
        (Text
"graphql_schema_introspection",) (Value -> (Text, Value)) -> Maybe Value -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SetGraphqlIntrospectionOptions -> Maybe Value
introspectionDisabledRolesToOrdJSON SetGraphqlIntrospectionOptions
introspectionDisabledRoles
      networkPair :: Maybe (Text, Value)
networkPair = (Text
"network",) (Value -> (Text, Value)) -> Maybe Value -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Maybe Value
networkConfigToOrdJSON Network
networkConfig
      backendConfigsPair :: Maybe (Text, Value)
backendConfigsPair = (Text
"backend_configs",) (Value -> (Text, Value)) -> Maybe Value -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackendMap BackendConfigWrapper -> Maybe Value
backendConfigsToOrdJSON BackendMap BackendConfigWrapper
backendConfigs
      openTelemetryConfigPair :: Maybe (Text, Value)
openTelemetryConfigPair = (Text
"opentelemetry",) (Value -> (Text, Value)) -> Maybe Value -> Maybe (Text, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpenTelemetryConfig -> Maybe Value
openTelemetryConfigToOrdJSON OpenTelemetryConfig
openTelemetryConfig

instance ToJSON Metadata where
  toJSON :: Metadata -> Value
toJSON = Value -> Value
AO.fromOrdered (Value -> Value) -> (Metadata -> Value) -> Metadata -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> Value
metadataToOrdJSON

instance ToJSON MetadataDefaults where
  toJSON :: MetadataDefaults -> Value
toJSON (MetadataDefaults Metadata
m) = Metadata -> Value
forall a. ToJSON a => a -> Value
toJSON Metadata
m

-- | Convert 'Metadata' to a DTO for serialization. In the near future the plan
-- is to use this function instead of the 'ToJSON' instance of 'Metadata'.
-- For the time being DTO serialization does not match the same order of object
-- keys as the 'ToJSON' instance - we can't switch to using this function until
-- that issue is resolved. See https://hasurahq.atlassian.net/browse/MM-29
metadataToDTO :: Metadata -> MetadataV3
metadataToDTO :: Metadata -> MetadataV3
metadataToDTO
  ( Metadata
      Sources
sources
      RemoteSchemas
remoteSchemas
      QueryCollections
queryCollections
      MetadataAllowlist
allowlist
      CustomTypes
customTypes
      Actions
actions
      CronTriggers
cronTriggers
      Endpoints
endpoints
      ApiLimit
apiLimits
      MetricsConfig
metricsConfig
      InheritedRoles
inheritedRoles
      SetGraphqlIntrospectionOptions
introspectionDisabledRoles
      Network
networkConfig
      BackendMap BackendConfigWrapper
backendConfigs
      OpenTelemetryConfig
openTelemetryConfig
    ) =
    MetadataV3
      { metaV3Sources :: Sources
metaV3Sources = Sources
sources,
        metaV3RemoteSchemas :: RemoteSchemas
metaV3RemoteSchemas = RemoteSchemas
remoteSchemas,
        metaV3QueryCollections :: QueryCollections
metaV3QueryCollections = QueryCollections
queryCollections,
        metaV3Allowlist :: MetadataAllowlist
metaV3Allowlist = MetadataAllowlist
allowlist,
        metaV3Actions :: Actions
metaV3Actions = Actions
actions,
        metaV3CustomTypes :: CustomTypes
metaV3CustomTypes = CustomTypes
customTypes,
        metaV3CronTriggers :: CronTriggers
metaV3CronTriggers = CronTriggers
cronTriggers,
        metaV3RestEndpoints :: Endpoints
metaV3RestEndpoints = Endpoints
endpoints,
        metaV3ApiLimits :: ApiLimit
metaV3ApiLimits = ApiLimit
apiLimits,
        metaV3MetricsConfig :: MetricsConfig
metaV3MetricsConfig = MetricsConfig
metricsConfig,
        metaV3InheritedRoles :: InheritedRoles
metaV3InheritedRoles = InheritedRoles
inheritedRoles,
        metaV3GraphqlSchemaIntrospection :: SetGraphqlIntrospectionOptions
metaV3GraphqlSchemaIntrospection = SetGraphqlIntrospectionOptions
introspectionDisabledRoles,
        metaV3Network :: Network
metaV3Network = Network
networkConfig,
        metaV3BackendConfigs :: BackendMap BackendConfigWrapper
metaV3BackendConfigs = BackendMap BackendConfigWrapper
backendConfigs,
        metaV3OpenTelemetryConfig :: OpenTelemetryConfig
metaV3OpenTelemetryConfig = OpenTelemetryConfig
openTelemetryConfig
      }