{-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Top-level functions concerned specifically with operations on the schema cache, such as
-- rebuilding it from the catalog and incorporating schema changes. See the module documentation for
-- "Hasura.RQL.DDL.Schema" for more details.
--
-- __Note__: this module is __mutually recursive__ with other @Hasura.RQL.DDL.Schema.*@ modules, which
-- both define pieces of the implementation of building the schema cache and define handlers that
-- trigger schema cache rebuilds.
module Hasura.RQL.DDL.Schema.Cache
  ( RebuildableSchemaCache,
    lastBuiltSchemaCache,
    buildRebuildableSchemaCache,
    CacheRWT,
    runCacheRWT,
    mkBooleanPermissionMap,
    saveSourcesIntrospection,
  )
where

import Control.Arrow.Extended
import Control.Arrow.Interpret
import Control.Lens hiding ((.=))
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Retry qualified as Retry
import Data.Aeson
import Data.ByteString.Lazy qualified as LBS
import Data.Either (isLeft)
import Data.Environment qualified as Env
import Data.Has
import Data.HashMap.Strict.Extended qualified as HashMap
import Data.HashMap.Strict.InsOrd.Extended qualified as InsOrdHashMap
import Data.HashSet qualified as HS
import Data.Proxy
import Data.Sequence qualified as Seq
import Data.Set qualified as S
import Data.Text qualified as T
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Eventing.Backend
import Hasura.Function.API
import Hasura.Function.Cache
import Hasura.Function.Metadata (FunctionMetadata (..))
import Hasura.GraphQL.Schema (buildGQLContext)
import Hasura.Incremental qualified as Inc
import Hasura.Logging
import Hasura.LogicalModel.Cache (LogicalModelCache, LogicalModelInfo (..))
import Hasura.LogicalModel.Metadata (LogicalModelMetadata (..))
import Hasura.LogicalModel.Types (LogicalModelField (..), LogicalModelName (..), LogicalModelType (..), LogicalModelTypeArray (..), LogicalModelTypeReference (..))
import Hasura.LogicalModelResolver.Metadata (InlineLogicalModelMetadata (..), LogicalModelIdentifier (..))
import Hasura.Metadata.Class
import Hasura.NativeQuery.Cache (NativeQueryCache, NativeQueryInfo (..))
import Hasura.NativeQuery.Metadata (NativeQueryMetadata (..), getNativeQueryName)
import Hasura.Prelude
import Hasura.QueryTags
import Hasura.RQL.DDL.Action
import Hasura.RQL.DDL.CustomTypes
import Hasura.RQL.DDL.EventTrigger (MonadEventLogCleanup (..), buildEventTriggerInfo)
import Hasura.RQL.DDL.InheritedRoles (resolveInheritedRole)
import Hasura.RQL.DDL.OpenTelemetry (parseOtelBatchSpanProcessorConfig, parseOtelExporterConfig)
import Hasura.RQL.DDL.Relationship
import Hasura.RQL.DDL.RemoteRelationship (CreateRemoteSchemaRemoteRelationship (..), PartiallyResolvedSource (..), buildRemoteFieldInfo, getRemoteSchemaEntityJoinColumns)
import Hasura.RQL.DDL.ScheduledTrigger
import Hasura.RQL.DDL.Schema.Cache.Common
import Hasura.RQL.DDL.Schema.Cache.Config
import Hasura.RQL.DDL.Schema.Cache.Dependencies
import Hasura.RQL.DDL.Schema.Cache.Fields
import Hasura.RQL.DDL.Schema.Cache.Permission
import Hasura.RQL.DDL.SchemaRegistry
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.Allowlist
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendTag
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.CustomTypes
import Hasura.RQL.Types.Endpoint
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.NamingCase
import Hasura.RQL.Types.OpenTelemetry
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.Relationships.Remote
import Hasura.RQL.Types.Roles
import Hasura.RQL.Types.ScheduledTrigger
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.SchemaCache.Instances ()
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.SourceCustomization
import Hasura.RemoteSchema.Metadata
import Hasura.RemoteSchema.SchemaCache
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.BackendMap (BackendMap)
import Hasura.SQL.BackendMap qualified as BackendMap
import Hasura.Server.Init.FeatureFlag qualified as FF
import Hasura.Server.Migrate.Version
import Hasura.Server.Types
import Hasura.Services
import Hasura.Session
import Hasura.StoredProcedure.Cache (StoredProcedureCache, StoredProcedureInfo (..))
import Hasura.StoredProcedure.Metadata (StoredProcedureMetadata (..))
import Hasura.Table.API
import Hasura.Table.Cache
import Hasura.Table.Metadata (TableMetadata (..))
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Syntax qualified as G
import Network.Types.Extended

{- Note [Roles Inheritance]
~~~~~~~~~~~~~~~~~~~~~~~~~~~

Roles may have parent roles defined from which they can inherit permission and this is
called as roles inheritance. Roles which have parents can also be parents of other roles.
So, cycle in roles should be disallowed and this is done in the `orderRoles` function.

When the metadata contains a permission for a role for a entity, then it will override the
inherited permission, if any.

Roles inheritance work differently for different features:

1. Select permissions
~~~~~~~~~~~~~~~~~~~~~

See note [Inherited roles architecture for read queries]

2. Mutation permissions and remote schema permissions
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

For mutation and remote schema permissions, an inherited role can only inherit permission
from its parent roles when the relevant parts of the permissions are equal i.e. the non-relevant
parts are discarded for the equality, for example, in two remote schema permissions the order
of the fields in an Object type is discarded.

When an inherited role cannot inherit permission from its parents due to a conflict, then we mark
the inherited role and the entity (remote schema or table) combination as inconsistent in the metadata.

3. Actions and Custom function permissions
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Currently, actions and custom function permissions can be thought of as a boolean. Either a role has
permission to the entity or it doesn't, so in these cases there's no possiblity of a conflict. An inherited
role will have access to the action/function if any one of the parents have permission to access the
action/function.

-}

buildRebuildableSchemaCache ::
  Logger Hasura ->
  Env.Environment ->
  MetadataWithResourceVersion ->
  CacheDynamicConfig ->
  Maybe SchemaRegistryContext ->
  CacheBuild RebuildableSchemaCache
buildRebuildableSchemaCache :: Logger Hasura
-> Environment
-> MetadataWithResourceVersion
-> CacheDynamicConfig
-> Maybe SchemaRegistryContext
-> CacheBuild RebuildableSchemaCache
buildRebuildableSchemaCache Logger Hasura
logger Environment
env MetadataWithResourceVersion
metadataWithVersion CacheDynamicConfig
dynamicConfig Maybe SchemaRegistryContext
mSchemaRegistryContext = do
  Result
  (ReaderT BuildReason CacheBuild)
  (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
   Maybe StoredIntrospection)
  (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
result <-
    (ReaderT
   BuildReason
   CacheBuild
   (Result
      (ReaderT BuildReason CacheBuild)
      (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
       Maybe StoredIntrospection)
      (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
 -> BuildReason
 -> CacheBuild
      (Result
         (ReaderT BuildReason CacheBuild)
         (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
          Maybe StoredIntrospection)
         (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))))
-> BuildReason
-> ReaderT
     BuildReason
     CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
         Maybe StoredIntrospection)
        (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
-> CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
         Maybe StoredIntrospection)
        (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  BuildReason
  CacheBuild
  (Result
     (ReaderT BuildReason CacheBuild)
     (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
      Maybe StoredIntrospection)
     (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
-> BuildReason
-> CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
         Maybe StoredIntrospection)
        (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT BuildReason
CatalogSync
      (ReaderT
   BuildReason
   CacheBuild
   (Result
      (ReaderT BuildReason CacheBuild)
      (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
       Maybe StoredIntrospection)
      (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
 -> CacheBuild
      (Result
         (ReaderT BuildReason CacheBuild)
         (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
          Maybe StoredIntrospection)
         (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))))
-> ReaderT
     BuildReason
     CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
         Maybe StoredIntrospection)
        (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
-> CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
         Maybe StoredIntrospection)
        (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
forall a b. (a -> b) -> a -> b
$ Rule
  (ReaderT BuildReason CacheBuild)
  (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
   Maybe StoredIntrospection)
  (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
-> (MetadataWithResourceVersion, CacheDynamicConfig,
    InvalidationKeys, Maybe StoredIntrospection)
-> ReaderT
     BuildReason
     CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
         Maybe StoredIntrospection)
        (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
forall (m :: * -> *) a b.
Applicative m =>
Rule m a b -> a -> m (Result m a b)
Inc.build (Logger Hasura
-> Environment
-> Maybe SchemaRegistryContext
-> Rule
     (ReaderT BuildReason CacheBuild)
     (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
      Maybe StoredIntrospection)
     (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowDistribute arr, ArrowCache m arr, MonadIO m,
 MonadBaseControl IO m, MonadError QErr m,
 MonadReader BuildReason m, ProvidesNetwork m, MonadResolveSource m,
 HasCacheStaticConfig m) =>
Logger Hasura
-> Environment
-> Maybe SchemaRegistryContext
-> arr
     (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
      Maybe StoredIntrospection)
     (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
buildSchemaCacheRule Logger Hasura
logger Environment
env Maybe SchemaRegistryContext
mSchemaRegistryContext) (MetadataWithResourceVersion
metadataWithVersion, CacheDynamicConfig
dynamicConfig, InvalidationKeys
initialInvalidationKeys, Maybe StoredIntrospection
forall a. Maybe a
Nothing)

  RebuildableSchemaCache -> CacheBuild RebuildableSchemaCache
forall a. a -> CacheBuild a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RebuildableSchemaCache -> CacheBuild RebuildableSchemaCache)
-> RebuildableSchemaCache -> CacheBuild RebuildableSchemaCache
forall a b. (a -> b) -> a -> b
$ SchemaCache
-> InvalidationKeys
-> Rule
     (ReaderT BuildReason CacheBuild)
     (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
      Maybe StoredIntrospection)
     (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
-> RebuildableSchemaCache
RebuildableSchemaCache ((SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
-> SchemaCache
forall a b. (a, b) -> a
fst ((SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
 -> SchemaCache)
-> (SchemaCache,
    (SourcesIntrospectionStatus, SchemaRegistryAction))
-> SchemaCache
forall a b. (a -> b) -> a -> b
$ Result
  (ReaderT BuildReason CacheBuild)
  (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
   Maybe StoredIntrospection)
  (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
-> (SchemaCache,
    (SourcesIntrospectionStatus, SchemaRegistryAction))
forall {k} (m :: k -> *) a b. Result m a b -> b
Inc.result Result
  (ReaderT BuildReason CacheBuild)
  (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
   Maybe StoredIntrospection)
  (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
result) InvalidationKeys
initialInvalidationKeys (Result
  (ReaderT BuildReason CacheBuild)
  (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
   Maybe StoredIntrospection)
  (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
-> Rule
     (ReaderT BuildReason CacheBuild)
     (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
      Maybe StoredIntrospection)
     (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
forall {k} (m :: k -> *) a b. Result m a b -> Rule m a b
Inc.rebuildRule Result
  (ReaderT BuildReason CacheBuild)
  (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
   Maybe StoredIntrospection)
  (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
result)

newtype CacheRWT m a
  = -- The CacheInvalidations component of the state could actually be collected
    -- using WriterT, but WriterT implementations prior to transformers-0.5.6.0
    -- (which added Control.Monad.Trans.Writer.CPS) are leaky, and we don’t have
    -- that yet.
    --
    -- The use of 'ReaderT CacheDynamicConfig' is only here to avoid manually
    -- passing the 'CacheDynamicConfig' to every function that builds the cache. It
    -- should ultimately be reduced to 'AppContext', or even better a relevant
    -- subset thereof.
    CacheRWT (ReaderT CacheDynamicConfig (StateT (RebuildableSchemaCache, CacheInvalidations, SourcesIntrospectionStatus, SchemaRegistryAction) m) a)
  deriving newtype
    ( (forall a b. (a -> b) -> CacheRWT m a -> CacheRWT m b)
-> (forall a b. a -> CacheRWT m b -> CacheRWT m a)
-> Functor (CacheRWT m)
forall a b. a -> CacheRWT m b -> CacheRWT m a
forall a b. (a -> b) -> CacheRWT m a -> CacheRWT m b
forall (m :: * -> *) a b.
Functor m =>
a -> CacheRWT m b -> CacheRWT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> CacheRWT m a -> CacheRWT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> CacheRWT m a -> CacheRWT m b
fmap :: forall a b. (a -> b) -> CacheRWT m a -> CacheRWT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> CacheRWT m b -> CacheRWT m a
<$ :: forall a b. a -> CacheRWT m b -> CacheRWT m a
Functor,
      Functor (CacheRWT m)
Functor (CacheRWT m)
-> (forall a. a -> CacheRWT m a)
-> (forall a b.
    CacheRWT m (a -> b) -> CacheRWT m a -> CacheRWT m b)
-> (forall a b c.
    (a -> b -> c) -> CacheRWT m a -> CacheRWT m b -> CacheRWT m c)
-> (forall a b. CacheRWT m a -> CacheRWT m b -> CacheRWT m b)
-> (forall a b. CacheRWT m a -> CacheRWT m b -> CacheRWT m a)
-> Applicative (CacheRWT m)
forall a. a -> CacheRWT m a
forall a b. CacheRWT m a -> CacheRWT m b -> CacheRWT m a
forall a b. CacheRWT m a -> CacheRWT m b -> CacheRWT m b
forall a b. CacheRWT m (a -> b) -> CacheRWT m a -> CacheRWT m b
forall a b c.
(a -> b -> c) -> CacheRWT m a -> CacheRWT m b -> CacheRWT m c
forall {m :: * -> *}. Monad m => Functor (CacheRWT m)
forall (m :: * -> *) a. Monad m => a -> CacheRWT m a
forall (m :: * -> *) a b.
Monad m =>
CacheRWT m a -> CacheRWT m b -> CacheRWT m a
forall (m :: * -> *) a b.
Monad m =>
CacheRWT m a -> CacheRWT m b -> CacheRWT m b
forall (m :: * -> *) a b.
Monad m =>
CacheRWT m (a -> b) -> CacheRWT m a -> CacheRWT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> CacheRWT m a -> CacheRWT m b -> CacheRWT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> CacheRWT m a
pure :: forall a. a -> CacheRWT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
CacheRWT m (a -> b) -> CacheRWT m a -> CacheRWT m b
<*> :: forall a b. CacheRWT m (a -> b) -> CacheRWT m a -> CacheRWT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> CacheRWT m a -> CacheRWT m b -> CacheRWT m c
liftA2 :: forall a b c.
(a -> b -> c) -> CacheRWT m a -> CacheRWT m b -> CacheRWT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
CacheRWT m a -> CacheRWT m b -> CacheRWT m b
*> :: forall a b. CacheRWT m a -> CacheRWT m b -> CacheRWT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
CacheRWT m a -> CacheRWT m b -> CacheRWT m a
<* :: forall a b. CacheRWT m a -> CacheRWT m b -> CacheRWT m a
Applicative,
      Applicative (CacheRWT m)
Applicative (CacheRWT m)
-> (forall a b.
    CacheRWT m a -> (a -> CacheRWT m b) -> CacheRWT m b)
-> (forall a b. CacheRWT m a -> CacheRWT m b -> CacheRWT m b)
-> (forall a. a -> CacheRWT m a)
-> Monad (CacheRWT m)
forall a. a -> CacheRWT m a
forall a b. CacheRWT m a -> CacheRWT m b -> CacheRWT m b
forall a b. CacheRWT m a -> (a -> CacheRWT m b) -> CacheRWT m b
forall (m :: * -> *). Monad m => Applicative (CacheRWT m)
forall (m :: * -> *) a. Monad m => a -> CacheRWT m a
forall (m :: * -> *) a b.
Monad m =>
CacheRWT m a -> CacheRWT m b -> CacheRWT m b
forall (m :: * -> *) a b.
Monad m =>
CacheRWT m a -> (a -> CacheRWT m b) -> CacheRWT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
CacheRWT m a -> (a -> CacheRWT m b) -> CacheRWT m b
>>= :: forall a b. CacheRWT m a -> (a -> CacheRWT m b) -> CacheRWT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
CacheRWT m a -> CacheRWT m b -> CacheRWT m b
>> :: forall a b. CacheRWT m a -> CacheRWT m b -> CacheRWT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> CacheRWT m a
return :: forall a. a -> CacheRWT m a
Monad,
      Monad (CacheRWT m)
Monad (CacheRWT m)
-> (forall a. IO a -> CacheRWT m a) -> MonadIO (CacheRWT m)
forall a. IO a -> CacheRWT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (CacheRWT m)
forall (m :: * -> *) a. MonadIO m => IO a -> CacheRWT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> CacheRWT m a
liftIO :: forall a. IO a -> CacheRWT m a
MonadIO,
      MonadError e,
      Monad (CacheRWT m)
CacheRWT m UserInfo
Monad (CacheRWT m) -> CacheRWT m UserInfo -> UserInfoM (CacheRWT m)
forall (m :: * -> *). Monad m -> m UserInfo -> UserInfoM m
forall {m :: * -> *}. UserInfoM m => Monad (CacheRWT m)
forall (m :: * -> *). UserInfoM m => CacheRWT m UserInfo
$caskUserInfo :: forall (m :: * -> *). UserInfoM m => CacheRWT m UserInfo
askUserInfo :: CacheRWT m UserInfo
UserInfoM,
      Monad (CacheRWT m)
CacheRWT m (Either QErr [ActionLogItem])
CacheRWT m (Either QErr ())
CacheRWT m (Either QErr MetadataDbId)
CacheRWT m (Either QErr CatalogState)
CacheRWT m (Either QErr MetadataWithResourceVersion)
CacheRWT m (Either QErr MetadataResourceVersion)
Monad (CacheRWT m)
-> CacheRWT m (Either QErr MetadataResourceVersion)
-> CacheRWT m (Either QErr MetadataWithResourceVersion)
-> (MetadataResourceVersion
    -> InstanceId
    -> CacheRWT
         m (Either QErr [(MetadataResourceVersion, CacheInvalidations)]))
-> (MetadataResourceVersion
    -> Metadata -> CacheRWT m (Either QErr MetadataResourceVersion))
-> (MetadataResourceVersion
    -> InstanceId -> CacheInvalidations -> CacheRWT m (Either QErr ()))
-> CacheRWT m (Either QErr CatalogState)
-> (CatalogStateType -> Value -> CacheRWT m (Either QErr ()))
-> (MetadataResourceVersion
    -> CacheRWT m (Either QErr (Maybe StoredIntrospection)))
-> (StoredIntrospection
    -> MetadataResourceVersion -> CacheRWT m (Either QErr ()))
-> CacheRWT m (Either QErr MetadataDbId)
-> CacheRWT m (Either QErr ())
-> ([TriggerName] -> CacheRWT m (Either QErr [CronTriggerStats]))
-> ([TriggerName]
    -> CacheRWT m (Either QErr ([CronEvent], [OneOffScheduledEvent])))
-> ([CronEventSeed] -> CacheRWT m (Either QErr ()))
-> (OneOffEvent -> CacheRWT m (Either QErr EventId))
-> (Invocation 'ScheduledType
    -> ScheduledEventType -> CacheRWT m (Either QErr ()))
-> (EventId
    -> ScheduledEventOp
    -> ScheduledEventType
    -> CacheRWT m (Either QErr ()))
-> (ScheduledEventType
    -> [EventId] -> CacheRWT m (Either QErr Int))
-> CacheRWT m (Either QErr ())
-> (ClearCronEvents -> CacheRWT m (Either QErr ()))
-> (ScheduledEventPagination
    -> [ScheduledEventStatus]
    -> RowsCountOption
    -> CacheRWT
         m (Either QErr (WithOptionalTotalCount [OneOffScheduledEvent])))
-> (TriggerName
    -> ScheduledEventPagination
    -> [ScheduledEventStatus]
    -> RowsCountOption
    -> CacheRWT m (Either QErr (WithOptionalTotalCount [CronEvent])))
-> (GetScheduledEventInvocations
    -> CacheRWT
         m
         (Either QErr (WithOptionalTotalCount [ScheduledEventInvocation])))
-> (EventId -> ScheduledEventType -> CacheRWT m (Either QErr ()))
-> (ActionName
    -> SessionVariables
    -> [Header]
    -> Value
    -> CacheRWT m (Either QErr ActionId))
-> CacheRWT m (Either QErr [ActionLogItem])
-> (ActionId -> AsyncActionStatus -> CacheRWT m (Either QErr ()))
-> (ActionId -> CacheRWT m (Either QErr ActionLogResponse))
-> (ActionName -> CacheRWT m (Either QErr ()))
-> (LockedActionIdArray -> CacheRWT m (Either QErr ()))
-> MonadMetadataStorage (CacheRWT m)
[TriggerName] -> CacheRWT m (Either QErr [CronTriggerStats])
[TriggerName]
-> CacheRWT m (Either QErr ([CronEvent], [OneOffScheduledEvent]))
[CronEventSeed] -> CacheRWT m (Either QErr ())
Invocation 'ScheduledType
-> ScheduledEventType -> CacheRWT m (Either QErr ())
EventId -> ScheduledEventType -> CacheRWT m (Either QErr ())
EventId
-> ScheduledEventOp
-> ScheduledEventType
-> CacheRWT m (Either QErr ())
TriggerName
-> ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> CacheRWT m (Either QErr (WithOptionalTotalCount [CronEvent]))
ClearCronEvents -> CacheRWT m (Either QErr ())
GetScheduledEventInvocations
-> CacheRWT
     m (Either QErr (WithOptionalTotalCount [ScheduledEventInvocation]))
ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> CacheRWT
     m (Either QErr (WithOptionalTotalCount [OneOffScheduledEvent]))
ScheduledEventType -> [EventId] -> CacheRWT m (Either QErr Int)
OneOffEvent -> CacheRWT m (Either QErr EventId)
LockedActionIdArray -> CacheRWT m (Either QErr ())
ActionId -> CacheRWT m (Either QErr ActionLogResponse)
ActionId -> AsyncActionStatus -> CacheRWT m (Either QErr ())
ActionName -> CacheRWT m (Either QErr ())
ActionName
-> SessionVariables
-> [Header]
-> Value
-> CacheRWT m (Either QErr ActionId)
CatalogStateType -> Value -> CacheRWT m (Either QErr ())
MetadataResourceVersion
-> CacheRWT m (Either QErr (Maybe StoredIntrospection))
MetadataResourceVersion
-> InstanceId
-> CacheRWT
     m (Either QErr [(MetadataResourceVersion, CacheInvalidations)])
MetadataResourceVersion
-> InstanceId -> CacheInvalidations -> CacheRWT m (Either QErr ())
MetadataResourceVersion
-> Metadata -> CacheRWT m (Either QErr MetadataResourceVersion)
StoredIntrospection
-> MetadataResourceVersion -> CacheRWT m (Either QErr ())
forall (m :: * -> *).
Monad m
-> m (Either QErr MetadataResourceVersion)
-> m (Either QErr MetadataWithResourceVersion)
-> (MetadataResourceVersion
    -> InstanceId
    -> m (Either QErr [(MetadataResourceVersion, CacheInvalidations)]))
-> (MetadataResourceVersion
    -> Metadata -> m (Either QErr MetadataResourceVersion))
-> (MetadataResourceVersion
    -> InstanceId -> CacheInvalidations -> m (Either QErr ()))
-> m (Either QErr CatalogState)
-> (CatalogStateType -> Value -> m (Either QErr ()))
-> (MetadataResourceVersion
    -> m (Either QErr (Maybe StoredIntrospection)))
-> (StoredIntrospection
    -> MetadataResourceVersion -> m (Either QErr ()))
-> m (Either QErr MetadataDbId)
-> m (Either QErr ())
-> ([TriggerName] -> m (Either QErr [CronTriggerStats]))
-> ([TriggerName]
    -> m (Either QErr ([CronEvent], [OneOffScheduledEvent])))
-> ([CronEventSeed] -> m (Either QErr ()))
-> (OneOffEvent -> m (Either QErr EventId))
-> (Invocation 'ScheduledType
    -> ScheduledEventType -> m (Either QErr ()))
-> (EventId
    -> ScheduledEventOp -> ScheduledEventType -> m (Either QErr ()))
-> (ScheduledEventType -> [EventId] -> m (Either QErr Int))
-> m (Either QErr ())
-> (ClearCronEvents -> m (Either QErr ()))
-> (ScheduledEventPagination
    -> [ScheduledEventStatus]
    -> RowsCountOption
    -> m (Either QErr (WithOptionalTotalCount [OneOffScheduledEvent])))
-> (TriggerName
    -> ScheduledEventPagination
    -> [ScheduledEventStatus]
    -> RowsCountOption
    -> m (Either QErr (WithOptionalTotalCount [CronEvent])))
-> (GetScheduledEventInvocations
    -> m (Either
            QErr (WithOptionalTotalCount [ScheduledEventInvocation])))
-> (EventId -> ScheduledEventType -> m (Either QErr ()))
-> (ActionName
    -> SessionVariables
    -> [Header]
    -> Value
    -> m (Either QErr ActionId))
-> m (Either QErr [ActionLogItem])
-> (ActionId -> AsyncActionStatus -> m (Either QErr ()))
-> (ActionId -> m (Either QErr ActionLogResponse))
-> (ActionName -> m (Either QErr ()))
-> (LockedActionIdArray -> m (Either QErr ()))
-> MonadMetadataStorage m
forall {m :: * -> *}. MonadMetadataStorage m => Monad (CacheRWT m)
forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m (Either QErr [ActionLogItem])
forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m (Either QErr MetadataDbId)
forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m (Either QErr CatalogState)
forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m (Either QErr MetadataWithResourceVersion)
forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m (Either QErr MetadataResourceVersion)
forall (m :: * -> *).
MonadMetadataStorage m =>
[TriggerName] -> CacheRWT m (Either QErr [CronTriggerStats])
forall (m :: * -> *).
MonadMetadataStorage m =>
[TriggerName]
-> CacheRWT m (Either QErr ([CronEvent], [OneOffScheduledEvent]))
forall (m :: * -> *).
MonadMetadataStorage m =>
[CronEventSeed] -> CacheRWT m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
Invocation 'ScheduledType
-> ScheduledEventType -> CacheRWT m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
EventId -> ScheduledEventType -> CacheRWT m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
EventId
-> ScheduledEventOp
-> ScheduledEventType
-> CacheRWT m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
TriggerName
-> ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> CacheRWT m (Either QErr (WithOptionalTotalCount [CronEvent]))
forall (m :: * -> *).
MonadMetadataStorage m =>
ClearCronEvents -> CacheRWT m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
GetScheduledEventInvocations
-> CacheRWT
     m (Either QErr (WithOptionalTotalCount [ScheduledEventInvocation]))
forall (m :: * -> *).
MonadMetadataStorage m =>
ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> CacheRWT
     m (Either QErr (WithOptionalTotalCount [OneOffScheduledEvent]))
forall (m :: * -> *).
MonadMetadataStorage m =>
ScheduledEventType -> [EventId] -> CacheRWT m (Either QErr Int)
forall (m :: * -> *).
MonadMetadataStorage m =>
OneOffEvent -> CacheRWT m (Either QErr EventId)
forall (m :: * -> *).
MonadMetadataStorage m =>
LockedActionIdArray -> CacheRWT m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
ActionId -> CacheRWT m (Either QErr ActionLogResponse)
forall (m :: * -> *).
MonadMetadataStorage m =>
ActionId -> AsyncActionStatus -> CacheRWT m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
ActionName -> CacheRWT m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
ActionName
-> SessionVariables
-> [Header]
-> Value
-> CacheRWT m (Either QErr ActionId)
forall (m :: * -> *).
MonadMetadataStorage m =>
CatalogStateType -> Value -> CacheRWT m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> CacheRWT m (Either QErr (Maybe StoredIntrospection))
forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> InstanceId
-> CacheRWT
     m (Either QErr [(MetadataResourceVersion, CacheInvalidations)])
forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> InstanceId -> CacheInvalidations -> CacheRWT m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> Metadata -> CacheRWT m (Either QErr MetadataResourceVersion)
forall (m :: * -> *).
MonadMetadataStorage m =>
StoredIntrospection
-> MetadataResourceVersion -> CacheRWT m (Either QErr ())
$cfetchMetadataResourceVersion :: forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m (Either QErr MetadataResourceVersion)
fetchMetadataResourceVersion :: CacheRWT m (Either QErr MetadataResourceVersion)
$cfetchMetadata :: forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m (Either QErr MetadataWithResourceVersion)
fetchMetadata :: CacheRWT m (Either QErr MetadataWithResourceVersion)
$cfetchMetadataNotifications :: forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> InstanceId
-> CacheRWT
     m (Either QErr [(MetadataResourceVersion, CacheInvalidations)])
fetchMetadataNotifications :: MetadataResourceVersion
-> InstanceId
-> CacheRWT
     m (Either QErr [(MetadataResourceVersion, CacheInvalidations)])
$csetMetadata :: forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> Metadata -> CacheRWT m (Either QErr MetadataResourceVersion)
setMetadata :: MetadataResourceVersion
-> Metadata -> CacheRWT m (Either QErr MetadataResourceVersion)
$cnotifySchemaCacheSync :: forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> InstanceId -> CacheInvalidations -> CacheRWT m (Either QErr ())
notifySchemaCacheSync :: MetadataResourceVersion
-> InstanceId -> CacheInvalidations -> CacheRWT m (Either QErr ())
$cgetCatalogState :: forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m (Either QErr CatalogState)
getCatalogState :: CacheRWT m (Either QErr CatalogState)
$csetCatalogState :: forall (m :: * -> *).
MonadMetadataStorage m =>
CatalogStateType -> Value -> CacheRWT m (Either QErr ())
setCatalogState :: CatalogStateType -> Value -> CacheRWT m (Either QErr ())
$cfetchSourceIntrospection :: forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> CacheRWT m (Either QErr (Maybe StoredIntrospection))
fetchSourceIntrospection :: MetadataResourceVersion
-> CacheRWT m (Either QErr (Maybe StoredIntrospection))
$cstoreSourceIntrospection :: forall (m :: * -> *).
MonadMetadataStorage m =>
StoredIntrospection
-> MetadataResourceVersion -> CacheRWT m (Either QErr ())
storeSourceIntrospection :: StoredIntrospection
-> MetadataResourceVersion -> CacheRWT m (Either QErr ())
$cgetMetadataDbUid :: forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m (Either QErr MetadataDbId)
getMetadataDbUid :: CacheRWT m (Either QErr MetadataDbId)
$ccheckMetadataStorageHealth :: forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m (Either QErr ())
checkMetadataStorageHealth :: CacheRWT m (Either QErr ())
$cgetDeprivedCronTriggerStats :: forall (m :: * -> *).
MonadMetadataStorage m =>
[TriggerName] -> CacheRWT m (Either QErr [CronTriggerStats])
getDeprivedCronTriggerStats :: [TriggerName] -> CacheRWT m (Either QErr [CronTriggerStats])
$cgetScheduledEventsForDelivery :: forall (m :: * -> *).
MonadMetadataStorage m =>
[TriggerName]
-> CacheRWT m (Either QErr ([CronEvent], [OneOffScheduledEvent]))
getScheduledEventsForDelivery :: [TriggerName]
-> CacheRWT m (Either QErr ([CronEvent], [OneOffScheduledEvent]))
$cinsertCronEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
[CronEventSeed] -> CacheRWT m (Either QErr ())
insertCronEvents :: [CronEventSeed] -> CacheRWT m (Either QErr ())
$cinsertOneOffScheduledEvent :: forall (m :: * -> *).
MonadMetadataStorage m =>
OneOffEvent -> CacheRWT m (Either QErr EventId)
insertOneOffScheduledEvent :: OneOffEvent -> CacheRWT m (Either QErr EventId)
$cinsertScheduledEventInvocation :: forall (m :: * -> *).
MonadMetadataStorage m =>
Invocation 'ScheduledType
-> ScheduledEventType -> CacheRWT m (Either QErr ())
insertScheduledEventInvocation :: Invocation 'ScheduledType
-> ScheduledEventType -> CacheRWT m (Either QErr ())
$csetScheduledEventOp :: forall (m :: * -> *).
MonadMetadataStorage m =>
EventId
-> ScheduledEventOp
-> ScheduledEventType
-> CacheRWT m (Either QErr ())
setScheduledEventOp :: EventId
-> ScheduledEventOp
-> ScheduledEventType
-> CacheRWT m (Either QErr ())
$cunlockScheduledEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
ScheduledEventType -> [EventId] -> CacheRWT m (Either QErr Int)
unlockScheduledEvents :: ScheduledEventType -> [EventId] -> CacheRWT m (Either QErr Int)
$cunlockAllLockedScheduledEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m (Either QErr ())
unlockAllLockedScheduledEvents :: CacheRWT m (Either QErr ())
$cclearFutureCronEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
ClearCronEvents -> CacheRWT m (Either QErr ())
clearFutureCronEvents :: ClearCronEvents -> CacheRWT m (Either QErr ())
$cgetOneOffScheduledEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> CacheRWT
     m (Either QErr (WithOptionalTotalCount [OneOffScheduledEvent]))
getOneOffScheduledEvents :: ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> CacheRWT
     m (Either QErr (WithOptionalTotalCount [OneOffScheduledEvent]))
$cgetCronEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
TriggerName
-> ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> CacheRWT m (Either QErr (WithOptionalTotalCount [CronEvent]))
getCronEvents :: TriggerName
-> ScheduledEventPagination
-> [ScheduledEventStatus]
-> RowsCountOption
-> CacheRWT m (Either QErr (WithOptionalTotalCount [CronEvent]))
$cgetScheduledEventInvocations :: forall (m :: * -> *).
MonadMetadataStorage m =>
GetScheduledEventInvocations
-> CacheRWT
     m (Either QErr (WithOptionalTotalCount [ScheduledEventInvocation]))
getScheduledEventInvocations :: GetScheduledEventInvocations
-> CacheRWT
     m (Either QErr (WithOptionalTotalCount [ScheduledEventInvocation]))
$cdeleteScheduledEvent :: forall (m :: * -> *).
MonadMetadataStorage m =>
EventId -> ScheduledEventType -> CacheRWT m (Either QErr ())
deleteScheduledEvent :: EventId -> ScheduledEventType -> CacheRWT m (Either QErr ())
$cinsertAction :: forall (m :: * -> *).
MonadMetadataStorage m =>
ActionName
-> SessionVariables
-> [Header]
-> Value
-> CacheRWT m (Either QErr ActionId)
insertAction :: ActionName
-> SessionVariables
-> [Header]
-> Value
-> CacheRWT m (Either QErr ActionId)
$cfetchUndeliveredActionEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m (Either QErr [ActionLogItem])
fetchUndeliveredActionEvents :: CacheRWT m (Either QErr [ActionLogItem])
$csetActionStatus :: forall (m :: * -> *).
MonadMetadataStorage m =>
ActionId -> AsyncActionStatus -> CacheRWT m (Either QErr ())
setActionStatus :: ActionId -> AsyncActionStatus -> CacheRWT m (Either QErr ())
$cfetchActionResponse :: forall (m :: * -> *).
MonadMetadataStorage m =>
ActionId -> CacheRWT m (Either QErr ActionLogResponse)
fetchActionResponse :: ActionId -> CacheRWT m (Either QErr ActionLogResponse)
$cclearActionData :: forall (m :: * -> *).
MonadMetadataStorage m =>
ActionName -> CacheRWT m (Either QErr ())
clearActionData :: ActionName -> CacheRWT m (Either QErr ())
$csetProcessingActionLogsToPending :: forall (m :: * -> *).
MonadMetadataStorage m =>
LockedActionIdArray -> CacheRWT m (Either QErr ())
setProcessingActionLogsToPending :: LockedActionIdArray -> CacheRWT m (Either QErr ())
MonadMetadataStorage,
      Monad (CacheRWT m)
CacheRWT m (Maybe TraceContext)
Monad (CacheRWT m)
-> (forall a.
    TraceContext
    -> SamplingPolicy -> Text -> CacheRWT m a -> CacheRWT m a)
-> (forall a. SpanId -> Text -> CacheRWT m a -> CacheRWT m a)
-> CacheRWT m (Maybe TraceContext)
-> (TraceMetadata -> CacheRWT m ())
-> MonadTrace (CacheRWT m)
TraceMetadata -> CacheRWT m ()
forall a. SpanId -> Text -> CacheRWT m a -> CacheRWT m a
forall a.
TraceContext
-> SamplingPolicy -> Text -> CacheRWT m a -> CacheRWT m a
forall (m :: * -> *).
Monad m
-> (forall a. TraceContext -> SamplingPolicy -> Text -> m a -> m a)
-> (forall a. SpanId -> Text -> m a -> m a)
-> m (Maybe TraceContext)
-> (TraceMetadata -> m ())
-> MonadTrace m
forall {m :: * -> *}. MonadTrace m => Monad (CacheRWT m)
forall (m :: * -> *).
MonadTrace m =>
CacheRWT m (Maybe TraceContext)
forall (m :: * -> *).
MonadTrace m =>
TraceMetadata -> CacheRWT m ()
forall (m :: * -> *) a.
MonadTrace m =>
SpanId -> Text -> CacheRWT m a -> CacheRWT m a
forall (m :: * -> *) a.
MonadTrace m =>
TraceContext
-> SamplingPolicy -> Text -> CacheRWT m a -> CacheRWT m a
$cnewTraceWith :: forall (m :: * -> *) a.
MonadTrace m =>
TraceContext
-> SamplingPolicy -> Text -> CacheRWT m a -> CacheRWT m a
newTraceWith :: forall a.
TraceContext
-> SamplingPolicy -> Text -> CacheRWT m a -> CacheRWT m a
$cnewSpanWith :: forall (m :: * -> *) a.
MonadTrace m =>
SpanId -> Text -> CacheRWT m a -> CacheRWT m a
newSpanWith :: forall a. SpanId -> Text -> CacheRWT m a -> CacheRWT m a
$ccurrentContext :: forall (m :: * -> *).
MonadTrace m =>
CacheRWT m (Maybe TraceContext)
currentContext :: CacheRWT m (Maybe TraceContext)
$cattachMetadata :: forall (m :: * -> *).
MonadTrace m =>
TraceMetadata -> CacheRWT m ()
attachMetadata :: TraceMetadata -> CacheRWT m ()
Tracing.MonadTrace,
      MonadBase b,
      MonadBaseControl b,
      Monad (CacheRWT m)
CacheRWT m Manager
Monad (CacheRWT m)
-> CacheRWT m Manager -> ProvidesNetwork (CacheRWT m)
forall (m :: * -> *). Monad m -> m Manager -> ProvidesNetwork m
forall {m :: * -> *}. ProvidesNetwork m => Monad (CacheRWT m)
forall (m :: * -> *). ProvidesNetwork m => CacheRWT m Manager
$caskHTTPManager :: forall (m :: * -> *). ProvidesNetwork m => CacheRWT m Manager
askHTTPManager :: CacheRWT m Manager
ProvidesNetwork,
      Monad (CacheRWT m)
Monad (CacheRWT m)
-> (FeatureFlag -> CacheRWT m Bool)
-> HasFeatureFlagChecker (CacheRWT m)
FeatureFlag -> CacheRWT m Bool
forall (m :: * -> *).
Monad m -> (FeatureFlag -> m Bool) -> HasFeatureFlagChecker m
forall {m :: * -> *}. HasFeatureFlagChecker m => Monad (CacheRWT m)
forall (m :: * -> *).
HasFeatureFlagChecker m =>
FeatureFlag -> CacheRWT m Bool
$ccheckFlag :: forall (m :: * -> *).
HasFeatureFlagChecker m =>
FeatureFlag -> CacheRWT m Bool
checkFlag :: FeatureFlag -> CacheRWT m Bool
FF.HasFeatureFlagChecker
    )
  deriving anyclass (Monad (CacheRWT m)
Monad (CacheRWT m)
-> (QueryTagsAttributes
    -> Maybe QueryTagsConfig -> Tagged (CacheRWT m) QueryTagsComment)
-> MonadQueryTags (CacheRWT m)
QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged (CacheRWT m) QueryTagsComment
forall (m :: * -> *).
Monad m
-> (QueryTagsAttributes
    -> Maybe QueryTagsConfig -> Tagged m QueryTagsComment)
-> MonadQueryTags m
forall {m :: * -> *}. MonadQueryTags m => Monad (CacheRWT m)
forall (m :: * -> *).
MonadQueryTags m =>
QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged (CacheRWT m) QueryTagsComment
$ccreateQueryTags :: forall (m :: * -> *).
MonadQueryTags m =>
QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged (CacheRWT m) QueryTagsComment
createQueryTags :: QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged (CacheRWT m) QueryTagsComment
MonadQueryTags)

instance (MonadReader r m) => MonadReader r (CacheRWT m) where
  ask :: CacheRWT m r
ask = m r -> CacheRWT m r
forall (m :: * -> *) a. Monad m => m a -> CacheRWT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> CacheRWT m a -> CacheRWT m a
local r -> r
f (CacheRWT ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  a
m) = ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  a
-> CacheRWT m a
forall (m :: * -> *) a.
ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  a
-> CacheRWT m a
CacheRWT (ReaderT
   CacheDynamicConfig
   (StateT
      (RebuildableSchemaCache, CacheInvalidations,
       SourcesIntrospectionStatus, SchemaRegistryAction)
      m)
   a
 -> CacheRWT m a)
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     a
-> CacheRWT m a
forall a b. (a -> b) -> a -> b
$ (StateT
   (RebuildableSchemaCache, CacheInvalidations,
    SourcesIntrospectionStatus, SchemaRegistryAction)
   m
   a
 -> StateT
      (RebuildableSchemaCache, CacheInvalidations,
       SourcesIntrospectionStatus, SchemaRegistryAction)
      m
      a)
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     a
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((r -> r)
-> StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m
     a
-> StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m
     a
forall a.
(r -> r)
-> StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m
     a
-> StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m
     a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f) ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  a
m

instance (MonadEventLogCleanup m) => MonadEventLogCleanup (CacheRWT m) where
  runLogCleaner :: SourceCache
-> TriggerLogCleanupConfig -> CacheRWT m (Either QErr EncJSON)
runLogCleaner SourceCache
sourceCache TriggerLogCleanupConfig
conf = m (Either QErr EncJSON) -> CacheRWT m (Either QErr EncJSON)
forall (m :: * -> *) a. Monad m => m a -> CacheRWT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either QErr EncJSON) -> CacheRWT m (Either QErr EncJSON))
-> m (Either QErr EncJSON) -> CacheRWT m (Either QErr EncJSON)
forall a b. (a -> b) -> a -> b
$ SourceCache -> TriggerLogCleanupConfig -> m (Either QErr EncJSON)
forall (m :: * -> *).
MonadEventLogCleanup m =>
SourceCache -> TriggerLogCleanupConfig -> m (Either QErr EncJSON)
runLogCleaner SourceCache
sourceCache TriggerLogCleanupConfig
conf
  generateCleanupSchedules :: AnyBackend SourceInfo
-> TriggerName
-> AutoTriggerLogCleanupConfig
-> CacheRWT m (Either QErr ())
generateCleanupSchedules AnyBackend SourceInfo
sourceInfo TriggerName
triggerName AutoTriggerLogCleanupConfig
cleanupConfig = m (Either QErr ()) -> CacheRWT m (Either QErr ())
forall (m :: * -> *) a. Monad m => m a -> CacheRWT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either QErr ()) -> CacheRWT m (Either QErr ()))
-> m (Either QErr ()) -> CacheRWT m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ AnyBackend SourceInfo
-> TriggerName -> AutoTriggerLogCleanupConfig -> m (Either QErr ())
forall (m :: * -> *).
MonadEventLogCleanup m =>
AnyBackend SourceInfo
-> TriggerName -> AutoTriggerLogCleanupConfig -> m (Either QErr ())
generateCleanupSchedules AnyBackend SourceInfo
sourceInfo TriggerName
triggerName AutoTriggerLogCleanupConfig
cleanupConfig
  updateTriggerCleanupSchedules :: Logger Hasura
-> InsOrdHashMap SourceName BackendSourceMetadata
-> InsOrdHashMap SourceName BackendSourceMetadata
-> SchemaCache
-> CacheRWT m (Either QErr ())
updateTriggerCleanupSchedules Logger Hasura
logger InsOrdHashMap SourceName BackendSourceMetadata
oldSources InsOrdHashMap SourceName BackendSourceMetadata
newSources SchemaCache
schemaCache = m (Either QErr ()) -> CacheRWT m (Either QErr ())
forall (m :: * -> *) a. Monad m => m a -> CacheRWT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either QErr ()) -> CacheRWT m (Either QErr ()))
-> m (Either QErr ()) -> CacheRWT m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ Logger Hasura
-> InsOrdHashMap SourceName BackendSourceMetadata
-> InsOrdHashMap SourceName BackendSourceMetadata
-> SchemaCache
-> m (Either QErr ())
forall (m :: * -> *).
MonadEventLogCleanup m =>
Logger Hasura
-> InsOrdHashMap SourceName BackendSourceMetadata
-> InsOrdHashMap SourceName BackendSourceMetadata
-> SchemaCache
-> m (Either QErr ())
updateTriggerCleanupSchedules Logger Hasura
logger InsOrdHashMap SourceName BackendSourceMetadata
oldSources InsOrdHashMap SourceName BackendSourceMetadata
newSources SchemaCache
schemaCache

instance (MonadGetPolicies m) => MonadGetPolicies (CacheRWT m) where
  runGetApiTimeLimit :: CacheRWT m (Maybe MaxTime)
runGetApiTimeLimit = m (Maybe MaxTime) -> CacheRWT m (Maybe MaxTime)
forall (m :: * -> *) a. Monad m => m a -> CacheRWT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe MaxTime) -> CacheRWT m (Maybe MaxTime))
-> m (Maybe MaxTime) -> CacheRWT m (Maybe MaxTime)
forall a b. (a -> b) -> a -> b
$ m (Maybe MaxTime)
forall (m :: * -> *). MonadGetPolicies m => m (Maybe MaxTime)
runGetApiTimeLimit
  runGetPrometheusMetricsGranularity :: CacheRWT m (IO GranularPrometheusMetricsState)
runGetPrometheusMetricsGranularity = m (IO GranularPrometheusMetricsState)
-> CacheRWT m (IO GranularPrometheusMetricsState)
forall (m :: * -> *) a. Monad m => m a -> CacheRWT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (IO GranularPrometheusMetricsState)
 -> CacheRWT m (IO GranularPrometheusMetricsState))
-> m (IO GranularPrometheusMetricsState)
-> CacheRWT m (IO GranularPrometheusMetricsState)
forall a b. (a -> b) -> a -> b
$ m (IO GranularPrometheusMetricsState)
forall (m :: * -> *).
MonadGetPolicies m =>
m (IO GranularPrometheusMetricsState)
runGetPrometheusMetricsGranularity

runCacheRWT ::
  (Monad m) =>
  CacheDynamicConfig ->
  RebuildableSchemaCache ->
  CacheRWT m a ->
  m (a, RebuildableSchemaCache, CacheInvalidations, SourcesIntrospectionStatus, SchemaRegistryAction)
runCacheRWT :: forall (m :: * -> *) a.
Monad m =>
CacheDynamicConfig
-> RebuildableSchemaCache
-> CacheRWT m a
-> m (a, RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
runCacheRWT CacheDynamicConfig
config RebuildableSchemaCache
cache (CacheRWT ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  a
m) = do
  (a
v, (RebuildableSchemaCache
newCache, CacheInvalidations
invalidations, SourcesIntrospectionStatus
introspection, SchemaRegistryAction
schemaRegistryAction)) <-
    StateT
  (RebuildableSchemaCache, CacheInvalidations,
   SourcesIntrospectionStatus, SchemaRegistryAction)
  m
  a
-> (RebuildableSchemaCache, CacheInvalidations,
    SourcesIntrospectionStatus, SchemaRegistryAction)
-> m (a,
      (RebuildableSchemaCache, CacheInvalidations,
       SourcesIntrospectionStatus, SchemaRegistryAction))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  a
-> CacheDynamicConfig
-> StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m
     a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  a
m CacheDynamicConfig
config) (RebuildableSchemaCache
cache, CacheInvalidations
forall a. Monoid a => a
mempty, SourcesIntrospectionStatus
SourcesIntrospectionUnchanged, SchemaRegistryAction
forall a. Maybe a
Nothing)
  (a, RebuildableSchemaCache, CacheInvalidations,
 SourcesIntrospectionStatus, SchemaRegistryAction)
-> m (a, RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
v, RebuildableSchemaCache
newCache, CacheInvalidations
invalidations, SourcesIntrospectionStatus
introspection, SchemaRegistryAction
schemaRegistryAction)

instance MonadTrans CacheRWT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> CacheRWT m a
lift = ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  a
-> CacheRWT m a
forall (m :: * -> *) a.
ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  a
-> CacheRWT m a
CacheRWT (ReaderT
   CacheDynamicConfig
   (StateT
      (RebuildableSchemaCache, CacheInvalidations,
       SourcesIntrospectionStatus, SchemaRegistryAction)
      m)
   a
 -> CacheRWT m a)
-> (m a
    -> ReaderT
         CacheDynamicConfig
         (StateT
            (RebuildableSchemaCache, CacheInvalidations,
             SourcesIntrospectionStatus, SchemaRegistryAction)
            m)
         a)
-> m a
-> CacheRWT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT
  (RebuildableSchemaCache, CacheInvalidations,
   SourcesIntrospectionStatus, SchemaRegistryAction)
  m
  a
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     a
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT CacheDynamicConfig m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT
   (RebuildableSchemaCache, CacheInvalidations,
    SourcesIntrospectionStatus, SchemaRegistryAction)
   m
   a
 -> ReaderT
      CacheDynamicConfig
      (StateT
         (RebuildableSchemaCache, CacheInvalidations,
          SourcesIntrospectionStatus, SchemaRegistryAction)
         m)
      a)
-> (m a
    -> StateT
         (RebuildableSchemaCache, CacheInvalidations,
          SourcesIntrospectionStatus, SchemaRegistryAction)
         m
         a)
-> m a
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a
-> StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m
     a
forall (m :: * -> *) a.
Monad m =>
m a
-> StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (Monad m) => CacheRM (CacheRWT m) where
  askSchemaCache :: CacheRWT m SchemaCache
askSchemaCache = ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  SchemaCache
-> CacheRWT m SchemaCache
forall (m :: * -> *) a.
ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  a
-> CacheRWT m a
CacheRWT (ReaderT
   CacheDynamicConfig
   (StateT
      (RebuildableSchemaCache, CacheInvalidations,
       SourcesIntrospectionStatus, SchemaRegistryAction)
      m)
   SchemaCache
 -> CacheRWT m SchemaCache)
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     SchemaCache
-> CacheRWT m SchemaCache
forall a b. (a -> b) -> a -> b
$ ((RebuildableSchemaCache, CacheInvalidations,
  SourcesIntrospectionStatus, SchemaRegistryAction)
 -> SchemaCache)
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     SchemaCache
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (RebuildableSchemaCache -> SchemaCache
lastBuiltSchemaCache (RebuildableSchemaCache -> SchemaCache)
-> ((RebuildableSchemaCache, CacheInvalidations,
     SourcesIntrospectionStatus, SchemaRegistryAction)
    -> RebuildableSchemaCache)
-> (RebuildableSchemaCache, CacheInvalidations,
    SourcesIntrospectionStatus, SchemaRegistryAction)
-> SchemaCache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RebuildableSchemaCache, CacheInvalidations,
 SourcesIntrospectionStatus, SchemaRegistryAction)
-> Getting
     RebuildableSchemaCache
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     RebuildableSchemaCache
-> RebuildableSchemaCache
forall s a. s -> Getting a s a -> a
^. Getting
  RebuildableSchemaCache
  (RebuildableSchemaCache, CacheInvalidations,
   SourcesIntrospectionStatus, SchemaRegistryAction)
  RebuildableSchemaCache
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (RebuildableSchemaCache, CacheInvalidations,
   SourcesIntrospectionStatus, SchemaRegistryAction)
  (RebuildableSchemaCache, CacheInvalidations,
   SourcesIntrospectionStatus, SchemaRegistryAction)
  RebuildableSchemaCache
  RebuildableSchemaCache
_1))

-- | Note: Use these functions over 'fetchSourceIntrospection' and
-- 'storeSourceIntrospection' from 'MonadMetadataStorage' class.
-- These are wrapper function over 'MonadMetadataStorage' methods. These functions
-- handles errors, if any, logs them and returns empty stored introspection.
-- This is to ensure we do not accidentally throw errors (related to
-- fetching/storing stored introspection) in the critical code path of building
-- the 'SchemaCache'.
loadStoredIntrospection ::
  (MonadMetadataStorage m, MonadIO m) =>
  Logger Hasura ->
  MetadataResourceVersion ->
  m (Maybe StoredIntrospection)
loadStoredIntrospection :: forall (m :: * -> *).
(MonadMetadataStorage m, MonadIO m) =>
Logger Hasura
-> MetadataResourceVersion -> m (Maybe StoredIntrospection)
loadStoredIntrospection Logger Hasura
logger MetadataResourceVersion
metadataVersion = do
  MetadataResourceVersion
-> m (Either QErr (Maybe StoredIntrospection))
forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> m (Either QErr (Maybe StoredIntrospection))
fetchSourceIntrospection MetadataResourceVersion
metadataVersion m (Either QErr (Maybe StoredIntrospection))
-> (QErr -> m (Maybe StoredIntrospection))
-> m (Maybe StoredIntrospection)
forall (m :: * -> *) e a.
Monad m =>
m (Either e a) -> (e -> m a) -> m a
`onLeftM` \QErr
err -> do
    Logger Hasura
-> forall a (m :: * -> *).
   (ToEngineLog a Hasura, MonadIO m) =>
   a -> m ()
forall impl.
Logger impl
-> forall a (m :: * -> *).
   (ToEngineLog a impl, MonadIO m) =>
   a -> m ()
unLogger Logger Hasura
logger
      (StoredIntrospectionStorageLog -> m ())
-> StoredIntrospectionStorageLog -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> QErr -> StoredIntrospectionStorageLog
StoredIntrospectionStorageLog Text
"Could not load stored-introspection. Continuing without it" QErr
err
    Maybe StoredIntrospection -> m (Maybe StoredIntrospection)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe StoredIntrospection
forall a. Maybe a
Nothing

saveSourcesIntrospection ::
  (MonadIO m, MonadMetadataStorage m) =>
  Logger Hasura ->
  SourcesIntrospectionStatus ->
  MetadataResourceVersion ->
  m ()
saveSourcesIntrospection :: forall (m :: * -> *).
(MonadIO m, MonadMetadataStorage m) =>
Logger Hasura
-> SourcesIntrospectionStatus -> MetadataResourceVersion -> m ()
saveSourcesIntrospection Logger Hasura
logger SourcesIntrospectionStatus
sourcesIntrospection MetadataResourceVersion
metadataVersion = do
  -- store the collected source introspection result only if we were able
  -- to introspect all sources successfully
  case SourcesIntrospectionStatus
sourcesIntrospection of
    SourcesIntrospectionStatus
SourcesIntrospectionUnchanged -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    SourcesIntrospectionChangedPartial StoredIntrospection
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    SourcesIntrospectionChangedFull StoredIntrospection
introspection ->
      StoredIntrospection
-> MetadataResourceVersion -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
StoredIntrospection
-> MetadataResourceVersion -> m (Either QErr ())
storeSourceIntrospection StoredIntrospection
introspection MetadataResourceVersion
metadataVersion m (Either QErr ()) -> (QErr -> m ()) -> m ()
forall (m :: * -> *) e a.
Monad m =>
m (Either e a) -> (e -> m a) -> m a
`onLeftM` \QErr
err ->
        Logger Hasura
-> forall a (m :: * -> *).
   (ToEngineLog a Hasura, MonadIO m) =>
   a -> m ()
forall impl.
Logger impl
-> forall a (m :: * -> *).
   (ToEngineLog a impl, MonadIO m) =>
   a -> m ()
unLogger Logger Hasura
logger (StoredIntrospectionStorageLog -> m ())
-> StoredIntrospectionStorageLog -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> QErr -> StoredIntrospectionStorageLog
StoredIntrospectionStorageLog Text
"Could not save source introspection" QErr
err

instance
  ( MonadIO m,
    MonadError QErr m,
    ProvidesNetwork m,
    MonadResolveSource m,
    HasCacheStaticConfig m,
    MonadMetadataStorage m
  ) =>
  CacheRWM (CacheRWT m)
  where
  tryBuildSchemaCacheWithOptions :: forall a.
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> CacheRWT m a
tryBuildSchemaCacheWithOptions BuildReason
buildReason CacheInvalidations
invalidations Metadata
newMetadata Maybe MetadataResourceVersion
metadataResourceVersion ValidateNewSchemaCache a
validateNewSchemaCache = ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  a
-> CacheRWT m a
forall (m :: * -> *) a.
ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  a
-> CacheRWT m a
CacheRWT do
    CacheDynamicConfig
dynamicConfig <- ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  CacheDynamicConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
    CacheStaticConfig
staticConfig <- ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  CacheStaticConfig
forall (m :: * -> *). HasCacheStaticConfig m => m CacheStaticConfig
askCacheStaticConfig
    (RebuildableSchemaCache SchemaCache
lastBuiltSC InvalidationKeys
invalidationKeys Rule
  (ReaderT BuildReason CacheBuild)
  (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
   Maybe StoredIntrospection)
  (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
rule, CacheInvalidations
oldInvalidations, SourcesIntrospectionStatus
_, SchemaRegistryAction
_) <- ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  (RebuildableSchemaCache, CacheInvalidations,
   SourcesIntrospectionStatus, SchemaRegistryAction)
forall s (m :: * -> *). MonadState s m => m s
get
    let oldMetadataVersion :: MetadataResourceVersion
oldMetadataVersion = SchemaCache -> MetadataResourceVersion
scMetadataResourceVersion SchemaCache
lastBuiltSC
        -- We are purposely putting (-1) as the metadata resource version here. This is because we want to
        -- catch error cases in `withSchemaCache(Read)Update`
        metadataWithVersion :: MetadataWithResourceVersion
metadataWithVersion = Metadata -> MetadataResourceVersion -> MetadataWithResourceVersion
MetadataWithResourceVersion Metadata
newMetadata (MetadataResourceVersion -> MetadataWithResourceVersion)
-> MetadataResourceVersion -> MetadataWithResourceVersion
forall a b. (a -> b) -> a -> b
$ MetadataResourceVersion
-> Maybe MetadataResourceVersion -> MetadataResourceVersion
forall a. a -> Maybe a -> a
fromMaybe (Int64 -> MetadataResourceVersion
MetadataResourceVersion (-Int64
1)) Maybe MetadataResourceVersion
metadataResourceVersion
        newInvalidationKeys :: InvalidationKeys
newInvalidationKeys = CacheInvalidations -> InvalidationKeys -> InvalidationKeys
invalidateKeys CacheInvalidations
invalidations InvalidationKeys
invalidationKeys
    Maybe StoredIntrospection
storedIntrospection <- Logger Hasura
-> MetadataResourceVersion
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     (Maybe StoredIntrospection)
forall (m :: * -> *).
(MonadMetadataStorage m, MonadIO m) =>
Logger Hasura
-> MetadataResourceVersion -> m (Maybe StoredIntrospection)
loadStoredIntrospection (CacheStaticConfig -> Logger Hasura
_cscLogger CacheStaticConfig
staticConfig) MetadataResourceVersion
oldMetadataVersion
    Result
  (ReaderT BuildReason CacheBuild)
  (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
   Maybe StoredIntrospection)
  (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
result <-
      CacheBuild
  (Result
     (ReaderT BuildReason CacheBuild)
     (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
      Maybe StoredIntrospection)
     (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     (Result
        (ReaderT BuildReason CacheBuild)
        (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
         Maybe StoredIntrospection)
        (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
forall (m :: * -> *) a.
(MonadIO m, MonadError QErr m, MonadResolveSource m,
 ProvidesNetwork m, HasCacheStaticConfig m) =>
CacheBuild a -> m a
runCacheBuildM
        (CacheBuild
   (Result
      (ReaderT BuildReason CacheBuild)
      (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
       Maybe StoredIntrospection)
      (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
 -> ReaderT
      CacheDynamicConfig
      (StateT
         (RebuildableSchemaCache, CacheInvalidations,
          SourcesIntrospectionStatus, SchemaRegistryAction)
         m)
      (Result
         (ReaderT BuildReason CacheBuild)
         (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
          Maybe StoredIntrospection)
         (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))))
-> CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
         Maybe StoredIntrospection)
        (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     (Result
        (ReaderT BuildReason CacheBuild)
        (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
         Maybe StoredIntrospection)
        (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
forall a b. (a -> b) -> a -> b
$ (ReaderT
   BuildReason
   CacheBuild
   (Result
      (ReaderT BuildReason CacheBuild)
      (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
       Maybe StoredIntrospection)
      (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
 -> BuildReason
 -> CacheBuild
      (Result
         (ReaderT BuildReason CacheBuild)
         (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
          Maybe StoredIntrospection)
         (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))))
-> BuildReason
-> ReaderT
     BuildReason
     CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
         Maybe StoredIntrospection)
        (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
-> CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
         Maybe StoredIntrospection)
        (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  BuildReason
  CacheBuild
  (Result
     (ReaderT BuildReason CacheBuild)
     (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
      Maybe StoredIntrospection)
     (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
-> BuildReason
-> CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
         Maybe StoredIntrospection)
        (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT BuildReason
buildReason
        (ReaderT
   BuildReason
   CacheBuild
   (Result
      (ReaderT BuildReason CacheBuild)
      (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
       Maybe StoredIntrospection)
      (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
 -> CacheBuild
      (Result
         (ReaderT BuildReason CacheBuild)
         (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
          Maybe StoredIntrospection)
         (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))))
-> ReaderT
     BuildReason
     CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
         Maybe StoredIntrospection)
        (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
-> CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
         Maybe StoredIntrospection)
        (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
forall a b. (a -> b) -> a -> b
$ Rule
  (ReaderT BuildReason CacheBuild)
  (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
   Maybe StoredIntrospection)
  (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
-> (MetadataWithResourceVersion, CacheDynamicConfig,
    InvalidationKeys, Maybe StoredIntrospection)
-> ReaderT
     BuildReason
     CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
         Maybe StoredIntrospection)
        (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction)))
forall (m :: * -> *) a b.
Applicative m =>
Rule m a b -> a -> m (Result m a b)
Inc.build Rule
  (ReaderT BuildReason CacheBuild)
  (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
   Maybe StoredIntrospection)
  (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
rule (MetadataWithResourceVersion
metadataWithVersion, CacheDynamicConfig
dynamicConfig, InvalidationKeys
newInvalidationKeys, Maybe StoredIntrospection
storedIntrospection)

    let (SchemaCache
schemaCache, (SourcesIntrospectionStatus
storedIntrospectionStatus, SchemaRegistryAction
schemaRegistryAction)) = Result
  (ReaderT BuildReason CacheBuild)
  (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
   Maybe StoredIntrospection)
  (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
-> (SchemaCache,
    (SourcesIntrospectionStatus, SchemaRegistryAction))
forall {k} (m :: k -> *) a b. Result m a b -> b
Inc.result Result
  (ReaderT BuildReason CacheBuild)
  (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
   Maybe StoredIntrospection)
  (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
result
        prunedInvalidationKeys :: InvalidationKeys
prunedInvalidationKeys = SchemaCache -> InvalidationKeys -> InvalidationKeys
pruneInvalidationKeys SchemaCache
schemaCache InvalidationKeys
newInvalidationKeys
        !newCache :: RebuildableSchemaCache
newCache = SchemaCache
-> InvalidationKeys
-> Rule
     (ReaderT BuildReason CacheBuild)
     (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
      Maybe StoredIntrospection)
     (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
-> RebuildableSchemaCache
RebuildableSchemaCache SchemaCache
schemaCache InvalidationKeys
prunedInvalidationKeys (Result
  (ReaderT BuildReason CacheBuild)
  (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
   Maybe StoredIntrospection)
  (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
-> Rule
     (ReaderT BuildReason CacheBuild)
     (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
      Maybe StoredIntrospection)
     (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
forall {k} (m :: k -> *) a b. Result m a b -> Rule m a b
Inc.rebuildRule Result
  (ReaderT BuildReason CacheBuild)
  (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
   Maybe StoredIntrospection)
  (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
result)
        !newInvalidations :: CacheInvalidations
newInvalidations = CacheInvalidations
oldInvalidations CacheInvalidations -> CacheInvalidations -> CacheInvalidations
forall a. Semigroup a => a -> a -> a
<> CacheInvalidations
invalidations

    case ValidateNewSchemaCache a
validateNewSchemaCache SchemaCache
lastBuiltSC SchemaCache
schemaCache of
      (ValidateNewSchemaCacheResult
KeepNewSchemaCache, a
valueToReturn) -> (RebuildableSchemaCache, CacheInvalidations,
 SourcesIntrospectionStatus, SchemaRegistryAction)
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (RebuildableSchemaCache
newCache, CacheInvalidations
newInvalidations, SourcesIntrospectionStatus
storedIntrospectionStatus, SchemaRegistryAction
schemaRegistryAction) ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  ()
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     a
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     a
forall a b.
ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  a
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     b
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     a
forall a.
a
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
valueToReturn
      (ValidateNewSchemaCacheResult
DiscardNewSchemaCache, a
valueToReturn) -> a
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     a
forall a.
a
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
valueToReturn
    where
      -- Prunes invalidation keys that no longer exist in the schema to avoid leaking memory by
      -- hanging onto unnecessary keys.
      pruneInvalidationKeys :: SchemaCache -> InvalidationKeys -> InvalidationKeys
pruneInvalidationKeys SchemaCache
schemaCache = ASetter
  InvalidationKeys
  InvalidationKeys
  (HashMap RemoteSchemaName InvalidationKey)
  (HashMap RemoteSchemaName InvalidationKey)
-> (HashMap RemoteSchemaName InvalidationKey
    -> HashMap RemoteSchemaName InvalidationKey)
-> InvalidationKeys
-> InvalidationKeys
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  InvalidationKeys
  InvalidationKeys
  (HashMap RemoteSchemaName InvalidationKey)
  (HashMap RemoteSchemaName InvalidationKey)
Lens' InvalidationKeys (HashMap RemoteSchemaName InvalidationKey)
ikRemoteSchemas ((HashMap RemoteSchemaName InvalidationKey
  -> HashMap RemoteSchemaName InvalidationKey)
 -> InvalidationKeys -> InvalidationKeys)
-> (HashMap RemoteSchemaName InvalidationKey
    -> HashMap RemoteSchemaName InvalidationKey)
-> InvalidationKeys
-> InvalidationKeys
forall a b. (a -> b) -> a -> b
$ (RemoteSchemaName -> InvalidationKey -> Bool)
-> HashMap RemoteSchemaName InvalidationKey
-> HashMap RemoteSchemaName InvalidationKey
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filterWithKey \RemoteSchemaName
name InvalidationKey
_ ->
        -- see Note [Keep invalidation keys for inconsistent objects]
        RemoteSchemaName
name RemoteSchemaName -> [RemoteSchemaName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` SchemaCache -> [RemoteSchemaName]
getAllRemoteSchemas SchemaCache
schemaCache

  setMetadataResourceVersionInSchemaCache :: MetadataResourceVersion -> CacheRWT m ()
setMetadataResourceVersionInSchemaCache MetadataResourceVersion
resourceVersion = ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  ()
-> CacheRWT m ()
forall (m :: * -> *) a.
ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  a
-> CacheRWT m a
CacheRWT (ReaderT
   CacheDynamicConfig
   (StateT
      (RebuildableSchemaCache, CacheInvalidations,
       SourcesIntrospectionStatus, SchemaRegistryAction)
      m)
   ()
 -> CacheRWT m ())
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     ()
-> CacheRWT m ()
forall a b. (a -> b) -> a -> b
$ do
    (RebuildableSchemaCache
rebuildableSchemaCache, CacheInvalidations
invalidations, SourcesIntrospectionStatus
introspection, SchemaRegistryAction
schemaRegistryAction) <- ReaderT
  CacheDynamicConfig
  (StateT
     (RebuildableSchemaCache, CacheInvalidations,
      SourcesIntrospectionStatus, SchemaRegistryAction)
     m)
  (RebuildableSchemaCache, CacheInvalidations,
   SourcesIntrospectionStatus, SchemaRegistryAction)
forall s (m :: * -> *). MonadState s m => m s
get
    (RebuildableSchemaCache, CacheInvalidations,
 SourcesIntrospectionStatus, SchemaRegistryAction)
-> ReaderT
     CacheDynamicConfig
     (StateT
        (RebuildableSchemaCache, CacheInvalidations,
         SourcesIntrospectionStatus, SchemaRegistryAction)
        m)
     ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
      ( RebuildableSchemaCache
rebuildableSchemaCache
          { lastBuiltSchemaCache :: SchemaCache
lastBuiltSchemaCache =
              (RebuildableSchemaCache -> SchemaCache
lastBuiltSchemaCache RebuildableSchemaCache
rebuildableSchemaCache)
                { scMetadataResourceVersion :: MetadataResourceVersion
scMetadataResourceVersion = MetadataResourceVersion
resourceVersion
                }
          },
        CacheInvalidations
invalidations,
        SourcesIntrospectionStatus
introspection,
        SchemaRegistryAction
schemaRegistryAction
      )

-- | Generate health checks related cache from sources metadata
buildHealthCheckCache :: Sources -> SourceHealthCheckCache
buildHealthCheckCache :: InsOrdHashMap SourceName BackendSourceMetadata
-> SourceHealthCheckCache
buildHealthCheckCache InsOrdHashMap SourceName BackendSourceMetadata
sources =
  HashMap SourceName (Maybe BackendSourceHealthCheckInfo)
-> SourceHealthCheckCache
forall a. HashMap SourceName (Maybe a) -> HashMap SourceName a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes (HashMap SourceName (Maybe BackendSourceHealthCheckInfo)
 -> SourceHealthCheckCache)
-> HashMap SourceName (Maybe BackendSourceHealthCheckInfo)
-> SourceHealthCheckCache
forall a b. (a -> b) -> a -> b
$ [(SourceName, Maybe BackendSourceHealthCheckInfo)]
-> HashMap SourceName (Maybe BackendSourceHealthCheckInfo)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(SourceName, Maybe BackendSourceHealthCheckInfo)]
 -> HashMap SourceName (Maybe BackendSourceHealthCheckInfo))
-> [(SourceName, Maybe BackendSourceHealthCheckInfo)]
-> HashMap SourceName (Maybe BackendSourceHealthCheckInfo)
forall a b. (a -> b) -> a -> b
$ ((SourceName, BackendSourceMetadata)
 -> (SourceName, Maybe BackendSourceHealthCheckInfo))
-> [(SourceName, BackendSourceMetadata)]
-> [(SourceName, Maybe BackendSourceHealthCheckInfo)]
forall a b. (a -> b) -> [a] -> [b]
map ((BackendSourceMetadata -> Maybe BackendSourceHealthCheckInfo)
-> (SourceName, BackendSourceMetadata)
-> (SourceName, Maybe BackendSourceHealthCheckInfo)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second BackendSourceMetadata -> Maybe BackendSourceHealthCheckInfo
mkSourceHealthCheck) (InsOrdHashMap SourceName BackendSourceMetadata
-> [(SourceName, BackendSourceMetadata)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList InsOrdHashMap SourceName BackendSourceMetadata
sources)
  where
    mkSourceHealthCheck :: BackendSourceMetadata -> Maybe BackendSourceHealthCheckInfo
    mkSourceHealthCheck :: BackendSourceMetadata -> Maybe BackendSourceHealthCheckInfo
mkSourceHealthCheck (BackendSourceMetadata AnyBackend SourceMetadata
sourceMetadata) =
      forall (c :: BackendType -> Constraint) (i :: BackendType -> *)
       (j :: BackendType -> *) (f :: * -> *).
(AllBackendsSatisfy c, Functor f) =>
AnyBackend i
-> (forall (b :: BackendType). c b => i b -> f (j b))
-> f (AnyBackend j)
AB.traverseBackend @Backend AnyBackend SourceMetadata
sourceMetadata SourceMetadata b -> Maybe (SourceHealthCheckInfo b)
forall (b :: BackendType).
Backend b =>
SourceMetadata b -> Maybe (SourceHealthCheckInfo b)
forall (b :: BackendType).
SourceMetadata b -> Maybe (SourceHealthCheckInfo b)
mkSourceHealthCheckBackend

    -- 'Nothing' when no health check is defined. See:
    -- https://hasura.io/docs/latest/deployment/health-checks/source-health-check/
    -- We likely choose not to install a default `SELECT 1` health check here,
    -- since we don't want to spam serverless databases.
    mkSourceHealthCheckBackend :: SourceMetadata b -> Maybe (SourceHealthCheckInfo b)
    mkSourceHealthCheckBackend :: forall (b :: BackendType).
SourceMetadata b -> Maybe (SourceHealthCheckInfo b)
mkSourceHealthCheckBackend SourceMetadata b
sourceMetadata =
      let sourceName :: SourceName
sourceName = SourceMetadata b -> SourceName
forall (b :: BackendType). SourceMetadata b -> SourceName
_smName SourceMetadata b
sourceMetadata
          connection :: SourceConnConfiguration b
connection = SourceMetadata b -> SourceConnConfiguration b
forall (b :: BackendType).
SourceMetadata b -> SourceConnConfiguration b
_smConfiguration SourceMetadata b
sourceMetadata
          healthCheck :: Maybe (HealthCheckConfig b)
healthCheck = SourceMetadata b -> Maybe (HealthCheckConfig b)
forall (b :: BackendType).
SourceMetadata b -> Maybe (HealthCheckConfig b)
_smHealthCheckConfig SourceMetadata b
sourceMetadata
       in SourceName
-> SourceConnConfiguration b
-> HealthCheckConfig b
-> SourceHealthCheckInfo b
forall (b :: BackendType).
SourceName
-> SourceConnConfiguration b
-> HealthCheckConfig b
-> SourceHealthCheckInfo b
SourceHealthCheckInfo SourceName
sourceName SourceConnConfiguration b
connection (HealthCheckConfig b -> SourceHealthCheckInfo b)
-> Maybe (HealthCheckConfig b) -> Maybe (SourceHealthCheckInfo b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (HealthCheckConfig b)
healthCheck

-- | Generate cache of source connection details so that we can ping sources for
-- attribution
buildSourcePingCache :: Sources -> SourcePingCache
buildSourcePingCache :: InsOrdHashMap SourceName BackendSourceMetadata -> SourcePingCache
buildSourcePingCache InsOrdHashMap SourceName BackendSourceMetadata
sources =
  [(SourceName, BackendSourcePingInfo)] -> SourcePingCache
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(SourceName, BackendSourcePingInfo)] -> SourcePingCache)
-> [(SourceName, BackendSourcePingInfo)] -> SourcePingCache
forall a b. (a -> b) -> a -> b
$ ((SourceName, BackendSourceMetadata)
 -> (SourceName, BackendSourcePingInfo))
-> [(SourceName, BackendSourceMetadata)]
-> [(SourceName, BackendSourcePingInfo)]
forall a b. (a -> b) -> [a] -> [b]
map ((BackendSourceMetadata -> BackendSourcePingInfo)
-> (SourceName, BackendSourceMetadata)
-> (SourceName, BackendSourcePingInfo)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second BackendSourceMetadata -> BackendSourcePingInfo
mkSourcePing) (InsOrdHashMap SourceName BackendSourceMetadata
-> [(SourceName, BackendSourceMetadata)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList InsOrdHashMap SourceName BackendSourceMetadata
sources)
  where
    mkSourcePing :: BackendSourceMetadata -> BackendSourcePingInfo
    mkSourcePing :: BackendSourceMetadata -> BackendSourcePingInfo
mkSourcePing (BackendSourceMetadata AnyBackend SourceMetadata
sourceMetadata) =
      AnyBackend SourceMetadata
-> (forall (b :: BackendType).
    SourceMetadata b -> SourcePingInfo b)
-> BackendSourcePingInfo
forall (i :: BackendType -> *) (j :: BackendType -> *).
AnyBackend i
-> (forall (b :: BackendType). i b -> j b) -> AnyBackend j
AB.mapBackend AnyBackend SourceMetadata
sourceMetadata SourceMetadata b -> SourcePingInfo b
forall (b :: BackendType). SourceMetadata b -> SourcePingInfo b
mkSourcePingBackend

    mkSourcePingBackend :: SourceMetadata b -> SourcePingInfo b
    mkSourcePingBackend :: forall (b :: BackendType). SourceMetadata b -> SourcePingInfo b
mkSourcePingBackend SourceMetadata b
sourceMetadata =
      let sourceName :: SourceName
sourceName = SourceMetadata b -> SourceName
forall (b :: BackendType). SourceMetadata b -> SourceName
_smName SourceMetadata b
sourceMetadata
          connection :: SourceConnConfiguration b
connection = SourceMetadata b -> SourceConnConfiguration b
forall (b :: BackendType).
SourceMetadata b -> SourceConnConfiguration b
_smConfiguration SourceMetadata b
sourceMetadata
       in SourceName -> SourceConnConfiguration b -> SourcePingInfo b
forall (b :: BackendType).
SourceName -> SourceConnConfiguration b -> SourcePingInfo b
SourcePingInfo SourceName
sourceName SourceConnConfiguration b
connection

partitionCollectedInfo ::
  Seq CollectItem -> ([InconsistentMetadata], [MetadataDependency], [StoredIntrospectionItem])
partitionCollectedInfo :: Seq CollectItem
-> ([InconsistentMetadata], [MetadataDependency],
    [StoredIntrospectionItem])
partitionCollectedInfo =
  let go :: CollectItem -> s -> t
go CollectItem
item = case CollectItem
item of
        CollectInconsistentMetadata InconsistentMetadata
inconsistentMetadata ->
          ([InconsistentMetadata] -> Identity [InconsistentMetadata])
-> s -> Identity t
forall s t a b. Field1 s t a b => Lens s t a b
Lens s t [InconsistentMetadata] [InconsistentMetadata]
_1 (([InconsistentMetadata] -> Identity [InconsistentMetadata])
 -> s -> Identity t)
-> ([InconsistentMetadata] -> [InconsistentMetadata]) -> s -> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([InconsistentMetadata
inconsistentMetadata] [InconsistentMetadata]
-> [InconsistentMetadata] -> [InconsistentMetadata]
forall a. Semigroup a => a -> a -> a
<>)
        CollectMetadataDependency MetadataDependency
dependency ->
          ([MetadataDependency] -> Identity [MetadataDependency])
-> s -> Identity t
forall s t a b. Field2 s t a b => Lens s t a b
Lens s t [MetadataDependency] [MetadataDependency]
_2 (([MetadataDependency] -> Identity [MetadataDependency])
 -> s -> Identity t)
-> ([MetadataDependency] -> [MetadataDependency]) -> s -> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([MetadataDependency
dependency] [MetadataDependency]
-> [MetadataDependency] -> [MetadataDependency]
forall a. Semigroup a => a -> a -> a
<>)
        CollectStoredIntrospection StoredIntrospectionItem
storedIntrospection ->
          ([StoredIntrospectionItem] -> Identity [StoredIntrospectionItem])
-> s -> Identity t
forall s t a b. Field3 s t a b => Lens s t a b
Lens s t [StoredIntrospectionItem] [StoredIntrospectionItem]
_3 (([StoredIntrospectionItem] -> Identity [StoredIntrospectionItem])
 -> s -> Identity t)
-> ([StoredIntrospectionItem] -> [StoredIntrospectionItem])
-> s
-> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([StoredIntrospectionItem
storedIntrospection] [StoredIntrospectionItem]
-> [StoredIntrospectionItem] -> [StoredIntrospectionItem]
forall a. Semigroup a => a -> a -> a
<>)
   in (CollectItem
 -> ([InconsistentMetadata], [MetadataDependency],
     [StoredIntrospectionItem])
 -> ([InconsistentMetadata], [MetadataDependency],
     [StoredIntrospectionItem]))
-> ([InconsistentMetadata], [MetadataDependency],
    [StoredIntrospectionItem])
-> [CollectItem]
-> ([InconsistentMetadata], [MetadataDependency],
    [StoredIntrospectionItem])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CollectItem
-> ([InconsistentMetadata], [MetadataDependency],
    [StoredIntrospectionItem])
-> ([InconsistentMetadata], [MetadataDependency],
    [StoredIntrospectionItem])
forall {s} {t}.
(Field1 s t [InconsistentMetadata] [InconsistentMetadata],
 Field2 s t [MetadataDependency] [MetadataDependency],
 Field3 s t [StoredIntrospectionItem] [StoredIntrospectionItem]) =>
CollectItem -> s -> t
go ([], [], []) ([CollectItem]
 -> ([InconsistentMetadata], [MetadataDependency],
     [StoredIntrospectionItem]))
-> (Seq CollectItem -> [CollectItem])
-> Seq CollectItem
-> ([InconsistentMetadata], [MetadataDependency],
    [StoredIntrospectionItem])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq CollectItem -> [CollectItem]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

buildSourcesIntrospectionStatus ::
  Sources -> RemoteSchemas -> [StoredIntrospectionItem] -> SourcesIntrospectionStatus
buildSourcesIntrospectionStatus :: InsOrdHashMap SourceName BackendSourceMetadata
-> RemoteSchemas
-> [StoredIntrospectionItem]
-> SourcesIntrospectionStatus
buildSourcesIntrospectionStatus InsOrdHashMap SourceName BackendSourceMetadata
sourcesMetadata RemoteSchemas
remoteSchemasMetadata = \case
  [] -> SourcesIntrospectionStatus
SourcesIntrospectionUnchanged
  [StoredIntrospectionItem]
items ->
    let go :: StoredIntrospectionItem
-> ([(SourceName, EncJSON)], [(RemoteSchemaName, EncJSON)])
-> ([(SourceName, EncJSON)], [(RemoteSchemaName, EncJSON)])
go StoredIntrospectionItem
item ([(SourceName, EncJSON)]
sources, [(RemoteSchemaName, EncJSON)]
remoteSchemas) = case StoredIntrospectionItem
item of
          SourceIntrospectionItem SourceName
name EncJSON
introspection ->
            ([(SourceName, EncJSON)]
sources [(SourceName, EncJSON)]
-> [(SourceName, EncJSON)] -> [(SourceName, EncJSON)]
forall a. Semigroup a => a -> a -> a
<> [(SourceName
name, EncJSON
introspection)], [(RemoteSchemaName, EncJSON)]
remoteSchemas)
          RemoteSchemaIntrospectionItem RemoteSchemaName
name EncJSON
introspection ->
            ([(SourceName, EncJSON)]
sources, [(RemoteSchemaName, EncJSON)]
remoteSchemas [(RemoteSchemaName, EncJSON)]
-> [(RemoteSchemaName, EncJSON)] -> [(RemoteSchemaName, EncJSON)]
forall a. Semigroup a => a -> a -> a
<> [(RemoteSchemaName
name, EncJSON
introspection)])
        ([(SourceName, EncJSON)]
allSources, [(RemoteSchemaName, EncJSON)]
allRemoteSchemas) = (StoredIntrospectionItem
 -> ([(SourceName, EncJSON)], [(RemoteSchemaName, EncJSON)])
 -> ([(SourceName, EncJSON)], [(RemoteSchemaName, EncJSON)]))
-> ([(SourceName, EncJSON)], [(RemoteSchemaName, EncJSON)])
-> [StoredIntrospectionItem]
-> ([(SourceName, EncJSON)], [(RemoteSchemaName, EncJSON)])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr StoredIntrospectionItem
-> ([(SourceName, EncJSON)], [(RemoteSchemaName, EncJSON)])
-> ([(SourceName, EncJSON)], [(RemoteSchemaName, EncJSON)])
go ([], []) [StoredIntrospectionItem]
items
        storedIntrospection :: StoredIntrospection
storedIntrospection = HashMap SourceName EncJSON
-> HashMap RemoteSchemaName EncJSON -> StoredIntrospection
StoredIntrospection ([(SourceName, EncJSON)] -> HashMap SourceName EncJSON
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(SourceName, EncJSON)]
allSources) ([(RemoteSchemaName, EncJSON)] -> HashMap RemoteSchemaName EncJSON
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(RemoteSchemaName, EncJSON)]
allRemoteSchemas)
     in if [(SourceName, EncJSON)] -> [(RemoteSchemaName, EncJSON)] -> Bool
forall sourceIntrospection remoteSchemaIntrospection.
[(SourceName, sourceIntrospection)]
-> [(RemoteSchemaName, remoteSchemaIntrospection)] -> Bool
allSourcesAndRemoteSchemasCollected [(SourceName, EncJSON)]
allSources [(RemoteSchemaName, EncJSON)]
allRemoteSchemas
          then StoredIntrospection -> SourcesIntrospectionStatus
SourcesIntrospectionChangedFull StoredIntrospection
storedIntrospection
          else StoredIntrospection -> SourcesIntrospectionStatus
SourcesIntrospectionChangedPartial StoredIntrospection
storedIntrospection
  where
    allSourcesAndRemoteSchemasCollected ::
      [(SourceName, sourceIntrospection)] ->
      [(RemoteSchemaName, remoteSchemaIntrospection)] ->
      Bool
    allSourcesAndRemoteSchemasCollected :: forall sourceIntrospection remoteSchemaIntrospection.
[(SourceName, sourceIntrospection)]
-> [(RemoteSchemaName, remoteSchemaIntrospection)] -> Bool
allSourcesAndRemoteSchemasCollected [(SourceName, sourceIntrospection)]
sources [(RemoteSchemaName, remoteSchemaIntrospection)]
remoteSchemas =
      [SourceName]
-> InsOrdHashMap SourceName BackendSourceMetadata -> Bool
forall a b. Hashable a => [a] -> InsOrdHashMap a b -> Bool
allPresent (((SourceName, sourceIntrospection) -> SourceName)
-> [(SourceName, sourceIntrospection)] -> [SourceName]
forall a b. (a -> b) -> [a] -> [b]
map (SourceName, sourceIntrospection) -> SourceName
forall a b. (a, b) -> a
fst [(SourceName, sourceIntrospection)]
sources) InsOrdHashMap SourceName BackendSourceMetadata
sourcesMetadata
        Bool -> Bool -> Bool
&& [RemoteSchemaName] -> RemoteSchemas -> Bool
forall a b. Hashable a => [a] -> InsOrdHashMap a b -> Bool
allPresent (((RemoteSchemaName, remoteSchemaIntrospection) -> RemoteSchemaName)
-> [(RemoteSchemaName, remoteSchemaIntrospection)]
-> [RemoteSchemaName]
forall a b. (a -> b) -> [a] -> [b]
map (RemoteSchemaName, remoteSchemaIntrospection) -> RemoteSchemaName
forall a b. (a, b) -> a
fst [(RemoteSchemaName, remoteSchemaIntrospection)]
remoteSchemas) RemoteSchemas
remoteSchemasMetadata

    allPresent :: (Hashable a) => [a] -> InsOrdHashMap a b -> Bool
    allPresent :: forall a b. Hashable a => [a] -> InsOrdHashMap a b -> Bool
allPresent [a]
list = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
list) ([a] -> Bool)
-> (InsOrdHashMap a b -> [a]) -> InsOrdHashMap a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsOrdHashMap a b -> [a]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys

{- Note [Avoiding GraphQL schema rebuilds when changing irrelevant Metadata]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
There are many Metadata operations that don't influence the GraphQL schema.  So
we should be caching its construction.

The `Hasura.Incremental` framework allows us to cache such constructions:
whenever we have an arrow `Rule m a b`, where `a` is the input to the arrow and
`b` the output, we can use the `Inc.cache` combinator to obtain a new arrow
which is only re-executed when the input `a` changes in a material way.  To test
this, `a` needs an `Eq` instance.

We can't simply apply `Inc.cache` to the GraphQL schema cache building phase
(`buildGQLContext`), because the inputs (components of `BuildOutputs` such as
`SourceCache`) don't have an `Eq` instance.

So the purpose of `buildOutputsAndSchema` is that we cach already at an earlier
point, encompassing more computation.  The Metadata and invalidation keys (which
have `Eq` instances) are used as a caching key, and `Inc.cache` can be applied
to the whole sequence of steps.

But because of the all-or-nothing nature of caching, it's important that
`buildOutputsAndSchema` is re-run as little as possible.  So the exercise
becomes to minimize the amount of stuff stored in `BuildOutputs`, so that as
many Metadata operations as possible can be handled outside of this codepath
that produces a GraphQL schema.
-}

buildSchemaCacheRule ::
  -- Note: by supplying BuildReason via MonadReader, it does not participate in caching, which is
  -- what we want!
  ( ArrowChoice arr,
    Inc.ArrowDistribute arr,
    Inc.ArrowCache m arr,
    MonadIO m,
    MonadBaseControl IO m,
    MonadError QErr m,
    MonadReader BuildReason m,
    ProvidesNetwork m,
    MonadResolveSource m,
    HasCacheStaticConfig m
  ) =>
  Logger Hasura ->
  Env.Environment ->
  Maybe SchemaRegistryContext ->
  (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys, Maybe StoredIntrospection) `arr` (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
buildSchemaCacheRule :: forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowDistribute arr, ArrowCache m arr, MonadIO m,
 MonadBaseControl IO m, MonadError QErr m,
 MonadReader BuildReason m, ProvidesNetwork m, MonadResolveSource m,
 HasCacheStaticConfig m) =>
Logger Hasura
-> Environment
-> Maybe SchemaRegistryContext
-> arr
     (MetadataWithResourceVersion, CacheDynamicConfig, InvalidationKeys,
      Maybe StoredIntrospection)
     (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
buildSchemaCacheRule Logger Hasura
logger Environment
env Maybe SchemaRegistryContext
mSchemaRegistryContext = proc (MetadataWithResourceVersion Metadata
metadataNoDefaults MetadataResourceVersion
interimMetadataResourceVersion, CacheDynamicConfig
dynamicConfig, InvalidationKeys
invalidationKeys, Maybe StoredIntrospection
storedIntrospection) -> do
  Dependency InvalidationKeys
invalidationKeysDep <- arr InvalidationKeys (Dependency InvalidationKeys)
forall a. arr a (Dependency a)
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowCache m arr =>
arr a (Dependency a)
Inc.newDependency -< InvalidationKeys
invalidationKeys
  let metadataDefaults :: MetadataDefaults
metadataDefaults = CacheDynamicConfig -> MetadataDefaults
_cdcMetadataDefaults CacheDynamicConfig
dynamicConfig
      metadata :: Metadata
metadata@Metadata {Network
QueryCollections
MetadataAllowlist
Endpoints
InheritedRoles
InsOrdHashMap SourceName BackendSourceMetadata
RemoteSchemas
CronTriggers
Actions
OpenTelemetryConfig
SetGraphqlIntrospectionOptions
MetricsConfig
ApiLimit
BackendMap BackendConfigWrapper
CustomTypes
_metaSources :: InsOrdHashMap SourceName BackendSourceMetadata
_metaRemoteSchemas :: RemoteSchemas
_metaQueryCollections :: QueryCollections
_metaAllowlist :: MetadataAllowlist
_metaCustomTypes :: CustomTypes
_metaActions :: Actions
_metaCronTriggers :: CronTriggers
_metaRestEndpoints :: Endpoints
_metaApiLimits :: ApiLimit
_metaMetricsConfig :: MetricsConfig
_metaInheritedRoles :: InheritedRoles
_metaSetGraphqlIntrospectionOptions :: SetGraphqlIntrospectionOptions
_metaNetwork :: Network
_metaBackendConfigs :: BackendMap BackendConfigWrapper
_metaOpenTelemetryConfig :: OpenTelemetryConfig
_metaSources :: Metadata -> InsOrdHashMap SourceName BackendSourceMetadata
_metaRemoteSchemas :: Metadata -> RemoteSchemas
_metaQueryCollections :: Metadata -> QueryCollections
_metaAllowlist :: Metadata -> MetadataAllowlist
_metaCustomTypes :: Metadata -> CustomTypes
_metaActions :: Metadata -> Actions
_metaCronTriggers :: Metadata -> CronTriggers
_metaRestEndpoints :: Metadata -> Endpoints
_metaApiLimits :: Metadata -> ApiLimit
_metaMetricsConfig :: Metadata -> MetricsConfig
_metaInheritedRoles :: Metadata -> InheritedRoles
_metaSetGraphqlIntrospectionOptions :: Metadata -> SetGraphqlIntrospectionOptions
_metaNetwork :: Metadata -> Network
_metaBackendConfigs :: Metadata -> BackendMap BackendConfigWrapper
_metaOpenTelemetryConfig :: Metadata -> OpenTelemetryConfig
..} = Metadata -> MetadataDefaults -> Metadata
overrideMetadataDefaults Metadata
metadataNoDefaults MetadataDefaults
metadataDefaults
  Dependency Metadata
metadataDep <- arr Metadata (Dependency Metadata)
forall a. arr a (Dependency a)
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowCache m arr =>
arr a (Dependency a)
Inc.newDependency -< Metadata
metadata

  ([InconsistentMetadata]
inconsistentObjects, [StoredIntrospectionItem]
storedIntrospections, (BuildOutputs
resolvedOutputs, [InconsistentMetadata]
dependencyInconsistentObjects, DepMap
resolvedDependencies), ((SchemaIntrospection
adminIntrospection, HashMap RoleName (RoleContext GQLContext)
gqlContext, GQLContext
gqlContextUnauth, HashSet InconsistentMetadata
inconsistentRemoteSchemas), (HashMap RoleName (RoleContext GQLContext)
relayContext, GQLContext
relayContextUnauth), SchemaRegistryAction
schemaRegistryAction)) <-
    arr
  (Dependency Metadata, CacheDynamicConfig,
   Dependency InvalidationKeys, Maybe StoredIntrospection)
  ([InconsistentMetadata], [StoredIntrospectionItem],
   (BuildOutputs, [InconsistentMetadata], DepMap),
   ((SchemaIntrospection, HashMap RoleName (RoleContext GQLContext),
     GQLContext, HashSet InconsistentMetadata),
    (HashMap RoleName (RoleContext GQLContext), GQLContext),
    SchemaRegistryAction))
-> arr
     (Dependency Metadata, CacheDynamicConfig,
      Dependency InvalidationKeys, Maybe StoredIntrospection)
     ([InconsistentMetadata], [StoredIntrospectionItem],
      (BuildOutputs, [InconsistentMetadata], DepMap),
      ((SchemaIntrospection, HashMap RoleName (RoleContext GQLContext),
        GQLContext, HashSet InconsistentMetadata),
       (HashMap RoleName (RoleContext GQLContext), GQLContext),
       SchemaRegistryAction))
forall a b. (Given Accesses => Eq a) => arr a b -> arr a b
forall (m :: * -> *) (arr :: * -> * -> *) a b.
(ArrowCache m arr, Given Accesses => Eq a) =>
arr a b -> arr a b
Inc.cache arr
  (Dependency Metadata, CacheDynamicConfig,
   Dependency InvalidationKeys, Maybe StoredIntrospection)
  ([InconsistentMetadata], [StoredIntrospectionItem],
   (BuildOutputs, [InconsistentMetadata], DepMap),
   ((SchemaIntrospection, HashMap RoleName (RoleContext GQLContext),
     GQLContext, HashSet InconsistentMetadata),
    (HashMap RoleName (RoleContext GQLContext), GQLContext),
    SchemaRegistryAction))
buildOutputsAndSchema -< (Dependency Metadata
metadataDep, CacheDynamicConfig
dynamicConfig, Dependency InvalidationKeys
invalidationKeysDep, Maybe StoredIntrospection
storedIntrospection)

  let storedIntrospectionStatus :: SourcesIntrospectionStatus
storedIntrospectionStatus = InsOrdHashMap SourceName BackendSourceMetadata
-> RemoteSchemas
-> [StoredIntrospectionItem]
-> SourcesIntrospectionStatus
buildSourcesIntrospectionStatus InsOrdHashMap SourceName BackendSourceMetadata
_metaSources RemoteSchemas
_metaRemoteSchemas [StoredIntrospectionItem]
storedIntrospections
      (HashMap EndpointName (EndpointMetadata GQLQueryWithText)
resolvedEndpoints, Seq CollectItem
endpointCollectedInfo) = Identity
  (HashMap EndpointName (EndpointMetadata GQLQueryWithText),
   Seq CollectItem)
-> (HashMap EndpointName (EndpointMetadata GQLQueryWithText),
    Seq CollectItem)
forall a. Identity a -> a
runIdentity (Identity
   (HashMap EndpointName (EndpointMetadata GQLQueryWithText),
    Seq CollectItem)
 -> (HashMap EndpointName (EndpointMetadata GQLQueryWithText),
     Seq CollectItem))
-> Identity
     (HashMap EndpointName (EndpointMetadata GQLQueryWithText),
      Seq CollectItem)
-> (HashMap EndpointName (EndpointMetadata GQLQueryWithText),
    Seq CollectItem)
forall a b. (a -> b) -> a -> b
$ WriterT
  (Seq CollectItem)
  Identity
  (HashMap EndpointName (EndpointMetadata GQLQueryWithText))
-> Identity
     (HashMap EndpointName (EndpointMetadata GQLQueryWithText),
      Seq CollectItem)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT
   (Seq CollectItem)
   Identity
   (HashMap EndpointName (EndpointMetadata GQLQueryWithText))
 -> Identity
      (HashMap EndpointName (EndpointMetadata GQLQueryWithText),
       Seq CollectItem))
-> WriterT
     (Seq CollectItem)
     Identity
     (HashMap EndpointName (EndpointMetadata GQLQueryWithText))
-> Identity
     (HashMap EndpointName (EndpointMetadata GQLQueryWithText),
      Seq CollectItem)
forall a b. (a -> b) -> a -> b
$ QueryCollections
-> [CreateEndpoint]
-> WriterT
     (Seq CollectItem)
     Identity
     (HashMap EndpointName (EndpointMetadata GQLQueryWithText))
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
QueryCollections
-> [CreateEndpoint]
-> m (HashMap EndpointName (EndpointMetadata GQLQueryWithText))
buildRESTEndpoints QueryCollections
_metaQueryCollections (Endpoints -> [CreateEndpoint]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems Endpoints
_metaRestEndpoints)
      (HashMap TriggerName CronTriggerInfo
cronTriggersMap, Seq CollectItem
cronTriggersCollectedInfo) = Identity (HashMap TriggerName CronTriggerInfo, Seq CollectItem)
-> (HashMap TriggerName CronTriggerInfo, Seq CollectItem)
forall a. Identity a -> a
runIdentity (Identity (HashMap TriggerName CronTriggerInfo, Seq CollectItem)
 -> (HashMap TriggerName CronTriggerInfo, Seq CollectItem))
-> Identity (HashMap TriggerName CronTriggerInfo, Seq CollectItem)
-> (HashMap TriggerName CronTriggerInfo, Seq CollectItem)
forall a b. (a -> b) -> a -> b
$ WriterT
  (Seq CollectItem) Identity (HashMap TriggerName CronTriggerInfo)
-> Identity (HashMap TriggerName CronTriggerInfo, Seq CollectItem)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT
   (Seq CollectItem) Identity (HashMap TriggerName CronTriggerInfo)
 -> Identity (HashMap TriggerName CronTriggerInfo, Seq CollectItem))
-> WriterT
     (Seq CollectItem) Identity (HashMap TriggerName CronTriggerInfo)
-> Identity (HashMap TriggerName CronTriggerInfo, Seq CollectItem)
forall a b. (a -> b) -> a -> b
$ [CronTriggerMetadata]
-> WriterT
     (Seq CollectItem) Identity (HashMap TriggerName CronTriggerInfo)
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
[CronTriggerMetadata] -> m (HashMap TriggerName CronTriggerInfo)
buildCronTriggers (CronTriggers -> [CronTriggerMetadata]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems CronTriggers
_metaCronTriggers)
      (OpenTelemetryInfo
openTelemetryInfo, Seq CollectItem
openTelemetryCollectedInfo) = Identity (OpenTelemetryInfo, Seq CollectItem)
-> (OpenTelemetryInfo, Seq CollectItem)
forall a. Identity a -> a
runIdentity (Identity (OpenTelemetryInfo, Seq CollectItem)
 -> (OpenTelemetryInfo, Seq CollectItem))
-> Identity (OpenTelemetryInfo, Seq CollectItem)
-> (OpenTelemetryInfo, Seq CollectItem)
forall a b. (a -> b) -> a -> b
$ WriterT (Seq CollectItem) Identity OpenTelemetryInfo
-> Identity (OpenTelemetryInfo, Seq CollectItem)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT (Seq CollectItem) Identity OpenTelemetryInfo
 -> Identity (OpenTelemetryInfo, Seq CollectItem))
-> WriterT (Seq CollectItem) Identity OpenTelemetryInfo
-> Identity (OpenTelemetryInfo, Seq CollectItem)
forall a b. (a -> b) -> a -> b
$ OpenTelemetryConfig
-> WriterT (Seq CollectItem) Identity OpenTelemetryInfo
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
OpenTelemetryConfig -> m OpenTelemetryInfo
buildOpenTelemetry OpenTelemetryConfig
_metaOpenTelemetryConfig

      duplicateVariables :: EndpointMetadata a -> Bool
      duplicateVariables :: forall a. EndpointMetadata a -> Bool
duplicateVariables EndpointMetadata a
m = ([Text] -> Bool) -> [[Text]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Int -> Bool) -> ([Text] -> Int) -> [Text] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[Text]] -> Bool) -> [[Text]] -> Bool
forall a b. (a -> b) -> a -> b
$ [Text] -> [[Text]]
forall a. Eq a => [a] -> [[a]]
group ([Text] -> [[Text]]) -> [Text] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes ([Maybe Text] -> [Text]) -> [Maybe Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe Text)
-> (Text -> Maybe Text) -> EndpointUrl -> [Maybe Text]
forall a. (Text -> a) -> (Text -> a) -> EndpointUrl -> [a]
splitPath Text -> Maybe Text
forall a. a -> Maybe a
Just (Maybe Text -> Text -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) (EndpointMetadata a -> EndpointUrl
forall query. EndpointMetadata query -> EndpointUrl
_ceUrl EndpointMetadata a
m)

      endpointObjId :: EndpointMetadata q -> MetadataObjId
      endpointObjId :: forall q. EndpointMetadata q -> MetadataObjId
endpointObjId EndpointMetadata q
md = EndpointName -> MetadataObjId
MOEndpoint (EndpointMetadata q -> EndpointName
forall query. EndpointMetadata query -> EndpointName
_ceName EndpointMetadata q
md)

      endpointObject :: EndpointMetadata q -> MetadataObject
      endpointObject :: forall q. EndpointMetadata q -> MetadataObject
endpointObject EndpointMetadata q
md = MetadataObjId -> Value -> MetadataObject
MetadataObject (EndpointMetadata q -> MetadataObjId
forall q. EndpointMetadata q -> MetadataObjId
endpointObjId EndpointMetadata q
md) (Maybe CreateEndpoint -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe CreateEndpoint -> Value) -> Maybe CreateEndpoint -> Value
forall a b. (a -> b) -> a -> b
$ EndpointName -> Endpoints -> Maybe CreateEndpoint
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup (EndpointMetadata q -> EndpointName
forall query. EndpointMetadata query -> EndpointName
_ceName EndpointMetadata q
md) Endpoints
_metaRestEndpoints)

      listedQueryObjects :: (CollectionName, ListedQuery) -> MetadataObject
      listedQueryObjects :: (CollectionName, ListedQuery) -> MetadataObject
listedQueryObjects (CollectionName
cName, ListedQuery
lq) = MetadataObjId -> Value -> MetadataObject
MetadataObject (CollectionName -> ListedQuery -> MetadataObjId
MOQueryCollectionsQuery CollectionName
cName ListedQuery
lq) (ListedQuery -> Value
forall a. ToJSON a => a -> Value
toJSON ListedQuery
lq)

      --  Cases of urls that generate invalid segments:

      hasInvalidSegments :: EndpointMetadata query -> Bool
      hasInvalidSegments :: forall a. EndpointMetadata a -> Bool
hasInvalidSegments EndpointMetadata query
m = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"", Text
":"]) ((Text -> Text) -> (Text -> Text) -> EndpointUrl -> [Text]
forall a. (Text -> a) -> (Text -> a) -> EndpointUrl -> [a]
splitPath Text -> Text
forall a. a -> a
id Text -> Text
forall a. a -> a
id (EndpointMetadata query -> EndpointUrl
forall query. EndpointMetadata query -> EndpointUrl
_ceUrl EndpointMetadata query
m))

      ceUrlTxt :: EndpointMetadata query -> Text
ceUrlTxt = EndpointUrl -> Text
forall a. ToTxt a => a -> Text
toTxt (EndpointUrl -> Text)
-> (EndpointMetadata query -> EndpointUrl)
-> EndpointMetadata query
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndpointMetadata query -> EndpointUrl
forall query. EndpointMetadata query -> EndpointUrl
_ceUrl

      endpoints :: EndpointTrie GQLQueryWithText
endpoints = [EndpointMetadata GQLQueryWithText]
-> EndpointTrie GQLQueryWithText
forall query.
Ord query =>
[EndpointMetadata query] -> EndpointTrie query
buildEndpointsTrie (HashMap EndpointName (EndpointMetadata GQLQueryWithText)
-> [EndpointMetadata GQLQueryWithText]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap EndpointName (EndpointMetadata GQLQueryWithText)
resolvedEndpoints)

      duplicateF :: EndpointMetadata q -> InconsistentMetadata
duplicateF EndpointMetadata q
md = Text -> MetadataObject -> InconsistentMetadata
DuplicateRestVariables (EndpointMetadata q -> Text
forall {query}. EndpointMetadata query -> Text
ceUrlTxt EndpointMetadata q
md) (EndpointMetadata q -> MetadataObject
forall q. EndpointMetadata q -> MetadataObject
endpointObject EndpointMetadata q
md)
      duplicateRestVariables :: [InconsistentMetadata]
duplicateRestVariables = (EndpointMetadata GQLQueryWithText -> InconsistentMetadata)
-> [EndpointMetadata GQLQueryWithText] -> [InconsistentMetadata]
forall a b. (a -> b) -> [a] -> [b]
map EndpointMetadata GQLQueryWithText -> InconsistentMetadata
forall {q}. EndpointMetadata q -> InconsistentMetadata
duplicateF ([EndpointMetadata GQLQueryWithText] -> [InconsistentMetadata])
-> [EndpointMetadata GQLQueryWithText] -> [InconsistentMetadata]
forall a b. (a -> b) -> a -> b
$ (EndpointMetadata GQLQueryWithText -> Bool)
-> [EndpointMetadata GQLQueryWithText]
-> [EndpointMetadata GQLQueryWithText]
forall a. (a -> Bool) -> [a] -> [a]
filter EndpointMetadata GQLQueryWithText -> Bool
forall a. EndpointMetadata a -> Bool
duplicateVariables (HashMap EndpointName (EndpointMetadata GQLQueryWithText)
-> [EndpointMetadata GQLQueryWithText]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap EndpointName (EndpointMetadata GQLQueryWithText)
resolvedEndpoints)

      invalidF :: EndpointMetadata q -> InconsistentMetadata
invalidF EndpointMetadata q
md = Text -> MetadataObject -> InconsistentMetadata
InvalidRestSegments (EndpointMetadata q -> Text
forall {query}. EndpointMetadata query -> Text
ceUrlTxt EndpointMetadata q
md) (EndpointMetadata q -> MetadataObject
forall q. EndpointMetadata q -> MetadataObject
endpointObject EndpointMetadata q
md)
      invalidRestSegments :: [InconsistentMetadata]
invalidRestSegments = (EndpointMetadata GQLQueryWithText -> InconsistentMetadata)
-> [EndpointMetadata GQLQueryWithText] -> [InconsistentMetadata]
forall a b. (a -> b) -> [a] -> [b]
map EndpointMetadata GQLQueryWithText -> InconsistentMetadata
forall {q}. EndpointMetadata q -> InconsistentMetadata
invalidF ([EndpointMetadata GQLQueryWithText] -> [InconsistentMetadata])
-> [EndpointMetadata GQLQueryWithText] -> [InconsistentMetadata]
forall a b. (a -> b) -> a -> b
$ (EndpointMetadata GQLQueryWithText -> Bool)
-> [EndpointMetadata GQLQueryWithText]
-> [EndpointMetadata GQLQueryWithText]
forall a. (a -> Bool) -> [a] -> [a]
filter EndpointMetadata GQLQueryWithText -> Bool
forall a. EndpointMetadata a -> Bool
hasInvalidSegments (HashMap EndpointName (EndpointMetadata GQLQueryWithText)
-> [EndpointMetadata GQLQueryWithText]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap EndpointName (EndpointMetadata GQLQueryWithText)
resolvedEndpoints)

      ambiguousF' :: EndpointMetadata q -> MetadataObject
ambiguousF' EndpointMetadata q
ep = MetadataObjId -> Value -> MetadataObject
MetadataObject (EndpointMetadata q -> MetadataObjId
forall q. EndpointMetadata q -> MetadataObjId
endpointObjId EndpointMetadata q
ep) (EndpointMetadata q -> Value
forall a. ToJSON a => a -> Value
toJSON EndpointMetadata q
ep)
      ambiguousF :: [EndpointMetadata q] -> InconsistentMetadata
ambiguousF [EndpointMetadata q]
mds = Text -> [MetadataObject] -> InconsistentMetadata
AmbiguousRestEndpoints ([EndpointUrl] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated ([EndpointUrl] -> Text) -> [EndpointUrl] -> Text
forall a b. (a -> b) -> a -> b
$ (EndpointMetadata q -> EndpointUrl)
-> [EndpointMetadata q] -> [EndpointUrl]
forall a b. (a -> b) -> [a] -> [b]
map EndpointMetadata q -> EndpointUrl
forall query. EndpointMetadata query -> EndpointUrl
_ceUrl [EndpointMetadata q]
mds) ((EndpointMetadata q -> MetadataObject)
-> [EndpointMetadata q] -> [MetadataObject]
forall a b. (a -> b) -> [a] -> [b]
map EndpointMetadata q -> MetadataObject
forall {q}. ToJSON q => EndpointMetadata q -> MetadataObject
ambiguousF' [EndpointMetadata q]
mds)
      ambiguousRestEndpoints :: [InconsistentMetadata]
ambiguousRestEndpoints = ((Set [PathComponent Text],
  Set (EndpointMetadata GQLQueryWithText))
 -> InconsistentMetadata)
-> [(Set [PathComponent Text],
     Set (EndpointMetadata GQLQueryWithText))]
-> [InconsistentMetadata]
forall a b. (a -> b) -> [a] -> [b]
map ([EndpointMetadata GQLQueryWithText] -> InconsistentMetadata
forall {q}.
ToJSON q =>
[EndpointMetadata q] -> InconsistentMetadata
ambiguousF ([EndpointMetadata GQLQueryWithText] -> InconsistentMetadata)
-> ((Set [PathComponent Text],
     Set (EndpointMetadata GQLQueryWithText))
    -> [EndpointMetadata GQLQueryWithText])
-> (Set [PathComponent Text],
    Set (EndpointMetadata GQLQueryWithText))
-> InconsistentMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (EndpointMetadata GQLQueryWithText)
-> [EndpointMetadata GQLQueryWithText]
forall a. Set a -> [a]
S.elems (Set (EndpointMetadata GQLQueryWithText)
 -> [EndpointMetadata GQLQueryWithText])
-> ((Set [PathComponent Text],
     Set (EndpointMetadata GQLQueryWithText))
    -> Set (EndpointMetadata GQLQueryWithText))
-> (Set [PathComponent Text],
    Set (EndpointMetadata GQLQueryWithText))
-> [EndpointMetadata GQLQueryWithText]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set [PathComponent Text], Set (EndpointMetadata GQLQueryWithText))
-> Set (EndpointMetadata GQLQueryWithText)
forall a b. (a, b) -> b
snd) ([(Set [PathComponent Text],
   Set (EndpointMetadata GQLQueryWithText))]
 -> [InconsistentMetadata])
-> [(Set [PathComponent Text],
     Set (EndpointMetadata GQLQueryWithText))]
-> [InconsistentMetadata]
forall a b. (a -> b) -> a -> b
$ EndpointTrie GQLQueryWithText
-> [(Set [PathComponent Text],
     Set (EndpointMetadata GQLQueryWithText))]
forall a k v.
(Hashable a, Hashable k, Ord v, Ord a) =>
MultiMapPathTrie a k v -> [(Set [PathComponent a], Set v)]
ambiguousPathsGrouped EndpointTrie GQLQueryWithText
endpoints

      inlinedAllowlist :: InlinedAllowlist
inlinedAllowlist = QueryCollections -> MetadataAllowlist -> InlinedAllowlist
inlineAllowlist QueryCollections
_metaQueryCollections MetadataAllowlist
_metaAllowlist
      globalAllowLists :: [NormalizedQuery]
globalAllowLists = HashSet NormalizedQuery -> [NormalizedQuery]
forall a. HashSet a -> [a]
HS.toList (HashSet NormalizedQuery -> [NormalizedQuery])
-> (InlinedAllowlist -> HashSet NormalizedQuery)
-> InlinedAllowlist
-> [NormalizedQuery]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InlinedAllowlist -> HashSet NormalizedQuery
iaGlobal (InlinedAllowlist -> [NormalizedQuery])
-> InlinedAllowlist -> [NormalizedQuery]
forall a b. (a -> b) -> a -> b
$ InlinedAllowlist
inlinedAllowlist

      -- Endpoints don't generate any dependencies
      ([InconsistentMetadata]
endpointInconsistencies, [MetadataDependency]
_, [StoredIntrospectionItem]
_) = Seq CollectItem
-> ([InconsistentMetadata], [MetadataDependency],
    [StoredIntrospectionItem])
partitionCollectedInfo Seq CollectItem
endpointCollectedInfo

      -- Cron triggers don't generate any dependencies
      ([InconsistentMetadata]
cronTriggersInconsistencies, [MetadataDependency]
_, [StoredIntrospectionItem]
_) = Seq CollectItem
-> ([InconsistentMetadata], [MetadataDependency],
    [StoredIntrospectionItem])
partitionCollectedInfo Seq CollectItem
cronTriggersCollectedInfo

      -- OpenTelemerty doesn't generate any dependencies
      ([InconsistentMetadata]
openTelemetryInconsistencies, [MetadataDependency]
_, [StoredIntrospectionItem]
_) = Seq CollectItem
-> ([InconsistentMetadata], [MetadataDependency],
    [StoredIntrospectionItem])
partitionCollectedInfo Seq CollectItem
openTelemetryCollectedInfo

      inconsistentQueryCollections :: [InconsistentMetadata]
inconsistentQueryCollections = SchemaIntrospection
-> QueryCollections
-> ((CollectionName, ListedQuery) -> MetadataObject)
-> EndpointTrie GQLQueryWithText
-> [NormalizedQuery]
-> [InconsistentMetadata]
getInconsistentQueryCollections SchemaIntrospection
adminIntrospection QueryCollections
_metaQueryCollections (CollectionName, ListedQuery) -> MetadataObject
listedQueryObjects EndpointTrie GQLQueryWithText
endpoints [NormalizedQuery]
globalAllowLists

  let schemaCache :: SchemaCache
schemaCache =
        SchemaCache
          { scSources :: SourceCache
scSources = BuildOutputs -> SourceCache
_boSources BuildOutputs
resolvedOutputs,
            scActions :: ActionCache
scActions = BuildOutputs -> ActionCache
_boActions BuildOutputs
resolvedOutputs,
            -- TODO this is not the right value: we should track what part of the schema
            -- we can stitch without consistencies, I think.
            scRemoteSchemas :: RemoteSchemaMap
scRemoteSchemas = ((RemoteSchemaCtx, MetadataObject) -> RemoteSchemaCtx)
-> HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
-> RemoteSchemaMap
forall a b.
(a -> b)
-> HashMap RemoteSchemaName a -> HashMap RemoteSchemaName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RemoteSchemaCtx, MetadataObject) -> RemoteSchemaCtx
forall a b. (a, b) -> a
fst (BuildOutputs
-> HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
_boRemoteSchemas BuildOutputs
resolvedOutputs), -- remoteSchemaMap
            scAllowlist :: InlinedAllowlist
scAllowlist = InlinedAllowlist
inlinedAllowlist,
            -- , scCustomTypes = _boCustomTypes resolvedOutputs
            scAdminIntrospection :: SchemaIntrospection
scAdminIntrospection = SchemaIntrospection
adminIntrospection,
            scGQLContext :: HashMap RoleName (RoleContext GQLContext)
scGQLContext = HashMap RoleName (RoleContext GQLContext)
gqlContext,
            scUnauthenticatedGQLContext :: GQLContext
scUnauthenticatedGQLContext = GQLContext
gqlContextUnauth,
            scRelayContext :: HashMap RoleName (RoleContext GQLContext)
scRelayContext = HashMap RoleName (RoleContext GQLContext)
relayContext,
            scUnauthenticatedRelayContext :: GQLContext
scUnauthenticatedRelayContext = GQLContext
relayContextUnauth,
            -- , scGCtxMap = gqlSchema
            -- , scDefaultRemoteGCtx = remoteGQLSchema
            scDepMap :: DepMap
scDepMap = DepMap
resolvedDependencies,
            scCronTriggers :: HashMap TriggerName CronTriggerInfo
scCronTriggers = HashMap TriggerName CronTriggerInfo
cronTriggersMap,
            scEndpoints :: EndpointTrie GQLQueryWithText
scEndpoints = EndpointTrie GQLQueryWithText
endpoints,
            scInconsistentObjs :: [InconsistentMetadata]
scInconsistentObjs =
              [InconsistentMetadata]
inconsistentObjects
                [InconsistentMetadata]
-> [InconsistentMetadata] -> [InconsistentMetadata]
forall a. Semigroup a => a -> a -> a
<> [InconsistentMetadata]
dependencyInconsistentObjects
                [InconsistentMetadata]
-> [InconsistentMetadata] -> [InconsistentMetadata]
forall a. Semigroup a => a -> a -> a
<> HashSet InconsistentMetadata -> [InconsistentMetadata]
forall a. HashSet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashSet InconsistentMetadata
inconsistentRemoteSchemas
                [InconsistentMetadata]
-> [InconsistentMetadata] -> [InconsistentMetadata]
forall a. Semigroup a => a -> a -> a
<> [InconsistentMetadata]
duplicateRestVariables
                [InconsistentMetadata]
-> [InconsistentMetadata] -> [InconsistentMetadata]
forall a. Semigroup a => a -> a -> a
<> [InconsistentMetadata]
invalidRestSegments
                [InconsistentMetadata]
-> [InconsistentMetadata] -> [InconsistentMetadata]
forall a. Semigroup a => a -> a -> a
<> [InconsistentMetadata]
ambiguousRestEndpoints
                [InconsistentMetadata]
-> [InconsistentMetadata] -> [InconsistentMetadata]
forall a. Semigroup a => a -> a -> a
<> [InconsistentMetadata]
endpointInconsistencies
                [InconsistentMetadata]
-> [InconsistentMetadata] -> [InconsistentMetadata]
forall a. Semigroup a => a -> a -> a
<> [InconsistentMetadata]
cronTriggersInconsistencies
                [InconsistentMetadata]
-> [InconsistentMetadata] -> [InconsistentMetadata]
forall a. Semigroup a => a -> a -> a
<> [InconsistentMetadata]
openTelemetryInconsistencies
                [InconsistentMetadata]
-> [InconsistentMetadata] -> [InconsistentMetadata]
forall a. Semigroup a => a -> a -> a
<> [InconsistentMetadata]
inconsistentQueryCollections,
            scApiLimits :: ApiLimit
scApiLimits = ApiLimit
_metaApiLimits,
            scMetricsConfig :: MetricsConfig
scMetricsConfig = MetricsConfig
_metaMetricsConfig,
            -- Please note that we are setting the metadata resource version to the last known metadata resource version
            -- for `CatalogSync` or to an invalid metadata resource version (-1) for `CatalogUpdate`.
            --
            -- For, CatalogUpdate, we update the metadata resource version to the latest value after the metadata
            -- operation is complete (see the usage of `setMetadataResourceVersionInSchemaCache`).
            scMetadataResourceVersion :: MetadataResourceVersion
scMetadataResourceVersion = MetadataResourceVersion
interimMetadataResourceVersion,
            scSetGraphqlIntrospectionOptions :: SetGraphqlIntrospectionOptions
scSetGraphqlIntrospectionOptions = SetGraphqlIntrospectionOptions
_metaSetGraphqlIntrospectionOptions,
            scTlsAllowlist :: [TlsAllow]
scTlsAllowlist = Network -> [TlsAllow]
networkTlsAllowlist Network
_metaNetwork,
            scQueryCollections :: QueryCollections
scQueryCollections = QueryCollections
_metaQueryCollections,
            scBackendCache :: BackendCache
scBackendCache = BuildOutputs -> BackendCache
_boBackendCache BuildOutputs
resolvedOutputs,
            scSourceHealthChecks :: SourceHealthCheckCache
scSourceHealthChecks = InsOrdHashMap SourceName BackendSourceMetadata
-> SourceHealthCheckCache
buildHealthCheckCache InsOrdHashMap SourceName BackendSourceMetadata
_metaSources,
            scSourcePingConfig :: SourcePingCache
scSourcePingConfig = InsOrdHashMap SourceName BackendSourceMetadata -> SourcePingCache
buildSourcePingCache InsOrdHashMap SourceName BackendSourceMetadata
_metaSources,
            scOpenTelemetryConfig :: OpenTelemetryInfo
scOpenTelemetryConfig = OpenTelemetryInfo
openTelemetryInfo
          }

  -- Write the Project Schema information to schema registry service
  ()
_ <-
    arr (m ()) ()
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA
      -< do
        BuildReason
buildReason <- m BuildReason
forall r (m :: * -> *). MonadReader r m => m r
ask
        case BuildReason
buildReason of
          -- If this is a catalog sync then we know for sure that the schema has more chances of being committed as some
          -- other instance of Hasura has already committed the schema. So we can safely write the schema to the registry
          -- service.
          BuildReason
CatalogSync ->
            SchemaRegistryAction
-> ((MetadataResourceVersion
     -> [InconsistentMetadata] -> Metadata -> IO ())
    -> m ())
-> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ SchemaRegistryAction
schemaRegistryAction (((MetadataResourceVersion
   -> [InconsistentMetadata] -> Metadata -> IO ())
  -> m ())
 -> m ())
-> ((MetadataResourceVersion
     -> [InconsistentMetadata] -> Metadata -> IO ())
    -> m ())
-> m ()
forall a b. (a -> b) -> a -> b
$ \MetadataResourceVersion
-> [InconsistentMetadata] -> Metadata -> IO ()
action -> do
              IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MetadataResourceVersion
-> [InconsistentMetadata] -> Metadata -> IO ()
action MetadataResourceVersion
interimMetadataResourceVersion (SchemaCache -> [InconsistentMetadata]
scInconsistentObjs SchemaCache
schemaCache) Metadata
metadata
          -- If this is a metadata event then we cannot be sure that the schema will be committed. So we write the schema
          -- to the registry service only after the schema is committed.
          CatalogUpdate Maybe (HashSet SourceName)
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  arr
  (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
  (SchemaCache, (SourcesIntrospectionStatus, SchemaRegistryAction))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (SchemaCache
schemaCache, (SourcesIntrospectionStatus
storedIntrospectionStatus, SchemaRegistryAction
schemaRegistryAction))
  where
    -- See Note [Avoiding GraphQL schema rebuilds when changing irrelevant Metadata]
    buildOutputsAndSchema :: arr
  (Dependency Metadata, CacheDynamicConfig,
   Dependency InvalidationKeys, Maybe StoredIntrospection)
  ([InconsistentMetadata], [StoredIntrospectionItem],
   (BuildOutputs, [InconsistentMetadata], DepMap),
   ((SchemaIntrospection, HashMap RoleName (RoleContext GQLContext),
     GQLContext, HashSet InconsistentMetadata),
    (HashMap RoleName (RoleContext GQLContext), GQLContext),
    SchemaRegistryAction))
buildOutputsAndSchema = proc (Dependency Metadata
metadataDep, CacheDynamicConfig
dynamicConfig, Dependency InvalidationKeys
invalidationKeysDep, Maybe StoredIntrospection
storedIntrospection) -> do
      (BuildOutputs
outputs, Seq CollectItem
collectedInfo) <- WriterA
  (Seq CollectItem)
  arr
  (CacheDynamicConfig, Dependency Metadata,
   Dependency InvalidationKeys, Maybe StoredIntrospection)
  BuildOutputs
-> arr
     (CacheDynamicConfig, Dependency Metadata,
      Dependency InvalidationKeys, Maybe StoredIntrospection)
     (BuildOutputs, Seq CollectItem)
forall w (arr :: * -> * -> *) a b.
(Monoid w, Arrow arr) =>
WriterA w arr a b -> arr a (b, w)
runWriterA WriterA
  (Seq CollectItem)
  arr
  (CacheDynamicConfig, Dependency Metadata,
   Dependency InvalidationKeys, Maybe StoredIntrospection)
  BuildOutputs
forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowDistribute arr, ArrowCache m arr,
 ArrowWriter (Seq CollectItem) arr, MonadIO m, MonadError QErr m,
 MonadReader BuildReason m, MonadBaseControl IO m,
 ProvidesNetwork m, MonadResolveSource m, HasCacheStaticConfig m) =>
arr
  (CacheDynamicConfig, Dependency Metadata,
   Dependency InvalidationKeys, Maybe StoredIntrospection)
  BuildOutputs
buildAndCollectInfo -< (CacheDynamicConfig
dynamicConfig, Dependency Metadata
metadataDep, Dependency InvalidationKeys
invalidationKeysDep, Maybe StoredIntrospection
storedIntrospection)
      let ([InconsistentMetadata]
inconsistentObjects, [MetadataDependency]
unresolvedDependencies, [StoredIntrospectionItem]
storedIntrospections) = Seq CollectItem
-> ([InconsistentMetadata], [MetadataDependency],
    [StoredIntrospectionItem])
partitionCollectedInfo Seq CollectItem
collectedInfo
      out2 :: (BuildOutputs, [InconsistentMetadata], DepMap)
out2@(BuildOutputs
resolvedOutputs, [InconsistentMetadata]
_dependencyInconsistentObjects, DepMap
_resolvedDependencies) <- arr
  (BuildOutputs, [MetadataDependency])
  (BuildOutputs, [InconsistentMetadata], DepMap)
forall (m :: * -> *) (arr :: * -> * -> *).
(ArrowKleisli m arr, QErrM m) =>
arr
  (BuildOutputs, [MetadataDependency])
  (BuildOutputs, [InconsistentMetadata], DepMap)
resolveDependencies -< (BuildOutputs
outputs, [MetadataDependency]
unresolvedDependencies)
      ((SchemaIntrospection, HashMap RoleName (RoleContext GQLContext),
  GQLContext, HashSet InconsistentMetadata),
 (HashMap RoleName (RoleContext GQLContext), GQLContext),
 SchemaRegistryAction)
out3 <-
        arr
  (m ((SchemaIntrospection,
       HashMap RoleName (RoleContext GQLContext), GQLContext,
       HashSet InconsistentMetadata),
      (HashMap RoleName (RoleContext GQLContext), GQLContext),
      SchemaRegistryAction))
  ((SchemaIntrospection, HashMap RoleName (RoleContext GQLContext),
    GQLContext, HashSet InconsistentMetadata),
   (HashMap RoleName (RoleContext GQLContext), GQLContext),
   SchemaRegistryAction)
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA
          -< do
            InferFunctionPermissions
-> RemoteSchemaPermissions
-> HashSet ExperimentalFeature
-> SQLGenCtx
-> ApolloFederationStatus
-> SourceCache
-> HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
-> ActionCache
-> AnnotatedCustomTypes
-> Maybe SchemaRegistryContext
-> Logger Hasura
-> m ((SchemaIntrospection,
       HashMap RoleName (RoleContext GQLContext), GQLContext,
       HashSet InconsistentMetadata),
      (HashMap RoleName (RoleContext GQLContext), GQLContext),
      SchemaRegistryAction)
forall (m :: * -> *).
(MonadError QErr m, MonadIO m) =>
InferFunctionPermissions
-> RemoteSchemaPermissions
-> HashSet ExperimentalFeature
-> SQLGenCtx
-> ApolloFederationStatus
-> SourceCache
-> HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
-> ActionCache
-> AnnotatedCustomTypes
-> Maybe SchemaRegistryContext
-> Logger Hasura
-> m ((SchemaIntrospection,
       HashMap RoleName (RoleContext GQLContext), GQLContext,
       HashSet InconsistentMetadata),
      (HashMap RoleName (RoleContext GQLContext), GQLContext),
      SchemaRegistryAction)
buildGQLContext
              (CacheDynamicConfig -> InferFunctionPermissions
_cdcFunctionPermsCtx CacheDynamicConfig
dynamicConfig)
              (CacheDynamicConfig -> RemoteSchemaPermissions
_cdcRemoteSchemaPermsCtx CacheDynamicConfig
dynamicConfig)
              (CacheDynamicConfig -> HashSet ExperimentalFeature
_cdcExperimentalFeatures CacheDynamicConfig
dynamicConfig)
              (CacheDynamicConfig -> SQLGenCtx
_cdcSQLGenCtx CacheDynamicConfig
dynamicConfig)
              (CacheDynamicConfig -> ApolloFederationStatus
_cdcApolloFederationStatus CacheDynamicConfig
dynamicConfig)
              (BuildOutputs -> SourceCache
_boSources BuildOutputs
resolvedOutputs)
              (BuildOutputs
-> HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
_boRemoteSchemas BuildOutputs
resolvedOutputs)
              (BuildOutputs -> ActionCache
_boActions BuildOutputs
resolvedOutputs)
              (BuildOutputs -> AnnotatedCustomTypes
_boCustomTypes BuildOutputs
resolvedOutputs)
              Maybe SchemaRegistryContext
mSchemaRegistryContext
              Logger Hasura
logger
      arr
  ([InconsistentMetadata], [StoredIntrospectionItem],
   (BuildOutputs, [InconsistentMetadata], DepMap),
   ((SchemaIntrospection, HashMap RoleName (RoleContext GQLContext),
     GQLContext, HashSet InconsistentMetadata),
    (HashMap RoleName (RoleContext GQLContext), GQLContext),
    SchemaRegistryAction))
  ([InconsistentMetadata], [StoredIntrospectionItem],
   (BuildOutputs, [InconsistentMetadata], DepMap),
   ((SchemaIntrospection, HashMap RoleName (RoleContext GQLContext),
     GQLContext, HashSet InconsistentMetadata),
    (HashMap RoleName (RoleContext GQLContext), GQLContext),
    SchemaRegistryAction))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< ([InconsistentMetadata]
inconsistentObjects, [StoredIntrospectionItem]
storedIntrospections, (BuildOutputs, [InconsistentMetadata], DepMap)
out2, ((SchemaIntrospection, HashMap RoleName (RoleContext GQLContext),
  GQLContext, HashSet InconsistentMetadata),
 (HashMap RoleName (RoleContext GQLContext), GQLContext),
 SchemaRegistryAction)
out3)

    resolveBackendInfo' ::
      forall arr m b.
      ( BackendMetadata b,
        ArrowChoice arr,
        Inc.ArrowCache m arr,
        Inc.ArrowDistribute arr,
        ArrowWriter (Seq CollectItem) arr,
        MonadIO m,
        MonadBaseControl IO m,
        ProvidesNetwork m
      ) =>
      (BackendConfigWrapper b, Inc.Dependency (BackendMap BackendInvalidationKeysWrapper)) `arr` BackendCache
    resolveBackendInfo' :: forall (arr :: * -> * -> *) (m :: * -> *) (b :: BackendType).
(BackendMetadata b, ArrowChoice arr, ArrowCache m arr,
 ArrowDistribute arr, ArrowWriter (Seq CollectItem) arr, MonadIO m,
 MonadBaseControl IO m, ProvidesNetwork m) =>
arr
  (BackendConfigWrapper b,
   Dependency (BackendMap BackendInvalidationKeysWrapper))
  BackendCache
resolveBackendInfo' = proc (BackendConfigWrapper b
backendConfigWrapper, Dependency (BackendMap BackendInvalidationKeysWrapper)
backendInvalidationMap) -> do
      let backendInvalidationKeys :: Dependency (Maybe (BackendInvalidationKeys b))
backendInvalidationKeys =
            Selector
  (BackendInvalidationKeysWrapper b) (BackendInvalidationKeys b)
-> Dependency (Maybe (BackendInvalidationKeysWrapper b))
-> Dependency (Maybe (BackendInvalidationKeys b))
forall a b.
Select a =>
Selector a b -> Dependency (Maybe a) -> Dependency (Maybe b)
Inc.selectMaybeD FieldS
  (BackendInvalidationKeysWrapper b) (BackendInvalidationKeys b)
Selector
  (BackendInvalidationKeysWrapper b) (BackendInvalidationKeys b)
#unBackendInvalidationKeysWrapper
              (Dependency (Maybe (BackendInvalidationKeysWrapper b))
 -> Dependency (Maybe (BackendInvalidationKeys b)))
-> Dependency (Maybe (BackendInvalidationKeysWrapper b))
-> Dependency (Maybe (BackendInvalidationKeys b))
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
Dependency (BackendMap i) -> Dependency (Maybe (i b))
BackendMap.lookupD @b Dependency (BackendMap BackendInvalidationKeysWrapper)
backendInvalidationMap
      BackendInfo b
backendInfo <- forall (b :: BackendType) (arr :: * -> * -> *) (m :: * -> *).
(BackendMetadata b, ArrowChoice arr, ArrowCache m arr,
 ArrowDistribute arr, ArrowWriter (Seq CollectItem) arr, MonadIO m,
 MonadBaseControl IO m, ProvidesNetwork m) =>
Logger Hasura
-> arr
     (Dependency (Maybe (BackendInvalidationKeys b)), BackendConfig b)
     (BackendInfo b)
resolveBackendInfo @b Logger Hasura
logger -< (Dependency (Maybe (BackendInvalidationKeys b))
backendInvalidationKeys, BackendConfigWrapper b -> BackendConfig b
forall (b :: BackendType).
BackendConfigWrapper b -> BackendConfig b
unBackendConfigWrapper BackendConfigWrapper b
backendConfigWrapper)
      arr BackendCache BackendCache
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< BackendInfoWrapper b -> BackendCache
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> BackendMap i
BackendMap.singleton (forall (b :: BackendType). BackendInfo b -> BackendInfoWrapper b
BackendInfoWrapper @b BackendInfo b
backendInfo)

    resolveBackendCache ::
      forall arr m.
      ( ArrowChoice arr,
        Inc.ArrowCache m arr,
        Inc.ArrowDistribute arr,
        ArrowWriter (Seq CollectItem) arr,
        MonadIO m,
        MonadBaseControl IO m,
        ProvidesNetwork m,
        HasCacheStaticConfig m
      ) =>
      (Inc.Dependency (BackendMap BackendInvalidationKeysWrapper), [AB.AnyBackend BackendConfigWrapper]) `arr` BackendCache
    resolveBackendCache :: forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowCache m arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectItem) arr, MonadIO m,
 MonadBaseControl IO m, ProvidesNetwork m,
 HasCacheStaticConfig m) =>
arr
  (Dependency (BackendMap BackendInvalidationKeysWrapper),
   [AnyBackend BackendConfigWrapper])
  BackendCache
resolveBackendCache = proc (Dependency (BackendMap BackendInvalidationKeysWrapper)
backendInvalidationMap, [AnyBackend BackendConfigWrapper]
backendConfigs) -> do
      case [AnyBackend BackendConfigWrapper]
backendConfigs of
        [] -> arr BackendCache BackendCache
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< BackendCache
forall a. Monoid a => a
mempty
        (AnyBackend BackendConfigWrapper
anyBackendConfig : [AnyBackend BackendConfigWrapper]
backendConfigs') -> do
          BackendCache
backendInfo <-
            forall (c1 :: BackendType -> Constraint)
       (c2 :: BackendType -> Constraint) (i :: BackendType -> *) r
       (arr :: * -> * -> *) x.
(ArrowChoice arr, AllBackendsSatisfy c1, AllBackendsSatisfy c2) =>
(forall (b :: BackendType). (c1 b, c2 b) => arr (i b, x) r)
-> arr (AnyBackend i, x) r
AB.dispatchAnyBackendArrow @BackendMetadata @HasTag arr
  (BackendConfigWrapper b,
   Dependency (BackendMap BackendInvalidationKeysWrapper))
  BackendCache
forall (b :: BackendType).
(BackendMetadata b, HasTag b) =>
arr
  (BackendConfigWrapper b,
   Dependency (BackendMap BackendInvalidationKeysWrapper))
  BackendCache
forall (arr :: * -> * -> *) (m :: * -> *) (b :: BackendType).
(BackendMetadata b, ArrowChoice arr, ArrowCache m arr,
 ArrowDistribute arr, ArrowWriter (Seq CollectItem) arr, MonadIO m,
 MonadBaseControl IO m, ProvidesNetwork m) =>
arr
  (BackendConfigWrapper b,
   Dependency (BackendMap BackendInvalidationKeysWrapper))
  BackendCache
resolveBackendInfo' -< (AnyBackend BackendConfigWrapper
anyBackendConfig, Dependency (BackendMap BackendInvalidationKeysWrapper)
backendInvalidationMap)
          BackendCache
backendInfos <- arr
  (Dependency (BackendMap BackendInvalidationKeysWrapper),
   [AnyBackend BackendConfigWrapper])
  BackendCache
forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowCache m arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectItem) arr, MonadIO m,
 MonadBaseControl IO m, ProvidesNetwork m,
 HasCacheStaticConfig m) =>
arr
  (Dependency (BackendMap BackendInvalidationKeysWrapper),
   [AnyBackend BackendConfigWrapper])
  BackendCache
resolveBackendCache -< (Dependency (BackendMap BackendInvalidationKeysWrapper)
backendInvalidationMap, [AnyBackend BackendConfigWrapper]
backendConfigs')
          arr BackendCache BackendCache
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< BackendCache
backendInfo BackendCache -> BackendCache -> BackendCache
forall a. Semigroup a => a -> a -> a
<> BackendCache
backendInfos

    tryGetSourceConfig ::
      forall b arr m.
      ( ArrowChoice arr,
        Inc.ArrowCache m arr,
        ArrowWriter (Seq CollectItem) arr,
        MonadIO m,
        MonadBaseControl IO m,
        MonadResolveSource m,
        ProvidesNetwork m,
        BackendMetadata b
      ) =>
      ( Inc.Dependency (HashMap SourceName Inc.InvalidationKey),
        SourceName,
        SourceConnConfiguration b,
        BackendSourceKind b,
        BackendInfo b
      )
        `arr` Maybe (SourceConfig b)
    tryGetSourceConfig :: forall (b :: BackendType) (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowCache m arr,
 ArrowWriter (Seq CollectItem) arr, MonadIO m,
 MonadBaseControl IO m, MonadResolveSource m, ProvidesNetwork m,
 BackendMetadata b) =>
arr
  (Dependency (HashMap SourceName InvalidationKey), SourceName,
   SourceConnConfiguration b, BackendSourceKind b, BackendInfo b)
  (Maybe (SourceConfig b))
tryGetSourceConfig = arr
  (Dependency (HashMap SourceName InvalidationKey), SourceName,
   SourceConnConfiguration b, BackendSourceKind b, BackendInfo b)
  (Maybe (SourceConfig b))
-> arr
     (Dependency (HashMap SourceName InvalidationKey), SourceName,
      SourceConnConfiguration b, BackendSourceKind b, BackendInfo b)
     (Maybe (SourceConfig b))
forall a b. (Given Accesses => Eq a) => arr a b -> arr a b
forall (m :: * -> *) (arr :: * -> * -> *) a b.
(ArrowCache m arr, Given Accesses => Eq a) =>
arr a b -> arr a b
Inc.cache proc (Dependency (HashMap SourceName InvalidationKey)
invalidationKeys, SourceName
sourceName, SourceConnConfiguration b
sourceConfig, BackendSourceKind b
backendKind, BackendInfo b
backendInfo) -> do
      let metadataObj :: MetadataObject
metadataObj = MetadataObjId -> Value -> MetadataObject
MetadataObject (SourceName -> MetadataObjId
MOSource SourceName
sourceName) (Value -> MetadataObject) -> Value -> MetadataObject
forall a b. (a -> b) -> a -> b
$ SourceName -> Value
forall a. ToJSON a => a -> Value
toJSON SourceName
sourceName
      -- TODO: if we make all of 'resolveSourceConfig' a Service, we could
      -- delegate to it the responsibility of extracting the HTTP manager, and
      -- avoid having to thread 'ProvidesNetwork' throughout the cache building
      -- code.
      Manager
httpMgr <- arr (m Manager) Manager
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< m Manager
forall (m :: * -> *). ProvidesNetwork m => m Manager
askHTTPManager
      arr (Dependency (Maybe InvalidationKey)) (Maybe InvalidationKey)
forall a. Eq a => arr (Dependency a) a
forall (m :: * -> *) (arr :: * -> * -> *) a.
(ArrowCache m arr, Eq a) =>
arr (Dependency a) a
Inc.dependOn -< SourceName
-> Dependency (HashMap SourceName InvalidationKey)
-> Dependency (Maybe InvalidationKey)
forall a k v.
(Select a, Selector a ~ ConstS k v) =>
k -> Dependency a -> Dependency v
Inc.selectKeyD SourceName
sourceName Dependency (HashMap SourceName InvalidationKey)
invalidationKeys
      (|
        ErrorA QErr arr (a, ()) (SourceConfig b)
-> arr (a, (MetadataObject, ())) (Maybe (SourceConfig b))
forall {a}.
ErrorA QErr arr (a, ()) (SourceConfig b)
-> arr (a, (MetadataObject, ())) (Maybe (SourceConfig b))
forall (arr :: * -> * -> *) e s a.
(ArrowChoice arr, ArrowWriter (Seq CollectItem) arr) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
          ( ErrorA QErr arr (ExceptT QErr m (SourceConfig b)) (SourceConfig b)
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr) =>
arr (ExceptT e m a) a
bindErrorA -< m (Either QErr (SourceConfig b)) -> ExceptT QErr m (SourceConfig b)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either QErr (SourceConfig b))
 -> ExceptT QErr m (SourceConfig b))
-> m (Either QErr (SourceConfig b))
-> ExceptT QErr m (SourceConfig b)
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadIO m, MonadBaseControl IO m,
 MonadResolveSource m) =>
SourceName
-> SourceConnConfiguration b
-> BackendSourceKind b
-> BackendInfo b
-> Environment
-> Manager
-> m (Either QErr (SourceConfig b))
resolveSourceConfig @b SourceName
sourceName SourceConnConfiguration b
sourceConfig BackendSourceKind b
backendKind BackendInfo b
backendInfo Environment
env Manager
httpMgr
          )
        |)
        MetadataObject
metadataObj

    tryResolveSource ::
      forall b arr m.
      ( ArrowChoice arr,
        Inc.ArrowCache m arr,
        ArrowWriter (Seq CollectItem) arr,
        MonadIO m,
        MonadBaseControl IO m,
        MonadResolveSource m,
        ProvidesNetwork m,
        BackendMetadata b
      ) =>
      ( Inc.Dependency (HashMap SourceName Inc.InvalidationKey),
        Maybe LBS.ByteString,
        BackendInfoAndSourceMetadata b
      )
        `arr` Maybe (SourceConfig b, DBObjectsIntrospection b)
    tryResolveSource :: forall (b :: BackendType) (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowCache m arr,
 ArrowWriter (Seq CollectItem) arr, MonadIO m,
 MonadBaseControl IO m, MonadResolveSource m, ProvidesNetwork m,
 BackendMetadata b) =>
arr
  (Dependency (HashMap SourceName InvalidationKey), Maybe ByteString,
   BackendInfoAndSourceMetadata b)
  (Maybe (SourceConfig b, DBObjectsIntrospection b))
tryResolveSource = arr
  (Dependency (HashMap SourceName InvalidationKey), Maybe ByteString,
   BackendInfoAndSourceMetadata b)
  (Maybe (SourceConfig b, DBObjectsIntrospection b))
-> arr
     (Dependency (HashMap SourceName InvalidationKey), Maybe ByteString,
      BackendInfoAndSourceMetadata b)
     (Maybe (SourceConfig b, DBObjectsIntrospection b))
forall a b. (Given Accesses => Eq a) => arr a b -> arr a b
forall (m :: * -> *) (arr :: * -> * -> *) a b.
(ArrowCache m arr, Given Accesses => Eq a) =>
arr a b -> arr a b
Inc.cache proc (Dependency (HashMap SourceName InvalidationKey)
invalidationKeys, Maybe ByteString
sourceIntrospection, BackendInfoAndSourceMetadata {BackendInfo b
SourceMetadata b
_bcasmBackendInfo :: BackendInfo b
_bcasmSourceMetadata :: SourceMetadata b
_bcasmBackendInfo :: forall (b :: BackendType).
BackendInfoAndSourceMetadata b -> BackendInfo b
_bcasmSourceMetadata :: forall (b :: BackendType).
BackendInfoAndSourceMetadata b -> SourceMetadata b
..}) -> do
      let sourceName :: SourceName
sourceName = SourceMetadata b -> SourceName
forall (b :: BackendType). SourceMetadata b -> SourceName
_smName SourceMetadata b
_bcasmSourceMetadata
          metadataObj :: MetadataObject
metadataObj = MetadataObjId -> Value -> MetadataObject
MetadataObject (SourceName -> MetadataObjId
MOSource SourceName
sourceName) (Value -> MetadataObject) -> Value -> MetadataObject
forall a b. (a -> b) -> a -> b
$ SourceName -> Value
forall a. ToJSON a => a -> Value
toJSON SourceName
sourceName

      Maybe (SourceConfig b)
maybeSourceConfig <- forall (b :: BackendType) (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowCache m arr,
 ArrowWriter (Seq CollectItem) arr, MonadIO m,
 MonadBaseControl IO m, MonadResolveSource m, ProvidesNetwork m,
 BackendMetadata b) =>
arr
  (Dependency (HashMap SourceName InvalidationKey), SourceName,
   SourceConnConfiguration b, BackendSourceKind b, BackendInfo b)
  (Maybe (SourceConfig b))
tryGetSourceConfig @b -< (Dependency (HashMap SourceName InvalidationKey)
invalidationKeys, SourceName
sourceName, SourceMetadata b -> SourceConnConfiguration b
forall (b :: BackendType).
SourceMetadata b -> SourceConnConfiguration b
_smConfiguration SourceMetadata b
_bcasmSourceMetadata, SourceMetadata b -> BackendSourceKind b
forall (b :: BackendType). SourceMetadata b -> BackendSourceKind b
_smKind SourceMetadata b
_bcasmSourceMetadata, BackendInfo b
_bcasmBackendInfo)
      case Maybe (SourceConfig b)
maybeSourceConfig of
        Maybe (SourceConfig b)
Nothing -> arr
  (Maybe (SourceConfig b, DBObjectsIntrospection b))
  (Maybe (SourceConfig b, DBObjectsIntrospection b))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Maybe (SourceConfig b, DBObjectsIntrospection b)
forall a. Maybe a
Nothing
        Just SourceConfig b
sourceConfig -> do
          Either QErr (DBObjectsIntrospection b)
databaseResponse <- arr
  (m (Either QErr (DBObjectsIntrospection b)))
  (Either QErr (DBObjectsIntrospection b))
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< Logger Hasura
-> SourceMetadata b
-> SourceConfig b
-> m (Either QErr (DBObjectsIntrospection b))
forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadIO m, MonadBaseControl IO m,
 MonadResolveSource m) =>
Logger Hasura
-> SourceMetadata b
-> SourceConfig b
-> m (Either QErr (DBObjectsIntrospection b))
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadResolveSource m) =>
Logger Hasura
-> SourceMetadata b
-> SourceConfig b
-> m (Either QErr (DBObjectsIntrospection b))
resolveDatabaseMetadata Logger Hasura
logger SourceMetadata b
_bcasmSourceMetadata SourceConfig b
sourceConfig
          case Either QErr (DBObjectsIntrospection b)
databaseResponse of
            Right DBObjectsIntrospection b
databaseMetadata -> do
              -- Collect database introspection to persist in the storage
              arr (Seq CollectItem) ()
forall w (arr :: * -> * -> *). ArrowWriter w arr => arr w ()
tellA -< CollectItem -> Seq CollectItem
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StoredIntrospectionItem -> CollectItem
CollectStoredIntrospection (StoredIntrospectionItem -> CollectItem)
-> StoredIntrospectionItem -> CollectItem
forall a b. (a -> b) -> a -> b
$ SourceName -> EncJSON -> StoredIntrospectionItem
SourceIntrospectionItem SourceName
sourceName (EncJSON -> StoredIntrospectionItem)
-> EncJSON -> StoredIntrospectionItem
forall a b. (a -> b) -> a -> b
$ DBObjectsIntrospection b -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue DBObjectsIntrospection b
databaseMetadata)
              arr
  (Maybe (SourceConfig b, DBObjectsIntrospection b))
  (Maybe (SourceConfig b, DBObjectsIntrospection b))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (SourceConfig b, DBObjectsIntrospection b)
-> Maybe (SourceConfig b, DBObjectsIntrospection b)
forall a. a -> Maybe a
Just (SourceConfig b
sourceConfig, DBObjectsIntrospection b
databaseMetadata)
            Left QErr
databaseError ->
              -- If database exception occurs, try to lookup from stored introspection
              case Maybe ByteString
sourceIntrospection Maybe ByteString
-> (ByteString -> Maybe (DBObjectsIntrospection b))
-> Maybe (DBObjectsIntrospection b)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe (DBObjectsIntrospection b)
forall a. FromJSON a => ByteString -> Maybe a
decode' of
                Maybe (DBObjectsIntrospection b)
Nothing ->
                  -- If no stored introspection exist, re-throw the database exception
                  (| ErrorA QErr arr (a, ()) (SourceConfig b, DBObjectsIntrospection b)
-> arr
     (a, (MetadataObject, ()))
     (Maybe (SourceConfig b, DBObjectsIntrospection b))
forall {a}.
ErrorA QErr arr (a, ()) (SourceConfig b, DBObjectsIntrospection b)
-> arr
     (a, (MetadataObject, ()))
     (Maybe (SourceConfig b, DBObjectsIntrospection b))
forall (arr :: * -> * -> *) e s a.
(ArrowChoice arr, ArrowWriter (Seq CollectItem) arr) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency (ErrorA QErr arr QErr (SourceConfig b, DBObjectsIntrospection b)
forall a. ErrorA QErr arr QErr a
forall e (arr :: * -> * -> *) a. ArrowError e arr => arr e a
throwA -< QErr
databaseError) |) MetadataObject
metadataObj
                Just DBObjectsIntrospection b
storedMetadata -> do
                  let inconsistencyMessage :: Text
inconsistencyMessage =
                        [Text] -> Text
T.unwords
                          [ Text
"source " Text -> SourceName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> SourceName
sourceName,
                            Text
" is inconsistent because of stale database introspection is used.",
                            Text
"The source couldn't be reached for a fresh introspection",
                            Text
"because we got error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QErr -> Text
qeError QErr
databaseError
                          ]
                  -- Still record inconsistency to notify the user obout the usage of stored stale data
                  arr ((Maybe Value, [MetadataObject]), Text) ()
forall (arr :: * -> * -> *) (f :: * -> *).
(ArrowWriter (Seq CollectItem) arr, Functor f, Foldable f) =>
arr ((Maybe Value, f MetadataObject), Text) ()
recordInconsistencies -< ((Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Maybe QErrExtra -> Value
forall a. ToJSON a => a -> Value
toJSON (QErr -> Maybe QErrExtra
qeInternal QErr
databaseError), [MetadataObject
metadataObj]), Text
inconsistencyMessage)
                  arr (m ()) ()
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< Logger Hasura
-> forall a (m :: * -> *).
   (ToEngineLog a Hasura, MonadIO m) =>
   a -> m ()
forall impl.
Logger impl
-> forall a (m :: * -> *).
   (ToEngineLog a impl, MonadIO m) =>
   a -> m ()
unLogger Logger Hasura
logger (StoredIntrospectionLog -> m ()) -> StoredIntrospectionLog -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> QErr -> StoredIntrospectionLog
StoredIntrospectionLog (Text
"Using stored introspection for database source " Text -> SourceName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> SourceName
sourceName) QErr
databaseError
                  arr
  (Maybe (SourceConfig b, DBObjectsIntrospection b))
  (Maybe (SourceConfig b, DBObjectsIntrospection b))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (SourceConfig b, DBObjectsIntrospection b)
-> Maybe (SourceConfig b, DBObjectsIntrospection b)
forall a. a -> Maybe a
Just (SourceConfig b
sourceConfig, DBObjectsIntrospection b
storedMetadata)

    -- impl notes (swann):
    --
    -- as our cache invalidation key, we use the fact of the availability of event triggers
    -- present, rerunning catalog init when this changes. i.e we invalidate the cache and
    -- rebuild it with the catalog only when there is at least one event trigger present.
    -- This is correct, because we only care about the transition from zero event triggers
    -- to nonzero (not necessarily one, as Anon has observed, because replace_metadata can
    -- add multiple event triggers in one go)
    --
    -- a future optimisation would be to cache, on a per-source basis, whether or not
    -- the event catalog itself exists, and to then trigger catalog init when an event
    -- trigger is created _but only if_ this cached information says the event catalog
    -- doesn't already exist.

    initCatalogIfNeeded ::
      forall b arr m.
      ( ArrowChoice arr,
        Inc.ArrowCache m arr,
        ArrowWriter (Seq CollectItem) arr,
        MonadIO m,
        BackendMetadata b,
        MonadBaseControl IO m,
        HasCacheStaticConfig m
      ) =>
      (Proxy b, [(TableName b, [EventTriggerConf b])], SourceConfig b, SourceName) `arr` (RecreateEventTriggers, SourceCatalogMigrationState)
    initCatalogIfNeeded :: forall (b :: BackendType) (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowCache m arr,
 ArrowWriter (Seq CollectItem) arr, MonadIO m, BackendMetadata b,
 MonadBaseControl IO m, HasCacheStaticConfig m) =>
arr
  (Proxy b, [(TableName b, [EventTriggerConf b])], SourceConfig b,
   SourceName)
  (RecreateEventTriggers, SourceCatalogMigrationState)
initCatalogIfNeeded = arr
  (Proxy b, [(TableName b, [EventTriggerConf b])], SourceConfig b,
   SourceName)
  (RecreateEventTriggers, SourceCatalogMigrationState)
-> arr
     (Proxy b, [(TableName b, [EventTriggerConf b])], SourceConfig b,
      SourceName)
     (RecreateEventTriggers, SourceCatalogMigrationState)
forall a b. (Given Accesses => Eq a) => arr a b -> arr a b
forall (m :: * -> *) (arr :: * -> * -> *) a b.
(ArrowCache m arr, Given Accesses => Eq a) =>
arr a b -> arr a b
Inc.cache proc (Proxy b
Proxy, [(TableName b, [EventTriggerConf b])]
eventTriggers, SourceConfig b
sourceConfig, SourceName
sourceName) -> do
      Maybe (RecreateEventTriggers, SourceCatalogMigrationState)
res <-
        (|
          ErrorA
  QErr
  arr
  (a, ())
  (RecreateEventTriggers, SourceCatalogMigrationState)
-> arr
     (a, ([MetadataObject], ()))
     (Maybe (RecreateEventTriggers, SourceCatalogMigrationState))
forall {a}.
ErrorA
  QErr
  arr
  (a, ())
  (RecreateEventTriggers, SourceCatalogMigrationState)
-> arr
     (a, ([MetadataObject], ()))
     (Maybe (RecreateEventTriggers, SourceCatalogMigrationState))
forall (arr :: * -> * -> *) e s a.
(ArrowChoice arr, ArrowWriter (Seq CollectItem) arr) =>
ErrorA QErr arr (e, s) a
-> arr (e, ([MetadataObject], s)) (Maybe a)
withRecordInconsistencies
            ( ErrorA
  QErr
  arr
  (ExceptT
     QErr m (RecreateEventTriggers, SourceCatalogMigrationState))
  (RecreateEventTriggers, SourceCatalogMigrationState)
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr) =>
arr (ExceptT e m a) a
bindErrorA
                -< do
                  if [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((TableName b, [EventTriggerConf b]) -> Int)
-> [(TableName b, [EventTriggerConf b])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([EventTriggerConf b] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([EventTriggerConf b] -> Int)
-> ((TableName b, [EventTriggerConf b]) -> [EventTriggerConf b])
-> (TableName b, [EventTriggerConf b])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TableName b, [EventTriggerConf b]) -> [EventTriggerConf b]
forall a b. (a, b) -> b
snd) [(TableName b, [EventTriggerConf b])]
eventTriggers) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                    then do
                      CacheStaticConfig
cacheStaticConfig <- ExceptT QErr m CacheStaticConfig
forall (m :: * -> *). HasCacheStaticConfig m => m CacheStaticConfig
askCacheStaticConfig
                      let maintenanceMode :: MaintenanceMode ()
maintenanceMode = CacheStaticConfig -> MaintenanceMode ()
_cscMaintenanceMode CacheStaticConfig
cacheStaticConfig
                          eventingMode :: EventingMode
eventingMode = CacheStaticConfig -> EventingMode
_cscEventingMode CacheStaticConfig
cacheStaticConfig
                          readOnlyMode :: ReadOnlyMode
readOnlyMode = CacheStaticConfig -> ReadOnlyMode
_cscReadOnlyMode CacheStaticConfig
cacheStaticConfig

                      if
                        -- when safe mode is enabled, don't perform any migrations
                        | ReadOnlyMode
readOnlyMode ReadOnlyMode -> ReadOnlyMode -> Bool
forall a. Eq a => a -> a -> Bool
== ReadOnlyMode
ReadOnlyModeEnabled -> (RecreateEventTriggers, SourceCatalogMigrationState)
-> ExceptT
     QErr m (RecreateEventTriggers, SourceCatalogMigrationState)
forall a. a -> ExceptT QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RecreateEventTriggers
RETDoNothing, Text -> SourceCatalogMigrationState
SCMSMigrationOnHold Text
"read-only mode enabled")
                        -- when eventing mode is disabled, don't perform any migrations
                        | EventingMode
eventingMode EventingMode -> EventingMode -> Bool
forall a. Eq a => a -> a -> Bool
== EventingMode
EventingDisabled -> (RecreateEventTriggers, SourceCatalogMigrationState)
-> ExceptT
     QErr m (RecreateEventTriggers, SourceCatalogMigrationState)
forall a. a -> ExceptT QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RecreateEventTriggers
RETDoNothing, Text -> SourceCatalogMigrationState
SCMSMigrationOnHold Text
"eventing mode disabled")
                        -- when maintenance mode is enabled, don't perform any migrations
                        | MaintenanceMode ()
maintenanceMode MaintenanceMode () -> MaintenanceMode () -> Bool
forall a. Eq a => a -> a -> Bool
== (() -> MaintenanceMode ()
forall a. a -> MaintenanceMode a
MaintenanceModeEnabled ()) -> (RecreateEventTriggers, SourceCatalogMigrationState)
-> ExceptT
     QErr m (RecreateEventTriggers, SourceCatalogMigrationState)
forall a. a -> ExceptT QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RecreateEventTriggers
RETDoNothing, Text -> SourceCatalogMigrationState
SCMSMigrationOnHold Text
"maintenance mode enabled")
                        | Bool
otherwise -> do
                            -- The `initCatalogForSource` action is retried here because
                            -- in cloud there will be multiple workers (graphql-engine instances)
                            -- trying to migrate the source catalog, when needed. This introduces
                            -- a race condition as both the workers try to migrate the source catalog
                            -- concurrently and when one of them succeeds the other ones will fail
                            -- and be in an inconsistent state. To avoid the inconsistency, we retry
                            -- migrating the catalog on error and in the retry `initCatalogForSource`
                            -- will see that the catalog is already migrated, so it won't attempt the
                            -- migration again
                            Either QErr (RecreateEventTriggers, SourceCatalogMigrationState)
-> ExceptT
     QErr m (RecreateEventTriggers, SourceCatalogMigrationState)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
                              (Either QErr (RecreateEventTriggers, SourceCatalogMigrationState)
 -> ExceptT
      QErr m (RecreateEventTriggers, SourceCatalogMigrationState))
-> ExceptT
     QErr
     m
     (Either QErr (RecreateEventTriggers, SourceCatalogMigrationState))
-> ExceptT
     QErr m (RecreateEventTriggers, SourceCatalogMigrationState)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RetryPolicyM (ExceptT QErr m)
-> (RetryStatus
    -> Either QErr (RecreateEventTriggers, SourceCatalogMigrationState)
    -> ExceptT QErr m Bool)
-> (RetryStatus
    -> ExceptT
         QErr
         m
         (Either QErr (RecreateEventTriggers, SourceCatalogMigrationState)))
-> ExceptT
     QErr
     m
     (Either QErr (RecreateEventTriggers, SourceCatalogMigrationState))
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
Retry.retrying
                                ( Int -> RetryPolicyM (ExceptT QErr m)
forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
Retry.constantDelay (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ DiffTime -> Integer
diffTimeToMicroSeconds (DiffTime -> Integer) -> DiffTime -> Integer
forall a b. (a -> b) -> a -> b
$ Seconds -> DiffTime
seconds (Seconds -> DiffTime) -> Seconds -> DiffTime
forall a b. (a -> b) -> a -> b
$ DiffTime -> Seconds
Seconds DiffTime
10)
                                    RetryPolicyM (ExceptT QErr m)
-> RetryPolicyM (ExceptT QErr m) -> RetryPolicyM (ExceptT QErr m)
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicy
Retry.limitRetries Int
3
                                )
                                ((Either QErr (RecreateEventTriggers, SourceCatalogMigrationState)
 -> ExceptT QErr m Bool)
-> RetryStatus
-> Either QErr (RecreateEventTriggers, SourceCatalogMigrationState)
-> ExceptT QErr m Bool
forall a b. a -> b -> a
const ((Either QErr (RecreateEventTriggers, SourceCatalogMigrationState)
  -> ExceptT QErr m Bool)
 -> RetryStatus
 -> Either QErr (RecreateEventTriggers, SourceCatalogMigrationState)
 -> ExceptT QErr m Bool)
-> (Either
      QErr (RecreateEventTriggers, SourceCatalogMigrationState)
    -> ExceptT QErr m Bool)
-> RetryStatus
-> Either QErr (RecreateEventTriggers, SourceCatalogMigrationState)
-> ExceptT QErr m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> ExceptT QErr m Bool
forall a. a -> ExceptT QErr m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ExceptT QErr m Bool)
-> (Either
      QErr (RecreateEventTriggers, SourceCatalogMigrationState)
    -> Bool)
-> Either QErr (RecreateEventTriggers, SourceCatalogMigrationState)
-> ExceptT QErr m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either QErr (RecreateEventTriggers, SourceCatalogMigrationState)
-> Bool
forall a b. Either a b -> Bool
isLeft)
                                (ExceptT
  QErr
  m
  (Either QErr (RecreateEventTriggers, SourceCatalogMigrationState))
-> RetryStatus
-> ExceptT
     QErr
     m
     (Either QErr (RecreateEventTriggers, SourceCatalogMigrationState))
forall a b. a -> b -> a
const (ExceptT
   QErr
   m
   (Either QErr (RecreateEventTriggers, SourceCatalogMigrationState))
 -> RetryStatus
 -> ExceptT
      QErr
      m
      (Either QErr (RecreateEventTriggers, SourceCatalogMigrationState)))
-> ExceptT
     QErr
     m
     (Either QErr (RecreateEventTriggers, SourceCatalogMigrationState))
-> RetryStatus
-> ExceptT
     QErr
     m
     (Either QErr (RecreateEventTriggers, SourceCatalogMigrationState))
forall a b. (a -> b) -> a -> b
$ ExceptT
  QErr
  (ExceptT QErr m)
  (RecreateEventTriggers, SourceCatalogMigrationState)
-> ExceptT
     QErr
     m
     (Either QErr (RecreateEventTriggers, SourceCatalogMigrationState))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   QErr
   (ExceptT QErr m)
   (RecreateEventTriggers, SourceCatalogMigrationState)
 -> ExceptT
      QErr
      m
      (Either QErr (RecreateEventTriggers, SourceCatalogMigrationState)))
-> ExceptT
     QErr
     (ExceptT QErr m)
     (RecreateEventTriggers, SourceCatalogMigrationState)
-> ExceptT
     QErr
     m
     (Either QErr (RecreateEventTriggers, SourceCatalogMigrationState))
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadIO m, MonadBaseControl IO m) =>
SourceConfig b
-> ExceptT
     QErr m (RecreateEventTriggers, SourceCatalogMigrationState)
prepareCatalog @b SourceConfig b
sourceConfig)
                    else (RecreateEventTriggers, SourceCatalogMigrationState)
-> ExceptT
     QErr m (RecreateEventTriggers, SourceCatalogMigrationState)
forall a. a -> ExceptT QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RecreateEventTriggers
RETDoNothing, SourceCatalogMigrationState
SCMSUninitializedSource)
            )
          |)
          (((TableName b, [EventTriggerConf b]) -> [MetadataObject])
-> [(TableName b, [EventTriggerConf b])] -> [MetadataObject]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(TableName b
tableName, [EventTriggerConf b]
events) -> (EventTriggerConf b -> MetadataObject)
-> [EventTriggerConf b] -> [MetadataObject]
forall a b. (a -> b) -> [a] -> [b]
map (SourceName -> TableName b -> EventTriggerConf b -> MetadataObject
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> EventTriggerConf b -> MetadataObject
mkEventTriggerMetadataObject' SourceName
sourceName TableName b
tableName) [EventTriggerConf b]
events) [(TableName b, [EventTriggerConf b])]
eventTriggers)

      case Maybe (RecreateEventTriggers, SourceCatalogMigrationState)
res of
        Maybe (RecreateEventTriggers, SourceCatalogMigrationState)
Nothing ->
          arr
  (RecreateEventTriggers, SourceCatalogMigrationState)
  (RecreateEventTriggers, SourceCatalogMigrationState)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (RecreateEventTriggers
RETDoNothing, SourceCatalogMigrationState
SCMSUninitializedSource)
        Just (RecreateEventTriggers
recreateEventTriggers, SourceCatalogMigrationState
catalogMigrationState) -> arr
  (RecreateEventTriggers, SourceCatalogMigrationState)
  (RecreateEventTriggers, SourceCatalogMigrationState)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (RecreateEventTriggers
recreateEventTriggers, SourceCatalogMigrationState
catalogMigrationState)

    buildSource ::
      forall b arr m.
      ( ArrowChoice arr,
        ArrowKleisli m arr,
        ArrowWriter (Seq CollectItem) arr,
        MonadError QErr m,
        HasCacheStaticConfig m,
        MonadIO m,
        BackendMetadata b,
        GetAggregationPredicatesDeps b
      ) =>
      ( CacheDynamicConfig,
        HashMap SourceName (AB.AnyBackend PartiallyResolvedSource),
        SourceMetadata b,
        SourceConfig b,
        HashMap (TableName b) (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)),
        HashMap (TableName b) (EventTriggerInfoMap b),
        DBObjectsIntrospection b,
        PartiallyResolvedRemoteSchemaMap,
        OrderedRoles
      )
        `arr` (SourceInfo b)
    buildSource :: forall (b :: BackendType) (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowKleisli m arr,
 ArrowWriter (Seq CollectItem) arr, MonadError QErr m,
 HasCacheStaticConfig m, MonadIO m, BackendMetadata b,
 GetAggregationPredicatesDeps b) =>
arr
  (CacheDynamicConfig,
   HashMap SourceName (AnyBackend PartiallyResolvedSource),
   SourceMetadata b, SourceConfig b,
   HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)),
   HashMap (TableName b) (EventTriggerInfoMap b),
   DBObjectsIntrospection b, PartiallyResolvedRemoteSchemaMap,
   OrderedRoles)
  (SourceInfo b)
buildSource = proc (CacheDynamicConfig
dynamicConfig, HashMap SourceName (AnyBackend PartiallyResolvedSource)
allSources, SourceMetadata b
sourceMetadata, SourceConfig b
sourceConfig, HashMap
  (TableName b)
  (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
tablesRawInfo, HashMap (TableName b) (EventTriggerInfoMap b)
eventTriggerInfoMaps, DBObjectsIntrospection b
dbObjectsIntrospection, PartiallyResolvedRemoteSchemaMap
remoteSchemaMap, OrderedRoles
orderedRoles) -> do
      let DBObjectsIntrospection DBTablesMetadata b
_dbTables DBFunctionsMetadata b
dbFunctions ScalarMap b
_scalars LogicalModels b
introspectedLogicalModels = DBObjectsIntrospection b
dbObjectsIntrospection
          SourceMetadata SourceName
sourceName BackendSourceKind b
backendSourceKind Tables b
tables Functions b
functions NativeQueries b
nativeQueries StoredProcedures b
storedProcedures LogicalModels b
logicalModels SourceConnConfiguration b
_ Maybe QueryTagsConfig
queryTagsConfig SourceCustomization
sourceCustomization Maybe (HealthCheckConfig b)
_healthCheckConfig = SourceMetadata b
sourceMetadata
          tablesMetadata :: [TableMetadata b]
tablesMetadata = Tables b -> [TableMetadata b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems Tables b
tables
          ([TableBuildInput b]
_, [NonColumnTableInputs b]
nonColumnInputs, [TablePermissionInputs b]
permissions) = [(TableBuildInput b, NonColumnTableInputs b,
  TablePermissionInputs b)]
-> ([TableBuildInput b], [NonColumnTableInputs b],
    [TablePermissionInputs b])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(TableBuildInput b, NonColumnTableInputs b,
   TablePermissionInputs b)]
 -> ([TableBuildInput b], [NonColumnTableInputs b],
     [TablePermissionInputs b]))
-> [(TableBuildInput b, NonColumnTableInputs b,
     TablePermissionInputs b)]
-> ([TableBuildInput b], [NonColumnTableInputs b],
    [TablePermissionInputs b])
forall a b. (a -> b) -> a -> b
$ (TableMetadata b
 -> (TableBuildInput b, NonColumnTableInputs b,
     TablePermissionInputs b))
-> [TableMetadata b]
-> [(TableBuildInput b, NonColumnTableInputs b,
     TablePermissionInputs b)]
forall a b. (a -> b) -> [a] -> [b]
map TableMetadata b
-> (TableBuildInput b, NonColumnTableInputs b,
    TablePermissionInputs b)
forall (b :: BackendType).
TableMetadata b
-> (TableBuildInput b, NonColumnTableInputs b,
    TablePermissionInputs b)
mkTableInputs [TableMetadata b]
tablesMetadata
          alignTableMap :: HashMap (TableName b) a -> HashMap (TableName b) c -> HashMap (TableName b) (a, c)
          alignTableMap :: forall a c.
HashMap (TableName b) a
-> HashMap (TableName b) c -> HashMap (TableName b) (a, c)
alignTableMap = (a -> c -> (a, c))
-> HashMap (TableName b) a
-> HashMap (TableName b) c
-> HashMap (TableName b) (a, c)
forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HashMap.intersectionWith (,)

      -- relationships and computed fields
      let nonColumnsByTable :: HashMap (TableName b) (NonColumnTableInputs b)
nonColumnsByTable = (NonColumnTableInputs b -> TableName b)
-> [NonColumnTableInputs b]
-> HashMap (TableName b) (NonColumnTableInputs b)
forall k a. Hashable k => (a -> k) -> [a] -> HashMap k a
mapFromL NonColumnTableInputs b -> TableName b
forall (b :: BackendType). NonColumnTableInputs b -> TableName b
_nctiTable [NonColumnTableInputs b]
nonColumnInputs
      HashMap (TableName b) (TableCoreInfo b)
tableCoreInfos :: HashMap (TableName b) (TableCoreInfo b) <-
        arr
  (Writer
     (Seq CollectItem) (HashMap (TableName b) (TableCoreInfo b)))
  (HashMap (TableName b) (TableCoreInfo b))
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter
          -< HashMap
  (TableName b)
  (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b),
   NonColumnTableInputs b)
-> ((TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b),
     NonColumnTableInputs b)
    -> WriterT (Seq CollectItem) Identity (TableCoreInfo b))
-> Writer
     (Seq CollectItem) (HashMap (TableName b) (TableCoreInfo b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (HashMap
  (TableName b)
  (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
tablesRawInfo HashMap
  (TableName b)
  (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
-> HashMap (TableName b) (NonColumnTableInputs b)
-> HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b),
      NonColumnTableInputs b)
forall a c.
HashMap (TableName b) a
-> HashMap (TableName b) c -> HashMap (TableName b) (a, c)
`alignTableMap` HashMap (TableName b) (NonColumnTableInputs b)
nonColumnsByTable) \(TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
tableRawInfo, NonColumnTableInputs b
nonColumnInput) -> do
            let columns :: FieldInfoMap (StructuredColumnInfo b)
columns = TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
-> FieldInfoMap (StructuredColumnInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
tableRawInfo
            FieldInfoMap (FieldInfo b)
allFields :: FieldInfoMap (FieldInfo b) <- HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> SourceName
-> SourceConfig b
-> HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
-> FieldInfoMap (StructuredColumnInfo b)
-> PartiallyResolvedRemoteSchemaMap
-> DBFunctionsMetadata b
-> NonColumnTableInputs b
-> WriterT (Seq CollectItem) Identity (FieldInfoMap (FieldInfo b))
forall (b :: BackendType) (m :: * -> *).
(MonadWriter (Seq CollectItem) m, BackendMetadata b) =>
HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> SourceName
-> SourceConfig b
-> HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
-> FieldInfoMap (StructuredColumnInfo b)
-> PartiallyResolvedRemoteSchemaMap
-> DBFunctionsMetadata b
-> NonColumnTableInputs b
-> m (FieldInfoMap (FieldInfo b))
addNonColumnFields HashMap SourceName (AnyBackend PartiallyResolvedSource)
allSources SourceName
sourceName SourceConfig b
sourceConfig HashMap
  (TableName b)
  (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
tablesRawInfo FieldInfoMap (StructuredColumnInfo b)
columns PartiallyResolvedRemoteSchemaMap
remoteSchemaMap DBFunctionsMetadata b
dbFunctions NonColumnTableInputs b
nonColumnInput
            TableCoreInfo b
-> WriterT (Seq CollectItem) Identity (TableCoreInfo b)
forall a. a -> WriterT (Seq CollectItem) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TableCoreInfo b
 -> WriterT (Seq CollectItem) Identity (TableCoreInfo b))
-> TableCoreInfo b
-> WriterT (Seq CollectItem) Identity (TableCoreInfo b)
forall a b. (a -> b) -> a -> b
$ TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
tableRawInfo {_tciFieldInfoMap :: FieldInfoMap (FieldInfo b)
_tciFieldInfoMap = FieldInfoMap (FieldInfo b)
allFields}

      -- permissions
      Either QErr (HashMap (TableName b) (TableInfo b))
result <-
        arr
  (Writer
     (Seq CollectItem)
     (Either QErr (HashMap (TableName b) (TableInfo b))))
  (Either QErr (HashMap (TableName b) (TableInfo b)))
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter
          -< ExceptT
  QErr
  (WriterT (Seq CollectItem) Identity)
  (HashMap (TableName b) (TableInfo b))
-> Writer
     (Seq CollectItem)
     (Either QErr (HashMap (TableName b) (TableInfo b)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
            (ExceptT
   QErr
   (WriterT (Seq CollectItem) Identity)
   (HashMap (TableName b) (TableInfo b))
 -> Writer
      (Seq CollectItem)
      (Either QErr (HashMap (TableName b) (TableInfo b))))
-> ExceptT
     QErr
     (WriterT (Seq CollectItem) Identity)
     (HashMap (TableName b) (TableInfo b))
-> Writer
     (Seq CollectItem)
     (Either QErr (HashMap (TableName b) (TableInfo b)))
forall a b. (a -> b) -> a -> b
$ HashMap
  (TableName b)
  ((TableCoreInfo b, TablePermissionInputs b), EventTriggerInfoMap b)
-> (((TableCoreInfo b, TablePermissionInputs b),
     EventTriggerInfoMap b)
    -> ExceptT QErr (WriterT (Seq CollectItem) Identity) (TableInfo b))
-> ExceptT
     QErr
     (WriterT (Seq CollectItem) Identity)
     (HashMap (TableName b) (TableInfo b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for
              (HashMap (TableName b) (TableCoreInfo b)
tableCoreInfos HashMap (TableName b) (TableCoreInfo b)
-> HashMap (TableName b) (TablePermissionInputs b)
-> HashMap (TableName b) (TableCoreInfo b, TablePermissionInputs b)
forall a c.
HashMap (TableName b) a
-> HashMap (TableName b) c -> HashMap (TableName b) (a, c)
`alignTableMap` (TablePermissionInputs b -> TableName b)
-> [TablePermissionInputs b]
-> HashMap (TableName b) (TablePermissionInputs b)
forall k a. Hashable k => (a -> k) -> [a] -> HashMap k a
mapFromL TablePermissionInputs b -> TableName b
forall (b :: BackendType). TablePermissionInputs b -> TableName b
_tpiTable [TablePermissionInputs b]
permissions HashMap (TableName b) (TableCoreInfo b, TablePermissionInputs b)
-> HashMap (TableName b) (EventTriggerInfoMap b)
-> HashMap
     (TableName b)
     ((TableCoreInfo b, TablePermissionInputs b), EventTriggerInfoMap b)
forall a c.
HashMap (TableName b) a
-> HashMap (TableName b) c -> HashMap (TableName b) (a, c)
`alignTableMap` HashMap (TableName b) (EventTriggerInfoMap b)
eventTriggerInfoMaps)
              \((TableCoreInfo b
tableCoreInfo, TablePermissionInputs b
permissionInputs), EventTriggerInfoMap b
eventTriggerInfos) -> do
                let tableFields :: FieldInfoMap (FieldInfo b)
tableFields = TableCoreInfo b -> FieldInfoMap (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap TableCoreInfo b
tableCoreInfo
                RolePermInfoMap b
permissionInfos <-
                  (ReaderT
   (SourceConfig b)
   (ExceptT QErr (WriterT (Seq CollectItem) Identity))
   (RolePermInfoMap b)
 -> SourceConfig b
 -> ExceptT
      QErr (WriterT (Seq CollectItem) Identity) (RolePermInfoMap b))
-> SourceConfig b
-> ReaderT
     (SourceConfig b)
     (ExceptT QErr (WriterT (Seq CollectItem) Identity))
     (RolePermInfoMap b)
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (RolePermInfoMap b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  (SourceConfig b)
  (ExceptT QErr (WriterT (Seq CollectItem) Identity))
  (RolePermInfoMap b)
-> SourceConfig b
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (RolePermInfoMap b)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT SourceConfig b
sourceConfig
                    (ReaderT
   (SourceConfig b)
   (ExceptT QErr (WriterT (Seq CollectItem) Identity))
   (RolePermInfoMap b)
 -> ExceptT
      QErr (WriterT (Seq CollectItem) Identity) (RolePermInfoMap b))
-> ReaderT
     (SourceConfig b)
     (ExceptT QErr (WriterT (Seq CollectItem) Identity))
     (RolePermInfoMap b)
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (RolePermInfoMap b)
forall a b. (a -> b) -> a -> b
$ Environment
-> SourceName
-> HashMap (TableName b) (TableCoreInfo b)
-> FieldInfoMap (FieldInfo b)
-> TablePermissionInputs b
-> OrderedRoles
-> ReaderT
     (SourceConfig b)
     (ExceptT QErr (WriterT (Seq CollectItem) Identity))
     (RolePermInfoMap b)
forall (b :: BackendType) (m :: * -> *) r.
(MonadError QErr m, MonadWriter (Seq CollectItem) m,
 BackendMetadata b, GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
Environment
-> SourceName
-> TableCoreCache b
-> FieldInfoMap (FieldInfo b)
-> TablePermissionInputs b
-> OrderedRoles
-> m (RolePermInfoMap b)
buildTablePermissions
                      Environment
env
                      SourceName
sourceName
                      HashMap (TableName b) (TableCoreInfo b)
tableCoreInfos
                      FieldInfoMap (FieldInfo b)
tableFields
                      TablePermissionInputs b
permissionInputs
                      OrderedRoles
orderedRoles
                TableInfo b
-> ExceptT QErr (WriterT (Seq CollectItem) Identity) (TableInfo b)
forall a. a -> ExceptT QErr (WriterT (Seq CollectItem) Identity) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TableInfo b
 -> ExceptT QErr (WriterT (Seq CollectItem) Identity) (TableInfo b))
-> TableInfo b
-> ExceptT QErr (WriterT (Seq CollectItem) Identity) (TableInfo b)
forall a b. (a -> b) -> a -> b
$ TableCoreInfo b
-> RolePermInfoMap b
-> EventTriggerInfoMap b
-> RolePermInfo b
-> TableInfo b
forall (b :: BackendType).
TableCoreInfo b
-> RolePermInfoMap b
-> EventTriggerInfoMap b
-> RolePermInfo b
-> TableInfo b
TableInfo TableCoreInfo b
tableCoreInfo RolePermInfoMap b
permissionInfos EventTriggerInfoMap b
eventTriggerInfos (TableCoreInfo b -> RolePermInfo b
forall (b :: BackendType).
Backend b =>
TableCoreInfo b -> RolePermInfo b
mkAdminRolePermInfo TableCoreInfo b
tableCoreInfo)
      -- Generate a non-recoverable error when inherited roles were not ordered in a way that allows for building permissions to succeed
      HashMap (TableName b) (TableInfo b)
tableCache <- arr
  (m (HashMap (TableName b) (TableInfo b)))
  (HashMap (TableName b) (TableInfo b))
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< Either QErr (HashMap (TableName b) (TableInfo b))
-> m (HashMap (TableName b) (TableInfo b))
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither Either QErr (HashMap (TableName b) (TableInfo b))
result

      -- not forcing the evaluation here results in a measurable negative impact
      -- on memory residency as measured by our benchmark
      let !defaultNC :: NamingCase
defaultNC = CacheDynamicConfig -> NamingCase
_cdcDefaultNamingConvention CacheDynamicConfig
dynamicConfig
          !isNamingConventionEnabled :: Bool
isNamingConventionEnabled = ExperimentalFeature
EFNamingConventions ExperimentalFeature -> HashSet ExperimentalFeature -> Bool
forall a. Eq a => a -> HashSet a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (CacheDynamicConfig -> HashSet ExperimentalFeature
_cdcExperimentalFeatures CacheDynamicConfig
dynamicConfig)
      !NamingCase
namingConv <-
        arr (m NamingCase) NamingCase
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA
          -<
            if Bool
isNamingConventionEnabled
              then SourceCustomization
-> SupportedNamingCase -> NamingCase -> m NamingCase
forall (m :: * -> *).
MonadError QErr m =>
SourceCustomization
-> SupportedNamingCase -> NamingCase -> m NamingCase
getNamingCase SourceCustomization
sourceCustomization (forall (b :: BackendType). Backend b => SupportedNamingCase
namingConventionSupport @b) NamingCase
defaultNC
              else NamingCase -> m NamingCase
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NamingCase
HasuraCase
      let resolvedCustomization :: ResolvedSourceCustomization
resolvedCustomization = SourceCustomization -> NamingCase -> ResolvedSourceCustomization
mkResolvedSourceCustomization SourceCustomization
sourceCustomization NamingCase
namingConv

      -- sql functions
      [Maybe (FunctionInfo b)]
functionCacheMaybes <-
        arr
  (Writer (Seq CollectItem) [Maybe (FunctionInfo b)])
  [Maybe (FunctionInfo b)]
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter
          -< [FunctionMetadata b]
-> (FunctionMetadata b
    -> WriterT (Seq CollectItem) Identity (Maybe (FunctionInfo b)))
-> Writer (Seq CollectItem) [Maybe (FunctionInfo b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for
            (Functions b -> [FunctionMetadata b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems Functions b
functions)
            \case
              FunctionMetadata FunctionName b
qf FunctionConfig b
config [FunctionPermissionInfo]
functionPermissions Maybe Text
comment -> do
                let systemDefined :: SystemDefined
systemDefined = Bool -> SystemDefined
SystemDefined Bool
False
                    definition :: TrackFunction b
definition = forall (b :: BackendType). FunctionName b -> TrackFunction b
TrackFunction @b FunctionName b
qf
                    metadataObject :: MetadataObject
metadataObject =
                      MetadataObjId -> Value -> MetadataObject
MetadataObject
                        ( SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
sourceName
                            (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                            (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). FunctionName b -> SourceMetadataObjId b
SMOFunction @b FunctionName b
qf
                        )
                        (TrackFunction b -> Value
forall a. ToJSON a => a -> Value
toJSON TrackFunction b
definition)
                    schemaObject :: SchemaObjId
schemaObject =
                      SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
sourceName
                        (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                        (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). FunctionName b -> SourceObjId b
SOIFunction @b FunctionName b
qf
                    addFunctionContext :: Text -> Text
addFunctionContext Text
e = Text
"in function " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FunctionName b
qf FunctionName b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
                    metadataPermissions :: HashMap RoleName FunctionPermissionInfo
metadataPermissions = (FunctionPermissionInfo -> RoleName)
-> [FunctionPermissionInfo]
-> HashMap RoleName FunctionPermissionInfo
forall k a. Hashable k => (a -> k) -> [a] -> HashMap k a
mapFromL FunctionPermissionInfo -> RoleName
_fpmRole [FunctionPermissionInfo]
functionPermissions
                    permissionsMap :: HashMap RoleName FunctionPermissionInfo
permissionsMap = (RoleName -> FunctionPermissionInfo)
-> HashMap RoleName FunctionPermissionInfo
-> OrderedRoles
-> HashMap RoleName FunctionPermissionInfo
forall a.
(RoleName -> a)
-> HashMap RoleName a -> OrderedRoles -> HashMap RoleName a
mkBooleanPermissionMap RoleName -> FunctionPermissionInfo
FunctionPermissionInfo HashMap RoleName FunctionPermissionInfo
metadataPermissions OrderedRoles
orderedRoles
                MetadataObject
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (FunctionInfo b)
-> WriterT (Seq CollectItem) Identity (Maybe (FunctionInfo b))
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM MetadataObject
metadataObject (ExceptT QErr (WriterT (Seq CollectItem) Identity) (FunctionInfo b)
 -> WriterT (Seq CollectItem) Identity (Maybe (FunctionInfo b)))
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (FunctionInfo b)
-> WriterT (Seq CollectItem) Identity (Maybe (FunctionInfo b))
forall a b. (a -> b) -> a -> b
$ (Text -> Text)
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (FunctionInfo b)
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (FunctionInfo b)
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr Text -> Text
addFunctionContext do
                  FunctionOverloads b
funcDefs <-
                    Maybe (FunctionOverloads b)
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (FunctionOverloads b)
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (FunctionOverloads b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing
                      (FunctionName b
-> DBFunctionsMetadata b -> Maybe (FunctionOverloads b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup FunctionName b
qf DBFunctionsMetadata b
dbFunctions)
                      (Code
-> Text
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (FunctionOverloads b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists (Text
 -> ExceptT
      QErr (WriterT (Seq CollectItem) Identity) (FunctionOverloads b))
-> Text
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (FunctionOverloads b)
forall a b. (a -> b) -> a -> b
$ Text
"no such function exists: " Text -> FunctionName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> FunctionName b
qf)

                  RawFunctionInfo b
rawfunctionInfo <- forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
FunctionName b -> FunctionOverloads b -> m (RawFunctionInfo b)
getSingleUniqueFunctionOverload @b FunctionName b
qf FunctionOverloads b
funcDefs
                  (FunctionInfo b
functionInfo, SchemaDependency
dep) <- SourceName
-> FunctionName b
-> SystemDefined
-> FunctionConfig b
-> HashMap RoleName FunctionPermissionInfo
-> RawFunctionInfo b
-> Maybe Text
-> NamingCase
-> ExceptT
     QErr
     (WriterT (Seq CollectItem) Identity)
     (FunctionInfo b, SchemaDependency)
forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadError QErr m) =>
SourceName
-> FunctionName b
-> SystemDefined
-> FunctionConfig b
-> HashMap RoleName FunctionPermissionInfo
-> RawFunctionInfo b
-> Maybe Text
-> NamingCase
-> m (FunctionInfo b, SchemaDependency)
forall (m :: * -> *).
MonadError QErr m =>
SourceName
-> FunctionName b
-> SystemDefined
-> FunctionConfig b
-> HashMap RoleName FunctionPermissionInfo
-> RawFunctionInfo b
-> Maybe Text
-> NamingCase
-> m (FunctionInfo b, SchemaDependency)
buildFunctionInfo SourceName
sourceName FunctionName b
qf SystemDefined
systemDefined FunctionConfig b
config HashMap RoleName FunctionPermissionInfo
permissionsMap RawFunctionInfo b
rawfunctionInfo Maybe Text
comment NamingCase
namingConv
                  MetadataObject
-> SchemaObjId
-> Seq SchemaDependency
-> ExceptT QErr (WriterT (Seq CollectItem) Identity) ()
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
MetadataObject -> SchemaObjId -> Seq SchemaDependency -> m ()
recordDependenciesM MetadataObject
metadataObject SchemaObjId
schemaObject (SchemaDependency -> Seq SchemaDependency
forall a. a -> Seq a
Seq.singleton SchemaDependency
dep)
                  FunctionInfo b
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (FunctionInfo b)
forall a. a -> ExceptT QErr (WriterT (Seq CollectItem) Identity) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunctionInfo b
functionInfo

      let functionCache :: HashMap (FunctionName b) (FunctionInfo b)
functionCache = (FunctionInfo b -> FunctionName b)
-> [FunctionInfo b] -> HashMap (FunctionName b) (FunctionInfo b)
forall k a. Hashable k => (a -> k) -> [a] -> HashMap k a
mapFromL FunctionInfo b -> FunctionName b
forall (b :: BackendType). FunctionInfo b -> FunctionName b
_fiSQLName ([FunctionInfo b] -> HashMap (FunctionName b) (FunctionInfo b))
-> [FunctionInfo b] -> HashMap (FunctionName b) (FunctionInfo b)
forall a b. (a -> b) -> a -> b
$ [Maybe (FunctionInfo b)] -> [FunctionInfo b]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe (FunctionInfo b)]
functionCacheMaybes

      let mkLogicalModelMetadataObject :: LogicalModelMetadata b -> MetadataObject
          mkLogicalModelMetadataObject :: LogicalModelMetadata b -> MetadataObject
mkLogicalModelMetadataObject LogicalModelMetadata b
lmm =
            ( MetadataObjId -> Value -> MetadataObject
MetadataObject
                ( SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
sourceName
                    (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                    (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
LogicalModelName -> SourceMetadataObjId b
SMOLogicalModel @b (LogicalModelMetadata b -> LogicalModelName
forall (b :: BackendType).
LogicalModelMetadata b -> LogicalModelName
_lmmName LogicalModelMetadata b
lmm)
                )
                (LogicalModelMetadata b -> Value
forall a. ToJSON a => a -> Value
toJSON LogicalModelMetadata b
lmm)
            )

      -- fetch static config
      CacheStaticConfig
cacheStaticConfig <- arr (m CacheStaticConfig) CacheStaticConfig
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< m CacheStaticConfig
forall (m :: * -> *). HasCacheStaticConfig m => m CacheStaticConfig
askCacheStaticConfig

      -- Combine logical models that come from DB schema introspection with logical models
      -- provided via metadata. If two logical models have the same name the one from metadata is preferred.
      let unifiedLogicalModels :: LogicalModels b
unifiedLogicalModels = LogicalModels b
logicalModels LogicalModels b -> LogicalModels b -> LogicalModels b
forall a. Semigroup a => a -> a -> a
<> LogicalModels b
introspectedLogicalModels

      let getLogicalModelTypeDependencies ::
            LogicalModelType b ->
            S.Set LogicalModelName
          getLogicalModelTypeDependencies :: LogicalModelType b -> Set LogicalModelName
getLogicalModelTypeDependencies = \case
            LogicalModelTypeScalar LogicalModelTypeScalar b
_ -> Set LogicalModelName
forall a. Monoid a => a
mempty
            LogicalModelTypeArray (LogicalModelTypeArrayC LogicalModelType b
ltmaArray Bool
_) ->
              LogicalModelType b -> Set LogicalModelName
getLogicalModelTypeDependencies LogicalModelType b
ltmaArray
            LogicalModelTypeReference (LogicalModelTypeReferenceC LogicalModelName
lmtrr Bool
_) -> LogicalModelName -> Set LogicalModelName
forall a. a -> Set a
S.singleton LogicalModelName
lmtrr

      [Maybe (LogicalModelInfo b)]
logicalModelCacheMaybes <-
        arr
  (Writer (Seq CollectItem) [Maybe (LogicalModelInfo b)])
  [Maybe (LogicalModelInfo b)]
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter
          -< [LogicalModelMetadata b]
-> (LogicalModelMetadata b
    -> WriterT (Seq CollectItem) Identity (Maybe (LogicalModelInfo b)))
-> Writer (Seq CollectItem) [Maybe (LogicalModelInfo b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for
            (LogicalModels b -> [LogicalModelMetadata b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems LogicalModels b
unifiedLogicalModels)
            \lmm :: LogicalModelMetadata b
lmm@LogicalModelMetadata {Maybe Text
InsOrdHashMap RoleName (SelPermDef b)
InsOrdHashMap (Column b) (LogicalModelField b)
LogicalModelName
_lmmName :: forall (b :: BackendType).
LogicalModelMetadata b -> LogicalModelName
_lmmName :: LogicalModelName
_lmmFields :: InsOrdHashMap (Column b) (LogicalModelField b)
_lmmDescription :: Maybe Text
_lmmSelectPermissions :: InsOrdHashMap RoleName (SelPermDef b)
_lmmFields :: forall (b :: BackendType).
LogicalModelMetadata b
-> InsOrdHashMap (Column b) (LogicalModelField b)
_lmmDescription :: forall (b :: BackendType). LogicalModelMetadata b -> Maybe Text
_lmmSelectPermissions :: forall (b :: BackendType).
LogicalModelMetadata b -> InsOrdHashMap RoleName (SelPermDef b)
..} ->
              MetadataObject
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (LogicalModelInfo b)
-> WriterT (Seq CollectItem) Identity (Maybe (LogicalModelInfo b))
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM (LogicalModelMetadata b -> MetadataObject
mkLogicalModelMetadataObject LogicalModelMetadata b
lmm) (ExceptT
   QErr (WriterT (Seq CollectItem) Identity) (LogicalModelInfo b)
 -> WriterT (Seq CollectItem) Identity (Maybe (LogicalModelInfo b)))
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (LogicalModelInfo b)
-> WriterT (Seq CollectItem) Identity (Maybe (LogicalModelInfo b))
forall a b. (a -> b) -> a -> b
$ do
                RolePermInfoMap b
logicalModelPermissions <-
                  (ReaderT
   (SourceConfig b)
   (ExceptT QErr (WriterT (Seq CollectItem) Identity))
   (RolePermInfoMap b)
 -> SourceConfig b
 -> ExceptT
      QErr (WriterT (Seq CollectItem) Identity) (RolePermInfoMap b))
-> SourceConfig b
-> ReaderT
     (SourceConfig b)
     (ExceptT QErr (WriterT (Seq CollectItem) Identity))
     (RolePermInfoMap b)
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (RolePermInfoMap b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  (SourceConfig b)
  (ExceptT QErr (WriterT (Seq CollectItem) Identity))
  (RolePermInfoMap b)
-> SourceConfig b
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (RolePermInfoMap b)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT SourceConfig b
sourceConfig (ReaderT
   (SourceConfig b)
   (ExceptT QErr (WriterT (Seq CollectItem) Identity))
   (RolePermInfoMap b)
 -> ExceptT
      QErr (WriterT (Seq CollectItem) Identity) (RolePermInfoMap b))
-> ReaderT
     (SourceConfig b)
     (ExceptT QErr (WriterT (Seq CollectItem) Identity))
     (RolePermInfoMap b)
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (RolePermInfoMap b)
forall a b. (a -> b) -> a -> b
$ SourceName
-> HashMap (TableName b) (TableCoreInfo b)
-> LogicalModelName
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> InsOrdHashMap RoleName (SelPermDef b)
-> OrderedRoles
-> ReaderT
     (SourceConfig b)
     (ExceptT QErr (WriterT (Seq CollectItem) Identity))
     (RolePermInfoMap b)
forall (b :: BackendType) (m :: * -> *) r.
(MonadError QErr m, MonadWriter (Seq CollectItem) m,
 BackendMetadata b, GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
SourceName
-> TableCoreCache b
-> LogicalModelName
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> InsOrdHashMap RoleName (SelPermDef b)
-> OrderedRoles
-> m (RolePermInfoMap b)
buildLogicalModelPermissions SourceName
sourceName HashMap (TableName b) (TableCoreInfo b)
tableCoreInfos LogicalModelName
_lmmName InsOrdHashMap (Column b) (LogicalModelField b)
_lmmFields InsOrdHashMap RoleName (SelPermDef b)
_lmmSelectPermissions OrderedRoles
orderedRoles

                let recordDependency :: LogicalModelName
-> ExceptT QErr (WriterT (Seq CollectItem) Identity) ()
recordDependency LogicalModelName
logicalModelName = do
                      let metadataObject :: MetadataObject
metadataObject =
                            MetadataObjId -> Value -> MetadataObject
MetadataObject
                              ( SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
sourceName
                                  (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                                  (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
LogicalModelName
-> LogicalModelMetadataObjId -> SourceMetadataObjId b
SMOLogicalModelObj @b LogicalModelName
_lmmName
                                  (LogicalModelMetadataObjId -> SourceMetadataObjId b)
-> LogicalModelMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$ LogicalModelName -> LogicalModelMetadataObjId
LMMOReferencedLogicalModel LogicalModelName
logicalModelName
                              )
                              ( LogicalModelMetadata b -> Value
forall a. ToJSON a => a -> Value
toJSON LogicalModelMetadata b
lmm
                              )

                          sourceObject :: SchemaObjId
                          sourceObject :: SchemaObjId
sourceObject =
                            SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
sourceName
                              (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                              (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
LogicalModelName -> LogicalModelObjId b -> SourceObjId b
SOILogicalModelObj @b LogicalModelName
_lmmName
                              (LogicalModelObjId b -> SourceObjId b)
-> LogicalModelObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$ LogicalModelName -> LogicalModelObjId b
forall (b :: BackendType). LogicalModelName -> LogicalModelObjId b
LMOReferencedLogicalModel LogicalModelName
logicalModelName

                      MetadataObject
-> SchemaObjId
-> Seq SchemaDependency
-> ExceptT QErr (WriterT (Seq CollectItem) Identity) ()
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
MetadataObject -> SchemaObjId -> Seq SchemaDependency -> m ()
recordDependenciesM MetadataObject
metadataObject SchemaObjId
sourceObject
                        (Seq SchemaDependency
 -> ExceptT QErr (WriterT (Seq CollectItem) Identity) ())
-> Seq SchemaDependency
-> ExceptT QErr (WriterT (Seq CollectItem) Identity) ()
forall a b. (a -> b) -> a -> b
$ SchemaDependency -> Seq SchemaDependency
forall a. a -> Seq a
Seq.singleton (SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency SchemaObjId
sourceObject DependencyReason
DRReferencedLogicalModel)

                -- record a dependency with each Logical Model our types
                -- reference
                (LogicalModelName
 -> ExceptT QErr (WriterT (Seq CollectItem) Identity) ())
-> [LogicalModelName]
-> ExceptT QErr (WriterT (Seq CollectItem) Identity) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LogicalModelName
-> ExceptT QErr (WriterT (Seq CollectItem) Identity) ()
recordDependency ((LogicalModelField b -> [LogicalModelName])
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> [LogicalModelName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Set LogicalModelName -> [LogicalModelName]
forall a. Set a -> [a]
S.toList (Set LogicalModelName -> [LogicalModelName])
-> (LogicalModelField b -> Set LogicalModelName)
-> LogicalModelField b
-> [LogicalModelName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalModelType b -> Set LogicalModelName
getLogicalModelTypeDependencies (LogicalModelType b -> Set LogicalModelName)
-> (LogicalModelField b -> LogicalModelType b)
-> LogicalModelField b
-> Set LogicalModelName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalModelField b -> LogicalModelType b
forall (b :: BackendType).
LogicalModelField b -> LogicalModelType b
lmfType) InsOrdHashMap (Column b) (LogicalModelField b)
_lmmFields)

                LogicalModelInfo b
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) (LogicalModelInfo b)
forall a. a -> ExceptT QErr (WriterT (Seq CollectItem) Identity) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                  LogicalModelInfo
                    { _lmiName :: LogicalModelName
_lmiName = LogicalModelName
_lmmName,
                      _lmiFields :: InsOrdHashMap (Column b) (LogicalModelField b)
_lmiFields = InsOrdHashMap (Column b) (LogicalModelField b)
_lmmFields,
                      _lmiPermissions :: RolePermInfoMap b
_lmiPermissions = RolePermInfoMap b
logicalModelPermissions,
                      _lmiDescription :: Maybe Text
_lmiDescription = Maybe Text
_lmmDescription
                    }

      let logicalModelsCache :: LogicalModelCache b
          logicalModelsCache :: LogicalModelCache b
logicalModelsCache = (LogicalModelInfo b -> LogicalModelName)
-> [LogicalModelInfo b] -> LogicalModelCache b
forall k a. Hashable k => (a -> k) -> [a] -> HashMap k a
mapFromL LogicalModelInfo b -> LogicalModelName
forall (b :: BackendType). LogicalModelInfo b -> LogicalModelName
_lmiName ([Maybe (LogicalModelInfo b)] -> [LogicalModelInfo b]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe (LogicalModelInfo b)]
logicalModelCacheMaybes)

      [Maybe (NativeQueryInfo b)]
nativeQueryCacheMaybes <-
        arr
  (WriterT (Seq CollectItem) m [Maybe (NativeQueryInfo b)])
  [Maybe (NativeQueryInfo b)]
forall (m :: * -> *) (arr :: * -> * -> *) w a.
(ArrowKleisli m arr, ArrowWriter w arr) =>
arr (WriterT w m a) a
interpretWriterT
          -< [NativeQueryMetadata b]
-> (NativeQueryMetadata b
    -> WriterT (Seq CollectItem) m (Maybe (NativeQueryInfo b)))
-> WriterT (Seq CollectItem) m [Maybe (NativeQueryInfo b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for
            (NativeQueries b -> [NativeQueryMetadata b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems NativeQueries b
nativeQueries)
            \preValidationNativeQuery :: NativeQueryMetadata b
preValidationNativeQuery@NativeQueryMetadata {NativeQueryName
_nqmRootFieldName :: NativeQueryName
_nqmRootFieldName :: forall (b :: BackendType). NativeQueryMetadata b -> NativeQueryName
_nqmRootFieldName, LogicalModelIdentifier b
_nqmReturns :: LogicalModelIdentifier b
_nqmReturns :: forall (b :: BackendType).
NativeQueryMetadata b -> LogicalModelIdentifier b
_nqmReturns, HashMap ArgumentName (NullableScalarType b)
_nqmArguments :: HashMap ArgumentName (NullableScalarType b)
_nqmArguments :: forall (b :: BackendType).
NativeQueryMetadata b
-> HashMap ArgumentName (NullableScalarType b)
_nqmArguments, Maybe Text
_nqmDescription :: Maybe Text
_nqmDescription :: forall (b :: BackendType). NativeQueryMetadata b -> Maybe Text
_nqmDescription} -> do
              let metadataObject :: MetadataObject
                  metadataObject :: MetadataObject
metadataObject =
                    MetadataObjId -> Value -> MetadataObject
MetadataObject
                      ( SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
sourceName
                          (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                          (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). NativeQueryName -> SourceMetadataObjId b
SMONativeQuery @b NativeQueryName
_nqmRootFieldName
                      )
                      (NativeQueryMetadata b -> Value
forall a. ToJSON a => a -> Value
toJSON NativeQueryMetadata b
preValidationNativeQuery)

                  schemaObjId :: SchemaObjId
                  schemaObjId :: SchemaObjId
schemaObjId =
                    SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
sourceName
                      (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                      (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). NativeQueryName -> SourceObjId b
SOINativeQuery @b NativeQueryName
_nqmRootFieldName

                  -- we only have a dependency if we used a named Logical Model
                  maybeDependency :: Maybe SchemaDependency
                  maybeDependency :: Maybe SchemaDependency
maybeDependency = case LogicalModelIdentifier b
_nqmReturns of
                    LMILogicalModelName LogicalModelName
logicalModelName ->
                      SchemaDependency -> Maybe SchemaDependency
forall a. a -> Maybe a
Just
                        (SchemaDependency -> Maybe SchemaDependency)
-> SchemaDependency -> Maybe SchemaDependency
forall a b. (a -> b) -> a -> b
$ SchemaDependency
                          { sdObjId :: SchemaObjId
sdObjId =
                              SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
sourceName
                                (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                                (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). LogicalModelName -> SourceObjId b
SOILogicalModel @b LogicalModelName
logicalModelName,
                            sdReason :: DependencyReason
sdReason = DependencyReason
DRLogicalModel
                          }
                    LMIInlineLogicalModel InlineLogicalModelMetadata b
_ -> Maybe SchemaDependency
forall a. Maybe a
Nothing

              MetadataObject
-> ExceptT QErr (WriterT (Seq CollectItem) m) (NativeQueryInfo b)
-> WriterT (Seq CollectItem) m (Maybe (NativeQueryInfo b))
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM MetadataObject
metadataObject (ExceptT QErr (WriterT (Seq CollectItem) m) (NativeQueryInfo b)
 -> WriterT (Seq CollectItem) m (Maybe (NativeQueryInfo b)))
-> ExceptT QErr (WriterT (Seq CollectItem) m) (NativeQueryInfo b)
-> WriterT (Seq CollectItem) m (Maybe (NativeQueryInfo b))
forall a b. (a -> b) -> a -> b
$ do
                Bool
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CacheStaticConfig -> BackendType -> Bool
_cscAreNativeQueriesEnabled CacheStaticConfig
cacheStaticConfig (BackendTag b -> BackendType
forall (b :: BackendType). BackendTag b -> BackendType
reify (BackendTag b -> BackendType) -> BackendTag b -> BackendType
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). HasTag b => BackendTag b
backendTag @b))
                  (ExceptT QErr (WriterT (Seq CollectItem) m) ()
 -> ExceptT QErr (WriterT (Seq CollectItem) m) ())
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
InvalidConfiguration Text
"The Native Queries feature is disabled"

                LogicalModelInfo b
logicalModel <- case LogicalModelIdentifier b
_nqmReturns of
                  LMILogicalModelName LogicalModelName
logicalModelName ->
                    Maybe (LogicalModelInfo b)
-> ExceptT QErr (WriterT (Seq CollectItem) m) (LogicalModelInfo b)
-> ExceptT QErr (WriterT (Seq CollectItem) m) (LogicalModelInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing
                      (LogicalModelName
-> LogicalModelCache b -> Maybe (LogicalModelInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup LogicalModelName
logicalModelName LogicalModelCache b
logicalModelsCache)
                      (Code
-> Text
-> ExceptT QErr (WriterT (Seq CollectItem) m) (LogicalModelInfo b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
InvalidConfiguration (Text
"The logical model " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LogicalModelName -> Text
forall a. ToTxt a => a -> Text
toTxt LogicalModelName
logicalModelName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" could not be found"))
                  LMIInlineLogicalModel (InlineLogicalModelMetadata {InsOrdHashMap (Column b) (LogicalModelField b)
_ilmmFields :: InsOrdHashMap (Column b) (LogicalModelField b)
_ilmmFields :: forall (b :: BackendType).
InlineLogicalModelMetadata b
-> InsOrdHashMap (Column b) (LogicalModelField b)
_ilmmFields, InsOrdHashMap RoleName (SelPermDef b)
_ilmmSelectPermissions :: InsOrdHashMap RoleName (SelPermDef b)
_ilmmSelectPermissions :: forall (b :: BackendType).
InlineLogicalModelMetadata b
-> InsOrdHashMap RoleName (SelPermDef b)
_ilmmSelectPermissions}) -> do
                    let logicalModelName :: LogicalModelName
logicalModelName = Name -> LogicalModelName
LogicalModelName (NativeQueryName -> Name
getNativeQueryName NativeQueryName
_nqmRootFieldName)

                        recordDependency :: LogicalModelName -> ExceptT QErr (WriterT (Seq CollectItem) m) ()
recordDependency LogicalModelName
innerLogicalModelName = do
                          let nqMetadataObject :: MetadataObject
nqMetadataObject =
                                MetadataObjId -> Value -> MetadataObject
MetadataObject
                                  ( SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
sourceName
                                      (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                                      (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
NativeQueryName
-> NativeQueryMetadataObjId -> SourceMetadataObjId b
SMONativeQueryObj @b NativeQueryName
_nqmRootFieldName
                                      (NativeQueryMetadataObjId -> SourceMetadataObjId b)
-> NativeQueryMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$ LogicalModelName -> NativeQueryMetadataObjId
NQMOReferencedLogicalModel LogicalModelName
innerLogicalModelName
                                  )
                                  ( NativeQueryMetadata b -> Value
forall a. ToJSON a => a -> Value
toJSON NativeQueryMetadata b
preValidationNativeQuery
                                  )

                              nqSourceObject :: SchemaObjId
                              nqSourceObject :: SchemaObjId
nqSourceObject =
                                SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
sourceName
                                  (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                                  (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
NativeQueryName -> NativeQueryObjId b -> SourceObjId b
SOINativeQueryObj @b NativeQueryName
_nqmRootFieldName
                                  (NativeQueryObjId b -> SourceObjId b)
-> NativeQueryObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$ LogicalModelName -> NativeQueryObjId b
forall (b :: BackendType). LogicalModelName -> NativeQueryObjId b
NQOReferencedLogicalModel LogicalModelName
innerLogicalModelName

                          MetadataObject
-> SchemaObjId
-> Seq SchemaDependency
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
MetadataObject -> SchemaObjId -> Seq SchemaDependency -> m ()
recordDependenciesM MetadataObject
nqMetadataObject SchemaObjId
nqSourceObject
                            (Seq SchemaDependency
 -> ExceptT QErr (WriterT (Seq CollectItem) m) ())
-> Seq SchemaDependency
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall a b. (a -> b) -> a -> b
$ SchemaDependency -> Seq SchemaDependency
forall a. a -> Seq a
Seq.singleton (SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency SchemaObjId
nqSourceObject DependencyReason
DRReferencedLogicalModel)

                    RolePermInfoMap b
logicalModelPermissions <-
                      (ReaderT
   (SourceConfig b)
   (ExceptT QErr (WriterT (Seq CollectItem) m))
   (RolePermInfoMap b)
 -> SourceConfig b
 -> ExceptT QErr (WriterT (Seq CollectItem) m) (RolePermInfoMap b))
-> SourceConfig b
-> ReaderT
     (SourceConfig b)
     (ExceptT QErr (WriterT (Seq CollectItem) m))
     (RolePermInfoMap b)
-> ExceptT QErr (WriterT (Seq CollectItem) m) (RolePermInfoMap b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  (SourceConfig b)
  (ExceptT QErr (WriterT (Seq CollectItem) m))
  (RolePermInfoMap b)
-> SourceConfig b
-> ExceptT QErr (WriterT (Seq CollectItem) m) (RolePermInfoMap b)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT SourceConfig b
sourceConfig (ReaderT
   (SourceConfig b)
   (ExceptT QErr (WriterT (Seq CollectItem) m))
   (RolePermInfoMap b)
 -> ExceptT QErr (WriterT (Seq CollectItem) m) (RolePermInfoMap b))
-> ReaderT
     (SourceConfig b)
     (ExceptT QErr (WriterT (Seq CollectItem) m))
     (RolePermInfoMap b)
-> ExceptT QErr (WriterT (Seq CollectItem) m) (RolePermInfoMap b)
forall a b. (a -> b) -> a -> b
$ SourceName
-> HashMap (TableName b) (TableCoreInfo b)
-> LogicalModelName
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> InsOrdHashMap RoleName (SelPermDef b)
-> OrderedRoles
-> ReaderT
     (SourceConfig b)
     (ExceptT QErr (WriterT (Seq CollectItem) m))
     (RolePermInfoMap b)
forall (b :: BackendType) (m :: * -> *) r.
(MonadError QErr m, MonadWriter (Seq CollectItem) m,
 BackendMetadata b, GetAggregationPredicatesDeps b, MonadReader r m,
 Has (ScalarTypeParsingContext b) r) =>
SourceName
-> TableCoreCache b
-> LogicalModelName
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> InsOrdHashMap RoleName (SelPermDef b)
-> OrderedRoles
-> m (RolePermInfoMap b)
buildLogicalModelPermissions SourceName
sourceName HashMap (TableName b) (TableCoreInfo b)
tableCoreInfos LogicalModelName
logicalModelName InsOrdHashMap (Column b) (LogicalModelField b)
_ilmmFields InsOrdHashMap RoleName (SelPermDef b)
_ilmmSelectPermissions OrderedRoles
orderedRoles

                    -- record a dependency with each Logical Model our types reference
                    (LogicalModelName -> ExceptT QErr (WriterT (Seq CollectItem) m) ())
-> [LogicalModelName]
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LogicalModelName -> ExceptT QErr (WriterT (Seq CollectItem) m) ()
recordDependency ((LogicalModelField b -> [LogicalModelName])
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> [LogicalModelName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Set LogicalModelName -> [LogicalModelName]
forall a. Set a -> [a]
S.toList (Set LogicalModelName -> [LogicalModelName])
-> (LogicalModelField b -> Set LogicalModelName)
-> LogicalModelField b
-> [LogicalModelName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalModelType b -> Set LogicalModelName
getLogicalModelTypeDependencies (LogicalModelType b -> Set LogicalModelName)
-> (LogicalModelField b -> LogicalModelType b)
-> LogicalModelField b
-> Set LogicalModelName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalModelField b -> LogicalModelType b
forall (b :: BackendType).
LogicalModelField b -> LogicalModelType b
lmfType) InsOrdHashMap (Column b) (LogicalModelField b)
_ilmmFields)

                    LogicalModelInfo b
-> ExceptT QErr (WriterT (Seq CollectItem) m) (LogicalModelInfo b)
forall a. a -> ExceptT QErr (WriterT (Seq CollectItem) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                      (LogicalModelInfo b
 -> ExceptT QErr (WriterT (Seq CollectItem) m) (LogicalModelInfo b))
-> LogicalModelInfo b
-> ExceptT QErr (WriterT (Seq CollectItem) m) (LogicalModelInfo b)
forall a b. (a -> b) -> a -> b
$ LogicalModelInfo
                        { _lmiName :: LogicalModelName
_lmiName = LogicalModelName
logicalModelName,
                          _lmiFields :: InsOrdHashMap (Column b) (LogicalModelField b)
_lmiFields = InsOrdHashMap (Column b) (LogicalModelField b)
_ilmmFields,
                          _lmiDescription :: Maybe Text
_lmiDescription = Maybe Text
_nqmDescription,
                          _lmiPermissions :: RolePermInfoMap b
_lmiPermissions = RolePermInfoMap b
logicalModelPermissions
                        }
                InterpolatedQuery ArgumentName
nqmCode <- forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadIO m, MonadError QErr m) =>
Environment
-> SourceConnConfiguration b
-> LogicalModelInfo b
-> NativeQueryMetadata b
-> m (InterpolatedQuery ArgumentName)
validateNativeQuery @b Environment
env (SourceMetadata b -> SourceConnConfiguration b
forall (b :: BackendType).
SourceMetadata b -> SourceConnConfiguration b
_smConfiguration SourceMetadata b
sourceMetadata) LogicalModelInfo b
logicalModel NativeQueryMetadata b
preValidationNativeQuery

                case Maybe SchemaDependency
maybeDependency of
                  Just SchemaDependency
dependency ->
                    MetadataObject
-> SchemaObjId
-> Seq SchemaDependency
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
MetadataObject -> SchemaObjId -> Seq SchemaDependency -> m ()
recordDependenciesM MetadataObject
metadataObject SchemaObjId
schemaObjId
                      (Seq SchemaDependency
 -> ExceptT QErr (WriterT (Seq CollectItem) m) ())
-> Seq SchemaDependency
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall a b. (a -> b) -> a -> b
$ SchemaDependency -> Seq SchemaDependency
forall a. a -> Seq a
Seq.singleton SchemaDependency
dependency
                  Maybe SchemaDependency
Nothing -> () -> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall a. a -> ExceptT QErr (WriterT (Seq CollectItem) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

                InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency)
arrayRelationships <-
                  (RelDef (RelManualNativeQueryConfig b)
 -> ExceptT
      QErr
      (WriterT (Seq CollectItem) m)
      (RelInfo b, Seq SchemaDependency))
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
-> ExceptT
     QErr
     (WriterT (Seq CollectItem) m)
     (InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> InsOrdHashMap RelName a -> f (InsOrdHashMap RelName b)
traverse
                    (SourceName
-> NativeQueryName
-> RelType
-> RelDef (RelManualNativeQueryConfig b)
-> ExceptT
     QErr
     (WriterT (Seq CollectItem) m)
     (RelInfo b, Seq SchemaDependency)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
SourceName
-> NativeQueryName
-> RelType
-> RelDef (RelManualNativeQueryConfig b)
-> m (RelInfo b, Seq SchemaDependency)
nativeQueryRelationshipSetup SourceName
sourceName NativeQueryName
_nqmRootFieldName RelType
ArrRel)
                    (NativeQueryMetadata b
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
forall (b :: BackendType).
NativeQueryMetadata b
-> Relationships (RelDef (RelManualNativeQueryConfig b))
_nqmArrayRelationships NativeQueryMetadata b
preValidationNativeQuery)

                InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency)
objectRelationships <-
                  (RelDef (RelManualNativeQueryConfig b)
 -> ExceptT
      QErr
      (WriterT (Seq CollectItem) m)
      (RelInfo b, Seq SchemaDependency))
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
-> ExceptT
     QErr
     (WriterT (Seq CollectItem) m)
     (InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> InsOrdHashMap RelName a -> f (InsOrdHashMap RelName b)
traverse
                    (SourceName
-> NativeQueryName
-> RelType
-> RelDef (RelManualNativeQueryConfig b)
-> ExceptT
     QErr
     (WriterT (Seq CollectItem) m)
     (RelInfo b, Seq SchemaDependency)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
SourceName
-> NativeQueryName
-> RelType
-> RelDef (RelManualNativeQueryConfig b)
-> m (RelInfo b, Seq SchemaDependency)
nativeQueryRelationshipSetup SourceName
sourceName NativeQueryName
_nqmRootFieldName RelType
ObjRel)
                    (NativeQueryMetadata b
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
forall (b :: BackendType).
NativeQueryMetadata b
-> Relationships (RelDef (RelManualNativeQueryConfig b))
_nqmObjectRelationships NativeQueryMetadata b
preValidationNativeQuery)

                let duplicates :: Set RelName
duplicates =
                      Set RelName -> Set RelName -> Set RelName
forall a. Ord a => Set a -> Set a -> Set a
S.intersection
                        ([RelName] -> Set RelName
forall a. Ord a => [a] -> Set a
S.fromList ([RelName] -> Set RelName) -> [RelName] -> Set RelName
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency)
-> [RelName]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency)
arrayRelationships)
                        ([RelName] -> Set RelName
forall a. Ord a => [a] -> Set a
S.fromList ([RelName] -> Set RelName) -> [RelName] -> Set RelName
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency)
-> [RelName]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency)
objectRelationships)

                -- it is possible to have the same field name in both `array`
                -- and `object`, let's stop that
                Bool
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set RelName -> Bool
forall a. Set a -> Bool
S.null Set RelName
duplicates)
                  (ExceptT QErr (WriterT (Seq CollectItem) m) ()
 -> ExceptT QErr (WriterT (Seq CollectItem) m) ())
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
InvalidConfiguration
                  (Text -> ExceptT QErr (WriterT (Seq CollectItem) m) ())
-> Text -> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall a b. (a -> b) -> a -> b
$ Text
"The native query '"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NativeQueryName -> Text
forall a. ToTxt a => a -> Text
toTxt NativeQueryName
_nqmRootFieldName
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' has duplicate relationships: "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," (RelName -> Text
forall a. ToTxt a => a -> Text
toTxt (RelName -> Text) -> [RelName] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set RelName -> [RelName]
forall a. Set a -> [a]
S.toList Set RelName
duplicates)

                let sourceObject :: SchemaObjId
sourceObject =
                      SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
sourceName
                        (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                        (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). NativeQueryName -> SourceObjId b
SOINativeQuery @b NativeQueryName
_nqmRootFieldName

                let dependencies :: Seq SchemaDependency
dependencies =
                      [Seq SchemaDependency] -> Seq SchemaDependency
forall a. Monoid a => [a] -> a
mconcat ((RelInfo b, Seq SchemaDependency) -> Seq SchemaDependency
forall a b. (a, b) -> b
snd ((RelInfo b, Seq SchemaDependency) -> Seq SchemaDependency)
-> [(RelInfo b, Seq SchemaDependency)] -> [Seq SchemaDependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency)
-> [(RelInfo b, Seq SchemaDependency)]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency)
arrayRelationships)
                        Seq SchemaDependency
-> Seq SchemaDependency -> Seq SchemaDependency
forall a. Semigroup a => a -> a -> a
<> [Seq SchemaDependency] -> Seq SchemaDependency
forall a. Monoid a => [a] -> a
mconcat ((RelInfo b, Seq SchemaDependency) -> Seq SchemaDependency
forall a b. (a, b) -> b
snd ((RelInfo b, Seq SchemaDependency) -> Seq SchemaDependency)
-> [(RelInfo b, Seq SchemaDependency)] -> [Seq SchemaDependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency)
-> [(RelInfo b, Seq SchemaDependency)]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency)
objectRelationships)

                MetadataObject
-> SchemaObjId
-> Seq SchemaDependency
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
MetadataObject -> SchemaObjId -> Seq SchemaDependency -> m ()
recordDependenciesM MetadataObject
metadataObject SchemaObjId
sourceObject Seq SchemaDependency
dependencies

                NativeQueryInfo b
-> ExceptT QErr (WriterT (Seq CollectItem) m) (NativeQueryInfo b)
forall a. a -> ExceptT QErr (WriterT (Seq CollectItem) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                  NativeQueryInfo
                    { _nqiRootFieldName :: NativeQueryName
_nqiRootFieldName = NativeQueryName
_nqmRootFieldName,
                      _nqiCode :: InterpolatedQuery ArgumentName
_nqiCode = InterpolatedQuery ArgumentName
nqmCode,
                      _nqiReturns :: LogicalModelInfo b
_nqiReturns = LogicalModelInfo b
logicalModel,
                      _nqiArguments :: HashMap ArgumentName (NullableScalarType b)
_nqiArguments = HashMap ArgumentName (NullableScalarType b)
_nqmArguments,
                      _nqiRelationships :: InsOrdHashMap RelName (RelInfo b)
_nqiRelationships = (RelInfo b, Seq SchemaDependency) -> RelInfo b
forall a b. (a, b) -> a
fst ((RelInfo b, Seq SchemaDependency) -> RelInfo b)
-> InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency)
-> InsOrdHashMap RelName (RelInfo b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency)
arrayRelationships InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency)
-> InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency)
-> InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency)
forall a. Semigroup a => a -> a -> a
<> InsOrdHashMap RelName (RelInfo b, Seq SchemaDependency)
objectRelationships),
                      _nqiDescription :: Maybe Text
_nqiDescription = Maybe Text
_nqmDescription
                    }

      let nativeQueryCache :: NativeQueryCache b
          nativeQueryCache :: NativeQueryCache b
nativeQueryCache = (NativeQueryInfo b -> NativeQueryName)
-> [NativeQueryInfo b] -> NativeQueryCache b
forall k a. Hashable k => (a -> k) -> [a] -> HashMap k a
mapFromL NativeQueryInfo b -> NativeQueryName
forall (b :: BackendType). NativeQueryInfo b -> NativeQueryName
_nqiRootFieldName ([Maybe (NativeQueryInfo b)] -> [NativeQueryInfo b]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe (NativeQueryInfo b)]
nativeQueryCacheMaybes)

      [Maybe (StoredProcedureInfo b)]
storedProcedureCacheMaybes <-
        arr
  (WriterT (Seq CollectItem) m [Maybe (StoredProcedureInfo b)])
  [Maybe (StoredProcedureInfo b)]
forall (m :: * -> *) (arr :: * -> * -> *) w a.
(ArrowKleisli m arr, ArrowWriter w arr) =>
arr (WriterT w m a) a
interpretWriterT
          -< [StoredProcedureMetadata b]
-> (StoredProcedureMetadata b
    -> WriterT (Seq CollectItem) m (Maybe (StoredProcedureInfo b)))
-> WriterT (Seq CollectItem) m [Maybe (StoredProcedureInfo b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for
            (StoredProcedures b -> [StoredProcedureMetadata b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems StoredProcedures b
storedProcedures)
            \spm :: StoredProcedureMetadata b
spm@StoredProcedureMetadata {Maybe Text
HashMap ArgumentName (NullableScalarType b)
FunctionName b
LogicalModelName
StoredProcedureConfig
_spmStoredProcedure :: FunctionName b
_spmConfig :: StoredProcedureConfig
_spmReturns :: LogicalModelName
_spmArguments :: HashMap ArgumentName (NullableScalarType b)
_spmDescription :: Maybe Text
_spmStoredProcedure :: forall (b :: BackendType).
StoredProcedureMetadata b -> FunctionName b
_spmConfig :: forall (b :: BackendType).
StoredProcedureMetadata b -> StoredProcedureConfig
_spmReturns :: forall (b :: BackendType).
StoredProcedureMetadata b -> LogicalModelName
_spmArguments :: forall (b :: BackendType).
StoredProcedureMetadata b
-> HashMap ArgumentName (NullableScalarType b)
_spmDescription :: forall (b :: BackendType). StoredProcedureMetadata b -> Maybe Text
..} -> do
              let metadataObject :: MetadataObject
                  metadataObject :: MetadataObject
metadataObject =
                    MetadataObjId -> Value -> MetadataObject
MetadataObject
                      ( SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
sourceName
                          (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                          (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). FunctionName b -> SourceMetadataObjId b
SMOStoredProcedure @b FunctionName b
_spmStoredProcedure
                      )
                      (StoredProcedureMetadata b -> Value
forall a. ToJSON a => a -> Value
toJSON StoredProcedureMetadata b
spm)

                  schemaObjId :: SchemaObjId
                  schemaObjId :: SchemaObjId
schemaObjId =
                    SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
sourceName
                      (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                      (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). FunctionName b -> SourceObjId b
SOIStoredProcedure @b FunctionName b
_spmStoredProcedure

                  dependency :: SchemaDependency
                  dependency :: SchemaDependency
dependency =
                    SchemaDependency
                      { sdObjId :: SchemaObjId
sdObjId =
                          SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
sourceName
                            (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                            (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). LogicalModelName -> SourceObjId b
SOILogicalModel @b LogicalModelName
_spmReturns,
                        sdReason :: DependencyReason
sdReason = DependencyReason
DRLogicalModel
                      }

              MetadataObject
-> ExceptT
     QErr (WriterT (Seq CollectItem) m) (StoredProcedureInfo b)
-> WriterT (Seq CollectItem) m (Maybe (StoredProcedureInfo b))
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM MetadataObject
metadataObject (ExceptT QErr (WriterT (Seq CollectItem) m) (StoredProcedureInfo b)
 -> WriterT (Seq CollectItem) m (Maybe (StoredProcedureInfo b)))
-> ExceptT
     QErr (WriterT (Seq CollectItem) m) (StoredProcedureInfo b)
-> WriterT (Seq CollectItem) m (Maybe (StoredProcedureInfo b))
forall a b. (a -> b) -> a -> b
$ do
                Bool
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CacheStaticConfig -> Bool
_cscAreStoredProceduresEnabled CacheStaticConfig
cacheStaticConfig)
                  (ExceptT QErr (WriterT (Seq CollectItem) m) ()
 -> ExceptT QErr (WriterT (Seq CollectItem) m) ())
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
InvalidConfiguration Text
"The Stored Procedure feature is disabled"

                LogicalModelInfo b
logicalModel <-
                  Maybe (LogicalModelInfo b)
-> ExceptT QErr (WriterT (Seq CollectItem) m) (LogicalModelInfo b)
-> ExceptT QErr (WriterT (Seq CollectItem) m) (LogicalModelInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing
                    (LogicalModelName
-> LogicalModelCache b -> Maybe (LogicalModelInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup LogicalModelName
_spmReturns LogicalModelCache b
logicalModelsCache)
                    (Code
-> Text
-> ExceptT QErr (WriterT (Seq CollectItem) m) (LogicalModelInfo b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
InvalidConfiguration (Text
"The logical model " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LogicalModelName -> Text
forall a. ToTxt a => a -> Text
toTxt LogicalModelName
_spmReturns Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" could not be found"))

                forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadIO m, MonadError QErr m) =>
Environment
-> SourceConnConfiguration b
-> LogicalModelInfo b
-> StoredProcedureMetadata b
-> m ()
validateStoredProcedure @b Environment
env (SourceMetadata b -> SourceConnConfiguration b
forall (b :: BackendType).
SourceMetadata b -> SourceConnConfiguration b
_smConfiguration SourceMetadata b
sourceMetadata) LogicalModelInfo b
logicalModel StoredProcedureMetadata b
spm

                MetadataObject
-> SchemaObjId
-> Seq SchemaDependency
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
MetadataObject -> SchemaObjId -> Seq SchemaDependency -> m ()
recordDependenciesM MetadataObject
metadataObject SchemaObjId
schemaObjId
                  (Seq SchemaDependency
 -> ExceptT QErr (WriterT (Seq CollectItem) m) ())
-> Seq SchemaDependency
-> ExceptT QErr (WriterT (Seq CollectItem) m) ()
forall a b. (a -> b) -> a -> b
$ SchemaDependency -> Seq SchemaDependency
forall a. a -> Seq a
Seq.singleton SchemaDependency
dependency

                Name
graphqlName <- forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadError QErr m) =>
FunctionName b -> StoredProcedureConfig -> m Name
getStoredProcedureGraphqlName @b FunctionName b
_spmStoredProcedure StoredProcedureConfig
_spmConfig

                StoredProcedureInfo b
-> ExceptT
     QErr (WriterT (Seq CollectItem) m) (StoredProcedureInfo b)
forall a. a -> ExceptT QErr (WriterT (Seq CollectItem) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                  StoredProcedureInfo
                    { _spiStoredProcedure :: FunctionName b
_spiStoredProcedure = FunctionName b
_spmStoredProcedure,
                      _spiGraphqlName :: Name
_spiGraphqlName = Name
graphqlName,
                      _spiConfig :: StoredProcedureConfig
_spiConfig = StoredProcedureConfig
_spmConfig,
                      _spiReturns :: LogicalModelInfo b
_spiReturns = LogicalModelInfo b
logicalModel,
                      _spiArguments :: HashMap ArgumentName (NullableScalarType b)
_spiArguments = HashMap ArgumentName (NullableScalarType b)
_spmArguments,
                      _spiDescription :: Maybe Text
_spiDescription = Maybe Text
_spmDescription
                    }

      let storedProcedureCache :: StoredProcedureCache b
          storedProcedureCache :: StoredProcedureCache b
storedProcedureCache = (StoredProcedureInfo b -> FunctionName b)
-> [StoredProcedureInfo b] -> StoredProcedureCache b
forall k a. Hashable k => (a -> k) -> [a] -> HashMap k a
mapFromL StoredProcedureInfo b -> FunctionName b
forall (b :: BackendType). StoredProcedureInfo b -> FunctionName b
_spiStoredProcedure ([Maybe (StoredProcedureInfo b)] -> [StoredProcedureInfo b]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe (StoredProcedureInfo b)]
storedProcedureCacheMaybes)

      arr (SourceInfo b) (SourceInfo b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< SourceName
-> BackendSourceKind b
-> HashMap (TableName b) (TableInfo b)
-> HashMap (FunctionName b) (FunctionInfo b)
-> NativeQueryCache b
-> StoredProcedureCache b
-> LogicalModelCache b
-> SourceConfig b
-> Maybe QueryTagsConfig
-> ResolvedSourceCustomization
-> DBObjectsIntrospection b
-> SourceInfo b
forall (b :: BackendType).
SourceName
-> BackendSourceKind b
-> TableCache b
-> FunctionCache b
-> NativeQueryCache b
-> StoredProcedureCache b
-> LogicalModelCache b
-> SourceConfig b
-> Maybe QueryTagsConfig
-> ResolvedSourceCustomization
-> DBObjectsIntrospection b
-> SourceInfo b
SourceInfo SourceName
sourceName BackendSourceKind b
backendSourceKind HashMap (TableName b) (TableInfo b)
tableCache HashMap (FunctionName b) (FunctionInfo b)
functionCache NativeQueryCache b
nativeQueryCache StoredProcedureCache b
storedProcedureCache LogicalModelCache b
logicalModelsCache SourceConfig b
sourceConfig Maybe QueryTagsConfig
queryTagsConfig ResolvedSourceCustomization
resolvedCustomization DBObjectsIntrospection b
dbObjectsIntrospection

    buildAndCollectInfo ::
      forall arr m.
      ( ArrowChoice arr,
        Inc.ArrowDistribute arr,
        Inc.ArrowCache m arr,
        ArrowWriter (Seq CollectItem) arr,
        MonadIO m,
        MonadError QErr m,
        MonadReader BuildReason m,
        MonadBaseControl IO m,
        ProvidesNetwork m,
        MonadResolveSource m,
        HasCacheStaticConfig m
      ) =>
      (CacheDynamicConfig, Inc.Dependency Metadata, Inc.Dependency InvalidationKeys, Maybe StoredIntrospection) `arr` BuildOutputs
    buildAndCollectInfo :: forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowDistribute arr, ArrowCache m arr,
 ArrowWriter (Seq CollectItem) arr, MonadIO m, MonadError QErr m,
 MonadReader BuildReason m, MonadBaseControl IO m,
 ProvidesNetwork m, MonadResolveSource m, HasCacheStaticConfig m) =>
arr
  (CacheDynamicConfig, Dependency Metadata,
   Dependency InvalidationKeys, Maybe StoredIntrospection)
  BuildOutputs
buildAndCollectInfo = proc (CacheDynamicConfig
dynamicConfig, Dependency Metadata
metadataDep, Dependency InvalidationKeys
invalidationKeys, Maybe StoredIntrospection
storedIntrospection) -> do
      InsOrdHashMap SourceName BackendSourceMetadata
sources <- arr
  (Dependency (InsOrdHashMap SourceName BackendSourceMetadata))
  (InsOrdHashMap SourceName BackendSourceMetadata)
forall a. Eq a => arr (Dependency a) a
forall (m :: * -> *) (arr :: * -> * -> *) a.
(ArrowCache m arr, Eq a) =>
arr (Dependency a) a
Inc.dependOn -< Selector Metadata (InsOrdHashMap SourceName BackendSourceMetadata)
-> Dependency Metadata
-> Dependency (InsOrdHashMap SourceName BackendSourceMetadata)
forall a b.
Select a =>
Selector a b -> Dependency a -> Dependency b
Inc.selectD FieldS Metadata (InsOrdHashMap SourceName BackendSourceMetadata)
Selector Metadata (InsOrdHashMap SourceName BackendSourceMetadata)
#_metaSources Dependency Metadata
metadataDep
      RemoteSchemas
remoteSchemas <- arr (Dependency RemoteSchemas) RemoteSchemas
forall a. Eq a => arr (Dependency a) a
forall (m :: * -> *) (arr :: * -> * -> *) a.
(ArrowCache m arr, Eq a) =>
arr (Dependency a) a
Inc.dependOn -< Selector Metadata RemoteSchemas
-> Dependency Metadata -> Dependency RemoteSchemas
forall a b.
Select a =>
Selector a b -> Dependency a -> Dependency b
Inc.selectD FieldS Metadata RemoteSchemas
Selector Metadata RemoteSchemas
#_metaRemoteSchemas Dependency Metadata
metadataDep
      CustomTypes
customTypes <- arr (Dependency CustomTypes) CustomTypes
forall a. Eq a => arr (Dependency a) a
forall (m :: * -> *) (arr :: * -> * -> *) a.
(ArrowCache m arr, Eq a) =>
arr (Dependency a) a
Inc.dependOn -< Selector Metadata CustomTypes
-> Dependency Metadata -> Dependency CustomTypes
forall a b.
Select a =>
Selector a b -> Dependency a -> Dependency b
Inc.selectD FieldS Metadata CustomTypes
Selector Metadata CustomTypes
#_metaCustomTypes Dependency Metadata
metadataDep
      Actions
actions <- arr (Dependency Actions) Actions
forall a. Eq a => arr (Dependency a) a
forall (m :: * -> *) (arr :: * -> * -> *) a.
(ArrowCache m arr, Eq a) =>
arr (Dependency a) a
Inc.dependOn -< Selector Metadata Actions
-> Dependency Metadata -> Dependency Actions
forall a b.
Select a =>
Selector a b -> Dependency a -> Dependency b
Inc.selectD FieldS Metadata Actions
Selector Metadata Actions
#_metaActions Dependency Metadata
metadataDep
      InheritedRoles
inheritedRoles <- arr (Dependency InheritedRoles) InheritedRoles
forall a. Eq a => arr (Dependency a) a
forall (m :: * -> *) (arr :: * -> * -> *) a.
(ArrowCache m arr, Eq a) =>
arr (Dependency a) a
Inc.dependOn -< Selector Metadata InheritedRoles
-> Dependency Metadata -> Dependency InheritedRoles
forall a b.
Select a =>
Selector a b -> Dependency a -> Dependency b
Inc.selectD FieldS Metadata InheritedRoles
Selector Metadata InheritedRoles
#_metaInheritedRoles Dependency Metadata
metadataDep
      BackendMap BackendConfigWrapper
backendConfigs <- arr
  (Dependency (BackendMap BackendConfigWrapper))
  (BackendMap BackendConfigWrapper)
forall a. Eq a => arr (Dependency a) a
forall (m :: * -> *) (arr :: * -> * -> *) a.
(ArrowCache m arr, Eq a) =>
arr (Dependency a) a
Inc.dependOn -< Selector Metadata (BackendMap BackendConfigWrapper)
-> Dependency Metadata
-> Dependency (BackendMap BackendConfigWrapper)
forall a b.
Select a =>
Selector a b -> Dependency a -> Dependency b
Inc.selectD FieldS Metadata (BackendMap BackendConfigWrapper)
Selector Metadata (BackendMap BackendConfigWrapper)
#_metaBackendConfigs Dependency Metadata
metadataDep
      let actionRoles :: [RoleName]
actionRoles = (ActionPermissionMetadata -> RoleName)
-> [ActionPermissionMetadata] -> [RoleName]
forall a b. (a -> b) -> [a] -> [b]
map ActionPermissionMetadata -> RoleName
_apmRole ([ActionPermissionMetadata] -> [RoleName])
-> (ActionMetadata -> [ActionPermissionMetadata])
-> ActionMetadata
-> [RoleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionMetadata -> [ActionPermissionMetadata]
_amPermissions (ActionMetadata -> [RoleName]) -> [ActionMetadata] -> [RoleName]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Actions -> [ActionMetadata]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems Actions
actions
          remoteSchemaRoles :: [RoleName]
remoteSchemaRoles = (RemoteSchemaPermissionMetadata -> RoleName)
-> [RemoteSchemaPermissionMetadata] -> [RoleName]
forall a b. (a -> b) -> [a] -> [b]
map RemoteSchemaPermissionMetadata -> RoleName
_rspmRole ([RemoteSchemaPermissionMetadata] -> [RoleName])
-> (RemoteSchemaMetadataG RemoteRelationshipDefinition
    -> [RemoteSchemaPermissionMetadata])
-> RemoteSchemaMetadataG RemoteRelationshipDefinition
-> [RoleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteSchemaMetadataG RemoteRelationshipDefinition
-> [RemoteSchemaPermissionMetadata]
forall r.
RemoteSchemaMetadataG r -> [RemoteSchemaPermissionMetadata]
_rsmPermissions (RemoteSchemaMetadataG RemoteRelationshipDefinition -> [RoleName])
-> [RemoteSchemaMetadataG RemoteRelationshipDefinition]
-> [RoleName]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RemoteSchemas
-> [RemoteSchemaMetadataG RemoteRelationshipDefinition]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems RemoteSchemas
remoteSchemas
          sourceRoles :: HashSet RoleName
sourceRoles =
            [RoleName] -> HashSet RoleName
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList
              ([RoleName] -> HashSet RoleName) -> [RoleName] -> HashSet RoleName
forall a b. (a -> b) -> a -> b
$ [[RoleName]] -> [RoleName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              ([[RoleName]] -> [RoleName]) -> [[RoleName]] -> [RoleName]
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap SourceName BackendSourceMetadata
-> [BackendSourceMetadata]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems InsOrdHashMap SourceName BackendSourceMetadata
sources
              [BackendSourceMetadata]
-> (BackendSourceMetadata -> [[RoleName]]) -> [[RoleName]]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(BackendSourceMetadata AnyBackend SourceMetadata
e) ->
                forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend AnyBackend SourceMetadata
e \(SourceMetadata SourceName
_ BackendSourceKind b
_ Tables b
tables Functions b
_functions NativeQueries b
_nativeQueries StoredProcedures b
_storedProcedures LogicalModels b
_logicalModels SourceConnConfiguration b
_ Maybe QueryTagsConfig
_ SourceCustomization
_ Maybe (HealthCheckConfig b)
_) -> do
                  TableMetadata b
table <- Tables b -> [TableMetadata b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems Tables b
tables
                  [RoleName] -> [[RoleName]]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                    ([RoleName] -> [[RoleName]]) -> [RoleName] -> [[RoleName]]
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap RoleName (InsPermDef b) -> [RoleName]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys (TableMetadata b -> InsOrdHashMap RoleName (InsPermDef b)
forall (b :: BackendType).
TableMetadata b -> Permissions (InsPermDef b)
_tmInsertPermissions TableMetadata b
table)
                    [RoleName] -> [RoleName] -> [RoleName]
forall a. Semigroup a => a -> a -> a
<> InsOrdHashMap RoleName (SelPermDef b) -> [RoleName]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys (TableMetadata b -> InsOrdHashMap RoleName (SelPermDef b)
forall (b :: BackendType).
TableMetadata b -> Permissions (SelPermDef b)
_tmSelectPermissions TableMetadata b
table)
                    [RoleName] -> [RoleName] -> [RoleName]
forall a. Semigroup a => a -> a -> a
<> InsOrdHashMap RoleName (UpdPermDef b) -> [RoleName]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys (TableMetadata b -> InsOrdHashMap RoleName (UpdPermDef b)
forall (b :: BackendType).
TableMetadata b -> Permissions (UpdPermDef b)
_tmUpdatePermissions TableMetadata b
table)
                    [RoleName] -> [RoleName] -> [RoleName]
forall a. Semigroup a => a -> a -> a
<> InsOrdHashMap RoleName (DelPermDef b) -> [RoleName]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys (TableMetadata b -> InsOrdHashMap RoleName (DelPermDef b)
forall (b :: BackendType).
TableMetadata b -> Permissions (DelPermDef b)
_tmDeletePermissions TableMetadata b
table)
          inheritedRoleNames :: [RoleName]
inheritedRoleNames = InheritedRoles -> [RoleName]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys InheritedRoles
inheritedRoles
          allRoleNames :: HashSet RoleName
allRoleNames = HashSet RoleName
sourceRoles HashSet RoleName -> HashSet RoleName -> HashSet RoleName
forall a. Semigroup a => a -> a -> a
<> [RoleName] -> HashSet RoleName
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([RoleName]
remoteSchemaRoles [RoleName] -> [RoleName] -> [RoleName]
forall a. Semigroup a => a -> a -> a
<> [RoleName]
actionRoles [RoleName] -> [RoleName] -> [RoleName]
forall a. Semigroup a => a -> a -> a
<> [RoleName]
inheritedRoleNames)

      -- roles which have some kind of permission (action/remote schema/table/function) set in the metadata
      let metadataRoles :: HashMap RoleName Role
metadataRoles = (Role -> RoleName) -> [Role] -> HashMap RoleName Role
forall k a. Hashable k => (a -> k) -> [a] -> HashMap k a
mapFromL Role -> RoleName
_rRoleName ([Role] -> HashMap RoleName Role)
-> [Role] -> HashMap RoleName Role
forall a b. (a -> b) -> a -> b
$ (RoleName -> ParentRoles -> Role
`Role` HashSet RoleName -> ParentRoles
ParentRoles HashSet RoleName
forall a. Monoid a => a
mempty) (RoleName -> Role) -> [RoleName] -> [Role]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashSet RoleName -> [RoleName]
forall a. HashSet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashSet RoleName
allRoleNames

      HashMap RoleName Role
resolvedInheritedRoles <- arr
  (Writer (Seq CollectItem) (HashMap RoleName Role))
  (HashMap RoleName Role)
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter -< HashSet RoleName
-> [Role] -> Writer (Seq CollectItem) (HashMap RoleName Role)
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
HashSet RoleName -> [Role] -> m (HashMap RoleName Role)
buildInheritedRoles HashSet RoleName
allRoleNames (InheritedRoles -> [Role]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems InheritedRoles
inheritedRoles)

      let allRoles :: HashMap RoleName Role
allRoles = HashMap RoleName Role
resolvedInheritedRoles HashMap RoleName Role
-> HashMap RoleName Role -> HashMap RoleName Role
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
`HashMap.union` HashMap RoleName Role
metadataRoles

      OrderedRoles
orderedRoles <- arr (m OrderedRoles) OrderedRoles
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< [Role] -> m OrderedRoles
forall (m :: * -> *). MonadError QErr m => [Role] -> m OrderedRoles
orderRoles ([Role] -> m OrderedRoles) -> [Role] -> m OrderedRoles
forall a b. (a -> b) -> a -> b
$ HashMap RoleName Role -> [Role]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap RoleName Role
allRoles

      -- remote schemas
      let remoteSchemaInvalidationKeys :: Dependency (HashMap RemoteSchemaName InvalidationKey)
remoteSchemaInvalidationKeys = Selector
  InvalidationKeys (HashMap RemoteSchemaName InvalidationKey)
-> Dependency InvalidationKeys
-> Dependency (HashMap RemoteSchemaName InvalidationKey)
forall a b.
Select a =>
Selector a b -> Dependency a -> Dependency b
Inc.selectD FieldS InvalidationKeys (HashMap RemoteSchemaName InvalidationKey)
Selector
  InvalidationKeys (HashMap RemoteSchemaName InvalidationKey)
#_ikRemoteSchemas Dependency InvalidationKeys
invalidationKeys
      HashMap
  RemoteSchemaName
  (PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition,
   MetadataObject)
remoteSchemaMap <- Logger Hasura
-> Environment
-> arr
     ((Dependency (HashMap RemoteSchemaName InvalidationKey),
       OrderedRoles, Maybe (HashMap RemoteSchemaName ByteString)),
      [RemoteSchemaMetadataG RemoteRelationshipDefinition])
     (HashMap
        RemoteSchemaName
        (PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition,
         MetadataObject))
forall (arr :: * -> * -> *) (m :: * -> *)
       remoteRelationshipDefinition.
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectItem) arr, ArrowCache m arr, MonadIO m,
 MonadBaseControl IO m, Eq remoteRelationshipDefinition,
 ToJSON remoteRelationshipDefinition, MonadError QErr m,
 ProvidesNetwork m) =>
Logger Hasura
-> Environment
-> arr
     ((Dependency (HashMap RemoteSchemaName InvalidationKey),
       OrderedRoles, Maybe (HashMap RemoteSchemaName ByteString)),
      [RemoteSchemaMetadataG remoteRelationshipDefinition])
     (HashMap
        RemoteSchemaName
        (PartiallyResolvedRemoteSchemaCtxG remoteRelationshipDefinition,
         MetadataObject))
buildRemoteSchemas Logger Hasura
logger Environment
env -< ((Dependency (HashMap RemoteSchemaName InvalidationKey)
remoteSchemaInvalidationKeys, OrderedRoles
orderedRoles, (EncJSON -> ByteString)
-> HashMap RemoteSchemaName EncJSON
-> HashMap RemoteSchemaName ByteString
forall a b.
(a -> b)
-> HashMap RemoteSchemaName a -> HashMap RemoteSchemaName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EncJSON -> ByteString
encJToLBS (HashMap RemoteSchemaName EncJSON
 -> HashMap RemoteSchemaName ByteString)
-> (StoredIntrospection -> HashMap RemoteSchemaName EncJSON)
-> StoredIntrospection
-> HashMap RemoteSchemaName ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoredIntrospection -> HashMap RemoteSchemaName EncJSON
siRemotes (StoredIntrospection -> HashMap RemoteSchemaName ByteString)
-> Maybe StoredIntrospection
-> Maybe (HashMap RemoteSchemaName ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StoredIntrospection
storedIntrospection), RemoteSchemas
-> [RemoteSchemaMetadataG RemoteRelationshipDefinition]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems RemoteSchemas
remoteSchemas)
      let remoteSchemaCtxMap :: PartiallyResolvedRemoteSchemaMap
remoteSchemaCtxMap = ((PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition,
  MetadataObject)
 -> PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition)
-> HashMap
     RemoteSchemaName
     (PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition,
      MetadataObject)
-> PartiallyResolvedRemoteSchemaMap
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map (PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition,
 MetadataObject)
-> PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition
forall a b. (a, b) -> a
fst HashMap
  RemoteSchemaName
  (PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition,
   MetadataObject)
remoteSchemaMap
          !defaultNC :: NamingCase
defaultNC = CacheDynamicConfig -> NamingCase
_cdcDefaultNamingConvention CacheDynamicConfig
dynamicConfig
          !isNamingConventionEnabled :: Bool
isNamingConventionEnabled = ExperimentalFeature
EFNamingConventions ExperimentalFeature -> HashSet ExperimentalFeature -> Bool
forall a. Eq a => a -> HashSet a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (CacheDynamicConfig -> HashSet ExperimentalFeature
_cdcExperimentalFeatures CacheDynamicConfig
dynamicConfig)

      let backendInvalidationKeys :: Dependency (BackendMap BackendInvalidationKeysWrapper)
backendInvalidationKeys = Selector
  InvalidationKeys (BackendMap BackendInvalidationKeysWrapper)
-> Dependency InvalidationKeys
-> Dependency (BackendMap BackendInvalidationKeysWrapper)
forall a b.
Select a =>
Selector a b -> Dependency a -> Dependency b
Inc.selectD FieldS InvalidationKeys (BackendMap BackendInvalidationKeysWrapper)
Selector
  InvalidationKeys (BackendMap BackendInvalidationKeysWrapper)
#_ikBackends Dependency InvalidationKeys
invalidationKeys
      BackendCache
backendCache <- arr
  (Dependency (BackendMap BackendInvalidationKeysWrapper),
   [AnyBackend BackendConfigWrapper])
  BackendCache
forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowCache m arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectItem) arr, MonadIO m,
 MonadBaseControl IO m, ProvidesNetwork m,
 HasCacheStaticConfig m) =>
arr
  (Dependency (BackendMap BackendInvalidationKeysWrapper),
   [AnyBackend BackendConfigWrapper])
  BackendCache
resolveBackendCache -< (Dependency (BackendMap BackendInvalidationKeysWrapper)
backendInvalidationKeys, BackendMap BackendConfigWrapper
-> [AnyBackend BackendConfigWrapper]
forall (i :: BackendType -> *). BackendMap i -> [AnyBackend i]
BackendMap.elems BackendMap BackendConfigWrapper
backendConfigs)

      let backendInfoAndSourceMetadata :: InsOrdHashMap SourceName (AnyBackend BackendInfoAndSourceMetadata)
backendInfoAndSourceMetadata = BackendCache
-> InsOrdHashMap SourceName BackendSourceMetadata
-> InsOrdHashMap
     SourceName (AnyBackend BackendInfoAndSourceMetadata)
joinBackendInfosToSources BackendCache
backendCache InsOrdHashMap SourceName BackendSourceMetadata
sources

      -- sources are build in two steps
      -- first we resolve them, and build the table cache
      HashMap SourceName (Maybe (AnyBackend PartiallyResolvedSource))
partiallyResolvedSourcesMaybes <-
        (|
          arr
  (a, (SourceName, (AnyBackend BackendInfoAndSourceMetadata, ())))
  (Maybe (AnyBackend PartiallyResolvedSource))
-> arr
     (a,
      (HashMap SourceName (AnyBackend BackendInfoAndSourceMetadata), ()))
     (HashMap SourceName (Maybe (AnyBackend PartiallyResolvedSource)))
forall {a}.
arr
  (a, (SourceName, (AnyBackend BackendInfoAndSourceMetadata, ())))
  (Maybe (AnyBackend PartiallyResolvedSource))
-> arr
     (a,
      (HashMap SourceName (AnyBackend BackendInfoAndSourceMetadata), ()))
     (HashMap SourceName (Maybe (AnyBackend PartiallyResolvedSource)))
forall k e a s b.
Hashable k =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed
            ( \SourceName
_ AnyBackend BackendInfoAndSourceMetadata
exists ->
                forall (c1 :: BackendType -> Constraint)
       (c2 :: BackendType -> Constraint) (i :: BackendType -> *) r
       (arr :: * -> * -> *) x.
(ArrowChoice arr, AllBackendsSatisfy c1, AllBackendsSatisfy c2) =>
(forall (b :: BackendType). (c1 b, c2 b) => arr (i b, x) r)
-> arr (AnyBackend i, x) r
AB.dispatchAnyBackendArrow @BackendMetadata @BackendEventTrigger
                  ( proc (BackendInfoAndSourceMetadata b
backendInfoAndSourceMetadata :: BackendInfoAndSourceMetadata b, (CacheDynamicConfig
dynamicConfig, Dependency InvalidationKeys
invalidationKeys, Maybe StoredIntrospection
storedIntrospection, NamingCase
defaultNC, Bool
isNamingConventionEnabled)) -> do
                      let sourceMetadata :: SourceMetadata b
sourceMetadata = BackendInfoAndSourceMetadata b -> SourceMetadata b
forall (b :: BackendType).
BackendInfoAndSourceMetadata b -> SourceMetadata b
_bcasmSourceMetadata BackendInfoAndSourceMetadata b
backendInfoAndSourceMetadata
                          sourceName :: SourceName
sourceName = SourceMetadata b -> SourceName
forall (b :: BackendType). SourceMetadata b -> SourceName
_smName SourceMetadata b
sourceMetadata
                          sourceInvalidationsKeys :: Dependency (HashMap SourceName InvalidationKey)
sourceInvalidationsKeys = Selector InvalidationKeys (HashMap SourceName InvalidationKey)
-> Dependency InvalidationKeys
-> Dependency (HashMap SourceName InvalidationKey)
forall a b.
Select a =>
Selector a b -> Dependency a -> Dependency b
Inc.selectD FieldS InvalidationKeys (HashMap SourceName InvalidationKey)
Selector InvalidationKeys (HashMap SourceName InvalidationKey)
#_ikSources Dependency InvalidationKeys
invalidationKeys
                          sourceIntrospection :: Maybe EncJSON
sourceIntrospection = SourceName -> HashMap SourceName EncJSON -> Maybe EncJSON
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup SourceName
sourceName (HashMap SourceName EncJSON -> Maybe EncJSON)
-> Maybe (HashMap SourceName EncJSON) -> Maybe EncJSON
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StoredIntrospection -> HashMap SourceName EncJSON
siBackendIntrospection (StoredIntrospection -> HashMap SourceName EncJSON)
-> Maybe StoredIntrospection -> Maybe (HashMap SourceName EncJSON)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StoredIntrospection
storedIntrospection
                      Maybe (SourceConfig b, DBObjectsIntrospection b)
maybeResolvedSource <- arr
  (Dependency (HashMap SourceName InvalidationKey), Maybe ByteString,
   BackendInfoAndSourceMetadata b)
  (Maybe (SourceConfig b, DBObjectsIntrospection b))
forall (b :: BackendType) (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowCache m arr,
 ArrowWriter (Seq CollectItem) arr, MonadIO m,
 MonadBaseControl IO m, MonadResolveSource m, ProvidesNetwork m,
 BackendMetadata b) =>
arr
  (Dependency (HashMap SourceName InvalidationKey), Maybe ByteString,
   BackendInfoAndSourceMetadata b)
  (Maybe (SourceConfig b, DBObjectsIntrospection b))
tryResolveSource -< (Dependency (HashMap SourceName InvalidationKey)
sourceInvalidationsKeys, EncJSON -> ByteString
encJToLBS (EncJSON -> ByteString) -> Maybe EncJSON -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe EncJSON
sourceIntrospection, BackendInfoAndSourceMetadata b
backendInfoAndSourceMetadata)
                      case Maybe (SourceConfig b, DBObjectsIntrospection b)
maybeResolvedSource of
                        Maybe (SourceConfig b, DBObjectsIntrospection b)
Nothing -> arr
  (Maybe (AnyBackend PartiallyResolvedSource))
  (Maybe (AnyBackend PartiallyResolvedSource))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Maybe (AnyBackend PartiallyResolvedSource)
forall a. Maybe a
Nothing
                        Just (SourceConfig b
sourceConfig, DBObjectsIntrospection b
source) -> do
                          let metadataInvalidationKey :: Dependency InvalidationKey
metadataInvalidationKey = Selector InvalidationKeys InvalidationKey
-> Dependency InvalidationKeys -> Dependency InvalidationKey
forall a b.
Select a =>
Selector a b -> Dependency a -> Dependency b
Inc.selectD FieldS InvalidationKeys InvalidationKey
Selector InvalidationKeys InvalidationKey
#_ikMetadata Dependency InvalidationKeys
invalidationKeys
                              ([TableBuildInput b]
tableInputs, [NonColumnTableInputs b]
_, [TablePermissionInputs b]
_) = [(TableBuildInput b, NonColumnTableInputs b,
  TablePermissionInputs b)]
-> ([TableBuildInput b], [NonColumnTableInputs b],
    [TablePermissionInputs b])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(TableBuildInput b, NonColumnTableInputs b,
   TablePermissionInputs b)]
 -> ([TableBuildInput b], [NonColumnTableInputs b],
     [TablePermissionInputs b]))
-> [(TableBuildInput b, NonColumnTableInputs b,
     TablePermissionInputs b)]
-> ([TableBuildInput b], [NonColumnTableInputs b],
    [TablePermissionInputs b])
forall a b. (a -> b) -> a -> b
$ (TableMetadata b
 -> (TableBuildInput b, NonColumnTableInputs b,
     TablePermissionInputs b))
-> [TableMetadata b]
-> [(TableBuildInput b, NonColumnTableInputs b,
     TablePermissionInputs b)]
forall a b. (a -> b) -> [a] -> [b]
map TableMetadata b
-> (TableBuildInput b, NonColumnTableInputs b,
    TablePermissionInputs b)
forall (b :: BackendType).
TableMetadata b
-> (TableBuildInput b, NonColumnTableInputs b,
    TablePermissionInputs b)
mkTableInputs ([TableMetadata b]
 -> [(TableBuildInput b, NonColumnTableInputs b,
      TablePermissionInputs b)])
-> [TableMetadata b]
-> [(TableBuildInput b, NonColumnTableInputs b,
     TablePermissionInputs b)]
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap (TableName b) (TableMetadata b) -> [TableMetadata b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems (InsOrdHashMap (TableName b) (TableMetadata b)
 -> [TableMetadata b])
-> InsOrdHashMap (TableName b) (TableMetadata b)
-> [TableMetadata b]
forall a b. (a -> b) -> a -> b
$ SourceMetadata b -> InsOrdHashMap (TableName b) (TableMetadata b)
forall (b :: BackendType). SourceMetadata b -> Tables b
_smTables SourceMetadata b
sourceMetadata
                              scNamingConvention :: Maybe NamingCase
scNamingConvention = SourceCustomization -> Maybe NamingCase
_scNamingConvention (SourceCustomization -> Maybe NamingCase)
-> SourceCustomization -> Maybe NamingCase
forall a b. (a -> b) -> a -> b
$ SourceMetadata b -> SourceCustomization
forall (b :: BackendType). SourceMetadata b -> SourceCustomization
_smCustomization SourceMetadata b
sourceMetadata
                              !namingConv :: NamingCase
namingConv = if Bool
isNamingConventionEnabled then NamingCase -> Maybe NamingCase -> NamingCase
forall a. a -> Maybe a -> a
fromMaybe NamingCase
defaultNC Maybe NamingCase
scNamingConvention else NamingCase
HasuraCase
                          HashMap
  (TableName b)
  (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
tablesCoreInfo <-
                            arr
  (SourceName, SourceConfig b, DBTablesMetadata b,
   [TableBuildInput b], Dependency InvalidationKey, NamingCase,
   LogicalModels b)
  (HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)))
forall (arr :: * -> * -> *) (m :: * -> *) (b :: BackendType).
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectItem) arr, ArrowCache m arr, MonadIO m,
 MonadBaseControl IO m, BackendMetadata b) =>
arr
  (SourceName, SourceConfig b, DBTablesMetadata b,
   [TableBuildInput b], Dependency InvalidationKey, NamingCase,
   LogicalModels b)
  (HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)))
buildTableCache
                              -<
                                ( SourceName
sourceName,
                                  SourceConfig b
sourceConfig,
                                  DBObjectsIntrospection b -> DBTablesMetadata b
forall (b :: BackendType).
DBObjectsIntrospection b -> DBTablesMetadata b
_rsTables DBObjectsIntrospection b
source,
                                  [TableBuildInput b]
tableInputs,
                                  Dependency InvalidationKey
metadataInvalidationKey,
                                  NamingCase
namingConv,
                                  SourceMetadata b -> LogicalModels b
forall (b :: BackendType). SourceMetadata b -> LogicalModels b
_smLogicalModels SourceMetadata b
sourceMetadata
                                )

                          let tablesMetadata :: [TableMetadata b]
tablesMetadata = InsOrdHashMap (TableName b) (TableMetadata b) -> [TableMetadata b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems (InsOrdHashMap (TableName b) (TableMetadata b)
 -> [TableMetadata b])
-> InsOrdHashMap (TableName b) (TableMetadata b)
-> [TableMetadata b]
forall a b. (a -> b) -> a -> b
$ SourceMetadata b -> InsOrdHashMap (TableName b) (TableMetadata b)
forall (b :: BackendType). SourceMetadata b -> Tables b
_smTables SourceMetadata b
sourceMetadata
                              eventTriggers :: [(TableName b, [EventTriggerConf b])]
eventTriggers = (TableMetadata b -> (TableName b, [EventTriggerConf b]))
-> [TableMetadata b] -> [(TableName b, [EventTriggerConf b])]
forall a b. (a -> b) -> [a] -> [b]
map (TableMetadata b -> TableName b
forall (b :: BackendType). TableMetadata b -> TableName b
_tmTable (TableMetadata b -> TableName b)
-> (TableMetadata b -> [EventTriggerConf b])
-> TableMetadata b
-> (TableName b, [EventTriggerConf b])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& InsOrdHashMap TriggerName (EventTriggerConf b)
-> [EventTriggerConf b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems (InsOrdHashMap TriggerName (EventTriggerConf b)
 -> [EventTriggerConf b])
-> (TableMetadata b
    -> InsOrdHashMap TriggerName (EventTriggerConf b))
-> TableMetadata b
-> [EventTriggerConf b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableMetadata b -> InsOrdHashMap TriggerName (EventTriggerConf b)
forall (b :: BackendType). TableMetadata b -> EventTriggers b
_tmEventTriggers) [TableMetadata b]
tablesMetadata

                          (RecreateEventTriggers
recreateEventTriggers, SourceCatalogMigrationState
sourceCatalogMigrationState) <- arr
  (Proxy b, [(TableName b, [EventTriggerConf b])], SourceConfig b,
   SourceName)
  (RecreateEventTriggers, SourceCatalogMigrationState)
forall (b :: BackendType) (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowCache m arr,
 ArrowWriter (Seq CollectItem) arr, MonadIO m, BackendMetadata b,
 MonadBaseControl IO m, HasCacheStaticConfig m) =>
arr
  (Proxy b, [(TableName b, [EventTriggerConf b])], SourceConfig b,
   SourceName)
  (RecreateEventTriggers, SourceCatalogMigrationState)
initCatalogIfNeeded -< (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b, [(TableName b, [EventTriggerConf b])]
eventTriggers, SourceConfig b
sourceConfig, SourceName
sourceName)

                          arr (m ()) ()
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< Logger Hasura
-> forall a (m :: * -> *).
   (ToEngineLog a Hasura, MonadIO m) =>
   a -> m ()
forall impl.
Logger impl
-> forall a (m :: * -> *).
   (ToEngineLog a impl, MonadIO m) =>
   a -> m ()
unLogger Logger Hasura
logger (SourceName
sourceName, SourceCatalogMigrationState
sourceCatalogMigrationState)

                          let alignTableMap :: HashMap (TableName b) a -> HashMap (TableName b) c -> HashMap (TableName b) (a, c)
                              alignTableMap :: forall a c.
HashMap (TableName b) a
-> HashMap (TableName b) c -> HashMap (TableName b) (a, c)
alignTableMap = (a -> c -> (a, c))
-> HashMap (TableName b) a
-> HashMap (TableName b) c
-> HashMap (TableName b) (a, c)
forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HashMap.intersectionWith (,)

                          HashMap (TableName b) (EventTriggerInfoMap b)
eventTriggerInfoMaps <-
                            (|
                              arr
  (a,
   (TableName b,
    ((TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b),
      (TableName b, [EventTriggerConf b])),
     ())))
  (EventTriggerInfoMap b)
-> arr
     (a,
      (HashMap
         (TableName b)
         (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b),
          (TableName b, [EventTriggerConf b])),
       ()))
     (HashMap (TableName b) (EventTriggerInfoMap b))
forall {a}.
arr
  (a,
   (TableName b,
    ((TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b),
      (TableName b, [EventTriggerConf b])),
     ())))
  (EventTriggerInfoMap b)
-> arr
     (a,
      (HashMap
         (TableName b)
         (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b),
          (TableName b, [EventTriggerConf b])),
       ()))
     (HashMap (TableName b) (EventTriggerInfoMap b))
forall k e a s b.
Hashable k =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed
                                ( \TableName b
_ (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
tableCoreInfo, (TableName b
_, [EventTriggerConf b]
eventTriggerConfs)) ->
                                    arr
  (CacheDynamicConfig, SourceName, SourceConfig b,
   TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b),
   [EventTriggerConf b], Dependency InvalidationKey,
   RecreateEventTriggers)
  (EventTriggerInfoMap b)
forall (arr :: * -> * -> *) (m :: * -> *) (b :: BackendType).
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectItem) arr, ArrowCache m arr, MonadIO m,
 MonadBaseControl IO m, MonadReader BuildReason m,
 BackendMetadata b, BackendEventTrigger b,
 HasCacheStaticConfig m) =>
arr
  (CacheDynamicConfig, SourceName, SourceConfig b,
   TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b),
   [EventTriggerConf b], Dependency InvalidationKey,
   RecreateEventTriggers)
  (EventTriggerInfoMap b)
buildTableEventTriggers -< (CacheDynamicConfig
dynamicConfig, SourceName
sourceName, SourceConfig b
sourceConfig, TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
tableCoreInfo, [EventTriggerConf b]
eventTriggerConfs, Dependency InvalidationKey
metadataInvalidationKey, RecreateEventTriggers
recreateEventTriggers)
                                )
                              |)
                              (HashMap
  (TableName b)
  (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
tablesCoreInfo HashMap
  (TableName b)
  (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
-> HashMap (TableName b) (TableName b, [EventTriggerConf b])
-> HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b),
      (TableName b, [EventTriggerConf b]))
forall a c.
HashMap (TableName b) a
-> HashMap (TableName b) c -> HashMap (TableName b) (a, c)
`alignTableMap` ((TableName b, [EventTriggerConf b]) -> TableName b)
-> [(TableName b, [EventTriggerConf b])]
-> HashMap (TableName b) (TableName b, [EventTriggerConf b])
forall k a. Hashable k => (a -> k) -> [a] -> HashMap k a
mapFromL (TableName b, [EventTriggerConf b]) -> TableName b
forall a b. (a, b) -> a
fst [(TableName b, [EventTriggerConf b])]
eventTriggers)

                          arr
  (Maybe (AnyBackend PartiallyResolvedSource))
  (Maybe (AnyBackend PartiallyResolvedSource))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA
                            -<
                              AnyBackend PartiallyResolvedSource
-> Maybe (AnyBackend PartiallyResolvedSource)
forall a. a -> Maybe a
Just
                                (AnyBackend PartiallyResolvedSource
 -> Maybe (AnyBackend PartiallyResolvedSource))
-> AnyBackend PartiallyResolvedSource
-> Maybe (AnyBackend PartiallyResolvedSource)
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend @b
                                (PartiallyResolvedSource b -> AnyBackend PartiallyResolvedSource)
-> PartiallyResolvedSource b -> AnyBackend PartiallyResolvedSource
forall a b. (a -> b) -> a -> b
$ SourceMetadata b
-> SourceConfig b
-> DBObjectsIntrospection b
-> HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
-> HashMap (TableName b) (EventTriggerInfoMap b)
-> PartiallyResolvedSource b
forall (b :: BackendType).
SourceMetadata b
-> SourceConfig b
-> DBObjectsIntrospection b
-> HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
-> HashMap (TableName b) (EventTriggerInfoMap b)
-> PartiallyResolvedSource b
PartiallyResolvedSource SourceMetadata b
sourceMetadata SourceConfig b
sourceConfig DBObjectsIntrospection b
source HashMap
  (TableName b)
  (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
tablesCoreInfo HashMap (TableName b) (EventTriggerInfoMap b)
eventTriggerInfoMaps
                  )
                  -<
                    (AnyBackend BackendInfoAndSourceMetadata
exists, (CacheDynamicConfig
dynamicConfig, Dependency InvalidationKeys
invalidationKeys, Maybe StoredIntrospection
storedIntrospection, NamingCase
defaultNC, Bool
isNamingConventionEnabled))
            )
          |)
          ([(SourceName, AnyBackend BackendInfoAndSourceMetadata)]
-> HashMap SourceName (AnyBackend BackendInfoAndSourceMetadata)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(SourceName, AnyBackend BackendInfoAndSourceMetadata)]
 -> HashMap SourceName (AnyBackend BackendInfoAndSourceMetadata))
-> [(SourceName, AnyBackend BackendInfoAndSourceMetadata)]
-> HashMap SourceName (AnyBackend BackendInfoAndSourceMetadata)
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap SourceName (AnyBackend BackendInfoAndSourceMetadata)
-> [(SourceName, AnyBackend BackendInfoAndSourceMetadata)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList InsOrdHashMap SourceName (AnyBackend BackendInfoAndSourceMetadata)
backendInfoAndSourceMetadata)
      let partiallyResolvedSources :: HashMap SourceName (AnyBackend PartiallyResolvedSource)
partiallyResolvedSources = HashMap SourceName (Maybe (AnyBackend PartiallyResolvedSource))
-> HashMap SourceName (AnyBackend PartiallyResolvedSource)
forall a. HashMap SourceName (Maybe a) -> HashMap SourceName a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes HashMap SourceName (Maybe (AnyBackend PartiallyResolvedSource))
partiallyResolvedSourcesMaybes

      -- then we can build the entire source output
      -- we need to have the table cache of all sources to build cross-sources relationships
      HashMap
  SourceName (AnyBackend SourceInfo, BackendMap ScalarParsingMap)
sourcesOutput <-
        (|
          arr
  (a, (SourceName, (AnyBackend PartiallyResolvedSource, ())))
  (AnyBackend SourceInfo, BackendMap ScalarParsingMap)
-> arr
     (a, (HashMap SourceName (AnyBackend PartiallyResolvedSource), ()))
     (HashMap
        SourceName (AnyBackend SourceInfo, BackendMap ScalarParsingMap))
forall {a}.
arr
  (a, (SourceName, (AnyBackend PartiallyResolvedSource, ())))
  (AnyBackend SourceInfo, BackendMap ScalarParsingMap)
-> arr
     (a, (HashMap SourceName (AnyBackend PartiallyResolvedSource), ()))
     (HashMap
        SourceName (AnyBackend SourceInfo, BackendMap ScalarParsingMap))
forall k e a s b.
Hashable k =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed
            ( \SourceName
_ AnyBackend PartiallyResolvedSource
exists ->
                -- Note that it's a bit of a coincidence that
                -- 'AB.dispatchAnyBackendArrow' accepts exactly two constraints,
                -- and that we happen to want to apply to exactly two
                -- constraints.
                -- Ideally the function should be able to take an arbitrary
                -- number of constraints.
                forall (c1 :: BackendType -> Constraint)
       (c2 :: BackendType -> Constraint) (i :: BackendType -> *) r
       (arr :: * -> * -> *) x.
(ArrowChoice arr, AllBackendsSatisfy c1, AllBackendsSatisfy c2) =>
(forall (b :: BackendType). (c1 b, c2 b) => arr (i b, x) r)
-> arr (AnyBackend i, x) r
AB.dispatchAnyBackendArrow @BackendMetadata @GetAggregationPredicatesDeps
                  ( proc
                      ( PartiallyResolvedSource b
partiallyResolvedSource :: PartiallyResolvedSource b,
                        (CacheDynamicConfig
dynamicConfig, HashMap SourceName (AnyBackend PartiallyResolvedSource)
allResolvedSources, PartiallyResolvedRemoteSchemaMap
remoteSchemaCtxMap, OrderedRoles
orderedRoles)
                        )
                    -> do
                      let PartiallyResolvedSource SourceMetadata b
sourceMetadata SourceConfig b
sourceConfig DBObjectsIntrospection b
introspection HashMap
  (TableName b)
  (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
tablesInfo HashMap (TableName b) (EventTriggerInfoMap b)
eventTriggers = PartiallyResolvedSource b
partiallyResolvedSource
                      SourceInfo b
so <-
                        arr
  (CacheDynamicConfig,
   HashMap SourceName (AnyBackend PartiallyResolvedSource),
   SourceMetadata b, SourceConfig b,
   HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)),
   HashMap (TableName b) (EventTriggerInfoMap b),
   DBObjectsIntrospection b, PartiallyResolvedRemoteSchemaMap,
   OrderedRoles)
  (SourceInfo b)
forall (b :: BackendType) (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowKleisli m arr,
 ArrowWriter (Seq CollectItem) arr, MonadError QErr m,
 HasCacheStaticConfig m, MonadIO m, BackendMetadata b,
 GetAggregationPredicatesDeps b) =>
arr
  (CacheDynamicConfig,
   HashMap SourceName (AnyBackend PartiallyResolvedSource),
   SourceMetadata b, SourceConfig b,
   HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)),
   HashMap (TableName b) (EventTriggerInfoMap b),
   DBObjectsIntrospection b, PartiallyResolvedRemoteSchemaMap,
   OrderedRoles)
  (SourceInfo b)
buildSource
                          -<
                            ( CacheDynamicConfig
dynamicConfig,
                              HashMap SourceName (AnyBackend PartiallyResolvedSource)
allResolvedSources,
                              SourceMetadata b
sourceMetadata,
                              SourceConfig b
sourceConfig,
                              HashMap
  (TableName b)
  (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
tablesInfo,
                              HashMap (TableName b) (EventTriggerInfoMap b)
eventTriggers,
                              DBObjectsIntrospection b
introspection,
                              PartiallyResolvedRemoteSchemaMap
remoteSchemaCtxMap,
                              OrderedRoles
orderedRoles
                            )
                      let scalarParsingContext :: ScalarTypeParsingContext b
scalarParsingContext = SourceConfig b -> ScalarTypeParsingContext b
forall a t. Has a t => t -> a
getter SourceConfig b
sourceConfig
                          ScalarMap HashMap Name (ScalarType b)
scalarMap = DBObjectsIntrospection b -> ScalarMap b
forall (b :: BackendType). DBObjectsIntrospection b -> ScalarMap b
_rsScalars DBObjectsIntrospection b
introspection
                          scalarParsingMap :: ScalarParsingMap b
scalarParsingMap = HashMap Name (ScalarWrapper b) -> ScalarParsingMap b
forall (b :: BackendType).
HashMap Name (ScalarWrapper b) -> ScalarParsingMap b
ScalarParsingMap (HashMap Name (ScalarWrapper b) -> ScalarParsingMap b)
-> HashMap Name (ScalarWrapper b) -> ScalarParsingMap b
forall a b. (a -> b) -> a -> b
$ ((ScalarType b -> ScalarTypeParsingContext b -> ScalarWrapper b)
-> ScalarTypeParsingContext b -> ScalarType b -> ScalarWrapper b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (b :: BackendType).
ScalarType b -> ScalarTypeParsingContext b -> ScalarWrapper b
ScalarWrapper @b) ScalarTypeParsingContext b
scalarParsingContext) (ScalarType b -> ScalarWrapper b)
-> HashMap Name (ScalarType b) -> HashMap Name (ScalarWrapper b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Name (ScalarType b)
scalarMap
                      arr
  (AnyBackend SourceInfo, BackendMap ScalarParsingMap)
  (AnyBackend SourceInfo, BackendMap ScalarParsingMap)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (SourceInfo b -> AnyBackend SourceInfo
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend SourceInfo b
so, ScalarParsingMap b -> BackendMap ScalarParsingMap
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> BackendMap i
BackendMap.singleton ScalarParsingMap b
scalarParsingMap)
                  )
                  -<
                    ( AnyBackend PartiallyResolvedSource
exists,
                      (CacheDynamicConfig
dynamicConfig, HashMap SourceName (AnyBackend PartiallyResolvedSource)
partiallyResolvedSources, PartiallyResolvedRemoteSchemaMap
remoteSchemaCtxMap, OrderedRoles
orderedRoles)
                    )
            )
          |)
          HashMap SourceName (AnyBackend PartiallyResolvedSource)
partiallyResolvedSources

      HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
remoteSchemaCache <-
        arr
  (Writer
     (Seq CollectItem)
     (HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)))
  (HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject))
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter
          -< HashMap
  RemoteSchemaName
  (PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition,
   MetadataObject)
-> ((PartiallyResolvedRemoteSchemaCtxG
       RemoteRelationshipDefinition,
     MetadataObject)
    -> WriterT
         (Seq CollectItem) Identity (RemoteSchemaCtx, MetadataObject))
-> Writer
     (Seq CollectItem)
     (HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for HashMap
  RemoteSchemaName
  (PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition,
   MetadataObject)
remoteSchemaMap \(PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition
partiallyResolvedRemoteSchemaCtx, MetadataObject
metadataObj) -> do
            let remoteSchemaIntrospection :: RemoteSchemaIntrospection
remoteSchemaIntrospection = IntrospectionResult -> RemoteSchemaIntrospection
irDoc (IntrospectionResult -> RemoteSchemaIntrospection)
-> IntrospectionResult -> RemoteSchemaIntrospection
forall a b. (a -> b) -> a -> b
$ PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition
-> IntrospectionResult
forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> IntrospectionResult
_rscIntroOriginal PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition
partiallyResolvedRemoteSchemaCtx
            RemoteSchemaCtxG (Maybe (RemoteFieldInfo Name))
resolvedSchemaCtx <- PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition
-> (PartiallyResolvedRemoteRelationship
      RemoteRelationshipDefinition
    -> WriterT
         (Seq CollectItem) Identity (Maybe (RemoteFieldInfo Name)))
-> WriterT
     (Seq CollectItem)
     Identity
     (RemoteSchemaCtxG (Maybe (RemoteFieldInfo Name)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition
partiallyResolvedRemoteSchemaCtx \PartiallyResolvedRemoteRelationship {Name
RemoteRelationshipG RemoteRelationshipDefinition
_prrrTypeName :: Name
_prrrDefinition :: RemoteRelationshipG RemoteRelationshipDefinition
_prrrTypeName :: forall remoteRelationshipDefinition.
PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> Name
_prrrDefinition :: forall remoteRelationshipDefinition.
PartiallyResolvedRemoteRelationship remoteRelationshipDefinition
-> RemoteRelationshipG remoteRelationshipDefinition
..} ->
              HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> PartiallyResolvedRemoteSchemaMap
-> RemoteSchemaName
-> RemoteSchemaIntrospection
-> Name
-> RemoteRelationshipG RemoteRelationshipDefinition
-> WriterT
     (Seq CollectItem) Identity (Maybe (RemoteFieldInfo Name))
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> PartiallyResolvedRemoteSchemaMap
-> RemoteSchemaName
-> RemoteSchemaIntrospection
-> Name
-> RemoteRelationshipG RemoteRelationshipDefinition
-> m (Maybe (RemoteFieldInfo Name))
buildRemoteSchemaRemoteRelationship HashMap SourceName (AnyBackend PartiallyResolvedSource)
partiallyResolvedSources PartiallyResolvedRemoteSchemaMap
remoteSchemaCtxMap (PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition
-> RemoteSchemaName
forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> RemoteSchemaName
_rscName PartiallyResolvedRemoteSchemaCtxG RemoteRelationshipDefinition
partiallyResolvedRemoteSchemaCtx) RemoteSchemaIntrospection
remoteSchemaIntrospection Name
_prrrTypeName RemoteRelationshipG RemoteRelationshipDefinition
_prrrDefinition
            (RemoteSchemaCtx, MetadataObject)
-> WriterT
     (Seq CollectItem) Identity (RemoteSchemaCtx, MetadataObject)
forall a. a -> WriterT (Seq CollectItem) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((RemoteSchemaCtx, MetadataObject)
 -> WriterT
      (Seq CollectItem) Identity (RemoteSchemaCtx, MetadataObject))
-> (RemoteSchemaCtx, MetadataObject)
-> WriterT
     (Seq CollectItem) Identity (RemoteSchemaCtx, MetadataObject)
forall a b. (a -> b) -> a -> b
$ (RemoteSchemaCtxG (Maybe (RemoteFieldInfo Name)) -> RemoteSchemaCtx
forall a. RemoteSchemaCtxG (Maybe a) -> RemoteSchemaCtxG a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes RemoteSchemaCtxG (Maybe (RemoteFieldInfo Name))
resolvedSchemaCtx, MetadataObject
metadataObj)

      -- actions
      (ActionCache
actionCache, AnnotatedCustomTypes
annotatedCustomTypes) <-
        arr
  (Writer (Seq CollectItem) (ActionCache, AnnotatedCustomTypes))
  (ActionCache, AnnotatedCustomTypes)
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter
          -< do
            -- custom types
            let scalarsMap :: BackendMap ScalarParsingMap
scalarsMap = [BackendMap ScalarParsingMap] -> BackendMap ScalarParsingMap
forall a. Monoid a => [a] -> a
mconcat ([BackendMap ScalarParsingMap] -> BackendMap ScalarParsingMap)
-> [BackendMap ScalarParsingMap] -> BackendMap ScalarParsingMap
forall a b. (a -> b) -> a -> b
$ ((AnyBackend SourceInfo, BackendMap ScalarParsingMap)
 -> BackendMap ScalarParsingMap)
-> [(AnyBackend SourceInfo, BackendMap ScalarParsingMap)]
-> [BackendMap ScalarParsingMap]
forall a b. (a -> b) -> [a] -> [b]
map (AnyBackend SourceInfo, BackendMap ScalarParsingMap)
-> BackendMap ScalarParsingMap
forall a b. (a, b) -> b
snd ([(AnyBackend SourceInfo, BackendMap ScalarParsingMap)]
 -> [BackendMap ScalarParsingMap])
-> [(AnyBackend SourceInfo, BackendMap ScalarParsingMap)]
-> [BackendMap ScalarParsingMap]
forall a b. (a -> b) -> a -> b
$ HashMap
  SourceName (AnyBackend SourceInfo, BackendMap ScalarParsingMap)
-> [(AnyBackend SourceInfo, BackendMap ScalarParsingMap)]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap
  SourceName (AnyBackend SourceInfo, BackendMap ScalarParsingMap)
sourcesOutput
                sourcesCache :: SourceCache
sourcesCache = ((AnyBackend SourceInfo, BackendMap ScalarParsingMap)
 -> AnyBackend SourceInfo)
-> HashMap
     SourceName (AnyBackend SourceInfo, BackendMap ScalarParsingMap)
-> SourceCache
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map (AnyBackend SourceInfo, BackendMap ScalarParsingMap)
-> AnyBackend SourceInfo
forall a b. (a, b) -> a
fst HashMap
  SourceName (AnyBackend SourceInfo, BackendMap ScalarParsingMap)
sourcesOutput
                actionList :: [ActionMetadata]
actionList = Actions -> [ActionMetadata]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems Actions
actions
            Maybe AnnotatedCustomTypes
maybeResolvedCustomTypes <-
              MetadataObject
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) AnnotatedCustomTypes
-> WriterT (Seq CollectItem) Identity (Maybe AnnotatedCustomTypes)
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM (MetadataObjId -> Value -> MetadataObject
MetadataObject MetadataObjId
MOCustomTypes (Value -> MetadataObject) -> Value -> MetadataObject
forall a b. (a -> b) -> a -> b
$ CustomTypes -> Value
forall a. ToJSON a => a -> Value
toJSON CustomTypes
customTypes)
                (ExceptT
   QErr (WriterT (Seq CollectItem) Identity) AnnotatedCustomTypes
 -> WriterT (Seq CollectItem) Identity (Maybe AnnotatedCustomTypes))
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) AnnotatedCustomTypes
-> WriterT (Seq CollectItem) Identity (Maybe AnnotatedCustomTypes)
forall a b. (a -> b) -> a -> b
$ SourceCache
-> CustomTypes
-> BackendMap ScalarParsingMap
-> ExceptT
     QErr (WriterT (Seq CollectItem) Identity) AnnotatedCustomTypes
forall (m :: * -> *).
MonadError QErr m =>
SourceCache
-> CustomTypes
-> BackendMap ScalarParsingMap
-> m AnnotatedCustomTypes
resolveCustomTypes SourceCache
sourcesCache CustomTypes
customTypes BackendMap ScalarParsingMap
scalarsMap
            case Maybe AnnotatedCustomTypes
maybeResolvedCustomTypes of
              Just AnnotatedCustomTypes
resolvedCustomTypes -> do
                ActionCache
actionCache' <- AnnotatedCustomTypes
-> BackendMap ScalarParsingMap
-> OrderedRoles
-> [ActionMetadata]
-> WriterT (Seq CollectItem) Identity ActionCache
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
AnnotatedCustomTypes
-> BackendMap ScalarParsingMap
-> OrderedRoles
-> [ActionMetadata]
-> m ActionCache
buildActions AnnotatedCustomTypes
resolvedCustomTypes BackendMap ScalarParsingMap
scalarsMap OrderedRoles
orderedRoles [ActionMetadata]
actionList
                (ActionCache, AnnotatedCustomTypes)
-> Writer (Seq CollectItem) (ActionCache, AnnotatedCustomTypes)
forall a. a -> WriterT (Seq CollectItem) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionCache
actionCache', AnnotatedCustomTypes
resolvedCustomTypes)
              -- If the custom types themselves are inconsistent, we can’t really do
              -- anything with actions, so just mark them all inconsistent.
              Maybe AnnotatedCustomTypes
Nothing -> do
                [MetadataObject] -> Text -> WriterT (Seq CollectItem) Identity ()
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
[MetadataObject] -> Text -> m ()
recordInconsistenciesM
                  ((ActionMetadata -> MetadataObject)
-> [ActionMetadata] -> [MetadataObject]
forall a b. (a -> b) -> [a] -> [b]
map ActionMetadata -> MetadataObject
mkActionMetadataObject [ActionMetadata]
actionList)
                  Text
"custom types are inconsistent"
                (ActionCache, AnnotatedCustomTypes)
-> Writer (Seq CollectItem) (ActionCache, AnnotatedCustomTypes)
forall a. a -> WriterT (Seq CollectItem) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionCache
forall a. Monoid a => a
mempty, AnnotatedCustomTypes
forall a. Monoid a => a
mempty)

      arr BuildOutputs BuildOutputs
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA
        -<
          BuildOutputs
            { _boSources :: SourceCache
_boSources = ((AnyBackend SourceInfo, BackendMap ScalarParsingMap)
 -> AnyBackend SourceInfo)
-> HashMap
     SourceName (AnyBackend SourceInfo, BackendMap ScalarParsingMap)
-> SourceCache
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map (AnyBackend SourceInfo, BackendMap ScalarParsingMap)
-> AnyBackend SourceInfo
forall a b. (a, b) -> a
fst HashMap
  SourceName (AnyBackend SourceInfo, BackendMap ScalarParsingMap)
sourcesOutput,
              _boActions :: ActionCache
_boActions = ActionCache
actionCache,
              _boRemoteSchemas :: HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
_boRemoteSchemas = HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
remoteSchemaCache,
              _boCustomTypes :: AnnotatedCustomTypes
_boCustomTypes = AnnotatedCustomTypes
annotatedCustomTypes,
              _boRoles :: HashMap RoleName Role
_boRoles = (Role -> RoleName) -> [Role] -> HashMap RoleName Role
forall k a. Hashable k => (a -> k) -> [a] -> HashMap k a
mapFromL Role -> RoleName
_rRoleName ([Role] -> HashMap RoleName Role)
-> [Role] -> HashMap RoleName Role
forall a b. (a -> b) -> a -> b
$ OrderedRoles -> [Role]
_unOrderedRoles OrderedRoles
orderedRoles,
              _boBackendCache :: BackendCache
_boBackendCache = BackendCache
backendCache
            }

    buildOpenTelemetry ::
      (MonadWriter (Seq CollectItem) m) =>
      OpenTelemetryConfig ->
      m OpenTelemetryInfo
    buildOpenTelemetry :: forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
OpenTelemetryConfig -> m OpenTelemetryInfo
buildOpenTelemetry OpenTelemetryConfig {Set OtelDataType
OtelBatchSpanProcessorConfig
OtelExporterConfig
OtelStatus
_ocStatus :: OtelStatus
_ocEnabledDataTypes :: Set OtelDataType
_ocExporterOtlp :: OtelExporterConfig
_ocBatchSpanProcessor :: OtelBatchSpanProcessorConfig
_ocStatus :: OpenTelemetryConfig -> OtelStatus
_ocEnabledDataTypes :: OpenTelemetryConfig -> Set OtelDataType
_ocExporterOtlp :: OpenTelemetryConfig -> OtelExporterConfig
_ocBatchSpanProcessor :: OpenTelemetryConfig -> OtelBatchSpanProcessorConfig
..} = do
      -- Always perform validation, even if OpenTelemetry is disabled
      Maybe OtelExporterInfo
mOtelExporterInfo <-
        (Maybe (Maybe OtelExporterInfo) -> Maybe OtelExporterInfo)
-> m (Maybe (Maybe OtelExporterInfo)) -> m (Maybe OtelExporterInfo)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe OtelExporterInfo) -> Maybe OtelExporterInfo
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
          (m (Maybe (Maybe OtelExporterInfo)) -> m (Maybe OtelExporterInfo))
-> m (Maybe (Maybe OtelExporterInfo)) -> m (Maybe OtelExporterInfo)
forall a b. (a -> b) -> a -> b
$ MetadataObject
-> ExceptT QErr m (Maybe OtelExporterInfo)
-> m (Maybe (Maybe OtelExporterInfo))
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM (MetadataObjId -> Value -> MetadataObject
MetadataObject (OpenTelemetryConfigSubobject -> MetadataObjId
MOOpenTelemetry OpenTelemetryConfigSubobject
OtelSubobjectExporterOtlp) (OtelExporterConfig -> Value
forall a. ToJSON a => a -> Value
toJSON OtelExporterConfig
_ocExporterOtlp))
          (ExceptT QErr m (Maybe OtelExporterInfo)
 -> m (Maybe (Maybe OtelExporterInfo)))
-> ExceptT QErr m (Maybe OtelExporterInfo)
-> m (Maybe (Maybe OtelExporterInfo))
forall a b. (a -> b) -> a -> b
$ Either QErr (Maybe OtelExporterInfo)
-> ExceptT QErr m (Maybe OtelExporterInfo)
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
          (Either QErr (Maybe OtelExporterInfo)
 -> ExceptT QErr m (Maybe OtelExporterInfo))
-> Either QErr (Maybe OtelExporterInfo)
-> ExceptT QErr m (Maybe OtelExporterInfo)
forall a b. (a -> b) -> a -> b
$ OtelStatus
-> Environment
-> OtelExporterConfig
-> Either QErr (Maybe OtelExporterInfo)
parseOtelExporterConfig OtelStatus
_ocStatus Environment
env OtelExporterConfig
_ocExporterOtlp
      Maybe OtelBatchSpanProcessorInfo
mOtelBatchSpanProcessorInfo <-
        MetadataObject
-> ExceptT QErr m OtelBatchSpanProcessorInfo
-> m (Maybe OtelBatchSpanProcessorInfo)
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM (MetadataObjId -> Value -> MetadataObject
MetadataObject (OpenTelemetryConfigSubobject -> MetadataObjId
MOOpenTelemetry OpenTelemetryConfigSubobject
OtelSubobjectBatchSpanProcessor) (OtelBatchSpanProcessorConfig -> Value
forall a. ToJSON a => a -> Value
toJSON OtelBatchSpanProcessorConfig
_ocBatchSpanProcessor))
          (ExceptT QErr m OtelBatchSpanProcessorInfo
 -> m (Maybe OtelBatchSpanProcessorInfo))
-> ExceptT QErr m OtelBatchSpanProcessorInfo
-> m (Maybe OtelBatchSpanProcessorInfo)
forall a b. (a -> b) -> a -> b
$ Either QErr OtelBatchSpanProcessorInfo
-> ExceptT QErr m OtelBatchSpanProcessorInfo
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
          (Either QErr OtelBatchSpanProcessorInfo
 -> ExceptT QErr m OtelBatchSpanProcessorInfo)
-> Either QErr OtelBatchSpanProcessorInfo
-> ExceptT QErr m OtelBatchSpanProcessorInfo
forall a b. (a -> b) -> a -> b
$ OtelBatchSpanProcessorConfig
-> Either QErr OtelBatchSpanProcessorInfo
parseOtelBatchSpanProcessorConfig OtelBatchSpanProcessorConfig
_ocBatchSpanProcessor
      OpenTelemetryInfo -> m OpenTelemetryInfo
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (OpenTelemetryInfo -> m OpenTelemetryInfo)
-> OpenTelemetryInfo -> m OpenTelemetryInfo
forall a b. (a -> b) -> a -> b
$ case OtelStatus
_ocStatus of
          OtelStatus
OtelDisabled ->
            -- Disable all components if OpenTelemetry export not enabled
            Maybe OtelExporterInfo
-> Maybe OtelBatchSpanProcessorInfo -> OpenTelemetryInfo
OpenTelemetryInfo Maybe OtelExporterInfo
forall a. Maybe a
Nothing Maybe OtelBatchSpanProcessorInfo
forall a. Maybe a
Nothing
          OtelStatus
OtelEnabled ->
            Maybe OtelExporterInfo
-> Maybe OtelBatchSpanProcessorInfo -> OpenTelemetryInfo
OpenTelemetryInfo
              Maybe OtelExporterInfo
mOtelExporterInfo
              -- Disable data types if they are not in the enabled set
              ( if OtelDataType
OtelTraces OtelDataType -> Set OtelDataType -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set OtelDataType
_ocEnabledDataTypes
                  then Maybe OtelBatchSpanProcessorInfo
mOtelBatchSpanProcessorInfo
                  else Maybe OtelBatchSpanProcessorInfo
forall a. Maybe a
Nothing
              )

    buildRESTEndpoints ::
      (MonadWriter (Seq CollectItem) m) =>
      QueryCollections ->
      [CreateEndpoint] ->
      m (HashMap EndpointName (EndpointMetadata GQLQueryWithText))
    buildRESTEndpoints :: forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
QueryCollections
-> [CreateEndpoint]
-> m (HashMap EndpointName (EndpointMetadata GQLQueryWithText))
buildRESTEndpoints QueryCollections
collections [CreateEndpoint]
endpoints = (CreateEndpoint -> EndpointName)
-> (CreateEndpoint -> MetadataObject)
-> (CreateEndpoint
    -> m (Maybe (EndpointMetadata GQLQueryWithText)))
-> [CreateEndpoint]
-> m (HashMap EndpointName (EndpointMetadata GQLQueryWithText))
forall (m :: * -> *) k a b.
(MonadWriter (Seq CollectItem) m, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> (a -> m (Maybe b))
-> [a]
-> m (HashMap k b)
buildInfoMapM CreateEndpoint -> EndpointName
forall query. EndpointMetadata query -> EndpointName
_ceName CreateEndpoint -> MetadataObject
forall {q}. ToJSON q => EndpointMetadata q -> MetadataObject
mkEndpointMetadataObject CreateEndpoint -> m (Maybe (EndpointMetadata GQLQueryWithText))
buildEndpoint [CreateEndpoint]
endpoints
      where
        mkEndpointMetadataObject :: EndpointMetadata query -> MetadataObject
mkEndpointMetadataObject createEndpoint :: EndpointMetadata query
createEndpoint@EndpointMetadata {Maybe Text
NonEmpty EndpointMethod
EndpointUrl
EndpointName
EndpointDef query
_ceUrl :: forall query. EndpointMetadata query -> EndpointUrl
_ceName :: forall query. EndpointMetadata query -> EndpointName
_ceName :: EndpointName
_ceUrl :: EndpointUrl
_ceMethods :: NonEmpty EndpointMethod
_ceDefinition :: EndpointDef query
_ceComment :: Maybe Text
_ceMethods :: forall query. EndpointMetadata query -> NonEmpty EndpointMethod
_ceDefinition :: forall query. EndpointMetadata query -> EndpointDef query
_ceComment :: forall query. EndpointMetadata query -> Maybe Text
..} =
          let objectId :: MetadataObjId
objectId = EndpointName -> MetadataObjId
MOEndpoint EndpointName
_ceName
           in MetadataObjId -> Value -> MetadataObject
MetadataObject MetadataObjId
objectId (EndpointMetadata query -> Value
forall a. ToJSON a => a -> Value
toJSON EndpointMetadata query
createEndpoint)

        buildEndpoint :: CreateEndpoint -> m (Maybe (EndpointMetadata GQLQueryWithText))
buildEndpoint createEndpoint :: CreateEndpoint
createEndpoint@EndpointMetadata {Maybe Text
NonEmpty EndpointMethod
EndpointUrl
EndpointName
EndpointDef QueryReference
_ceUrl :: forall query. EndpointMetadata query -> EndpointUrl
_ceName :: forall query. EndpointMetadata query -> EndpointName
_ceMethods :: forall query. EndpointMetadata query -> NonEmpty EndpointMethod
_ceDefinition :: forall query. EndpointMetadata query -> EndpointDef query
_ceComment :: forall query. EndpointMetadata query -> Maybe Text
_ceName :: EndpointName
_ceUrl :: EndpointUrl
_ceMethods :: NonEmpty EndpointMethod
_ceDefinition :: EndpointDef QueryReference
_ceComment :: Maybe Text
..} = do
          let -- QueryReference collName queryName = _edQuery endpoint
              addContext :: Text -> Text
addContext Text
err = Text
"in endpoint " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> EndpointName -> Text
forall a. ToTxt a => a -> Text
toTxt EndpointName
_ceName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
          MetadataObject
-> ExceptT QErr m (EndpointMetadata GQLQueryWithText)
-> m (Maybe (EndpointMetadata GQLQueryWithText))
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM (CreateEndpoint -> MetadataObject
forall {q}. ToJSON q => EndpointMetadata q -> MetadataObject
mkEndpointMetadataObject CreateEndpoint
createEndpoint) (ExceptT QErr m (EndpointMetadata GQLQueryWithText)
 -> m (Maybe (EndpointMetadata GQLQueryWithText)))
-> ExceptT QErr m (EndpointMetadata GQLQueryWithText)
-> m (Maybe (EndpointMetadata GQLQueryWithText))
forall a b. (a -> b) -> a -> b
$ (Text -> Text)
-> ExceptT QErr m (EndpointMetadata GQLQueryWithText)
-> ExceptT QErr m (EndpointMetadata GQLQueryWithText)
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr Text -> Text
addContext (ExceptT QErr m (EndpointMetadata GQLQueryWithText)
 -> ExceptT QErr m (EndpointMetadata GQLQueryWithText))
-> ExceptT QErr m (EndpointMetadata GQLQueryWithText)
-> ExceptT QErr m (EndpointMetadata GQLQueryWithText)
forall a b. (a -> b) -> a -> b
$ QueryCollections
-> CreateEndpoint
-> ExceptT QErr m (EndpointMetadata GQLQueryWithText)
forall (m :: * -> *).
QErrM m =>
QueryCollections
-> CreateEndpoint -> m (EndpointMetadata GQLQueryWithText)
resolveEndpoint QueryCollections
collections CreateEndpoint
createEndpoint

    resolveEndpoint ::
      (QErrM m) =>
      InsOrdHashMap CollectionName CreateCollection ->
      EndpointMetadata QueryReference ->
      m (EndpointMetadata GQLQueryWithText)
    resolveEndpoint :: forall (m :: * -> *).
QErrM m =>
QueryCollections
-> CreateEndpoint -> m (EndpointMetadata GQLQueryWithText)
resolveEndpoint QueryCollections
collections = (QueryReference -> m GQLQueryWithText)
-> CreateEndpoint -> m (EndpointMetadata GQLQueryWithText)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EndpointMetadata a -> f (EndpointMetadata b)
traverse ((QueryReference -> m GQLQueryWithText)
 -> CreateEndpoint -> m (EndpointMetadata GQLQueryWithText))
-> (QueryReference -> m GQLQueryWithText)
-> CreateEndpoint
-> m (EndpointMetadata GQLQueryWithText)
forall a b. (a -> b) -> a -> b
$ \(QueryReference CollectionName
collName QueryName
queryName) -> do
      CreateCollection
collection <-
        Maybe CreateCollection -> m CreateCollection -> m CreateCollection
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing
          (CollectionName -> QueryCollections -> Maybe CreateCollection
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup CollectionName
collName QueryCollections
collections)
          (Code -> Text -> m CreateCollection
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists (Text -> m CreateCollection) -> Text -> m CreateCollection
forall a b. (a -> b) -> a -> b
$ Text
"collection with name " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CollectionName -> Text
forall a. ToTxt a => a -> Text
toTxt CollectionName
collName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not exist")
      ListedQuery
listedQuery <-
        (Maybe ListedQuery -> m ListedQuery -> m ListedQuery)
-> m ListedQuery -> Maybe ListedQuery -> m ListedQuery
forall a b c. (a -> b -> c) -> b -> a -> c
flip
          Maybe ListedQuery -> m ListedQuery -> m ListedQuery
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing
          ( Code -> Text -> m ListedQuery
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
              (Text -> m ListedQuery) -> Text -> m ListedQuery
forall a b. (a -> b) -> a -> b
$ Text
"query with name "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QueryName -> Text
forall a. ToTxt a => a -> Text
toTxt QueryName
queryName
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not exist in collection "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CollectionName -> Text
forall a. ToTxt a => a -> Text
toTxt CollectionName
collName
          )
          (Maybe ListedQuery -> m ListedQuery)
-> Maybe ListedQuery -> m ListedQuery
forall a b. (a -> b) -> a -> b
$ (ListedQuery -> Bool) -> [ListedQuery] -> Maybe ListedQuery
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((QueryName -> QueryName -> Bool
forall a. Eq a => a -> a -> Bool
== QueryName
queryName) (QueryName -> Bool)
-> (ListedQuery -> QueryName) -> ListedQuery -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListedQuery -> QueryName
_lqName) (CollectionDef -> [ListedQuery]
_cdQueries (CreateCollection -> CollectionDef
_ccDefinition CreateCollection
collection))

      let lq :: GQLQueryWithText
lq@(GQLQueryWithText (Text, GQLQuery)
lqq) = ListedQuery -> GQLQueryWithText
_lqQuery ListedQuery
listedQuery
          ds :: [ExecutableDefinition Name]
ds = ExecutableDocument Name -> [ExecutableDefinition Name]
forall var. ExecutableDocument var -> [ExecutableDefinition var]
G.getExecutableDefinitions (ExecutableDocument Name -> [ExecutableDefinition Name])
-> ExecutableDocument Name -> [ExecutableDefinition Name]
forall a b. (a -> b) -> a -> b
$ GQLQuery -> ExecutableDocument Name
unGQLQuery (GQLQuery -> ExecutableDocument Name)
-> GQLQuery -> ExecutableDocument Name
forall a b. (a -> b) -> a -> b
$ (Text, GQLQuery) -> GQLQuery
forall a b. (a, b) -> b
snd (Text, GQLQuery)
lqq

      case [ExecutableDefinition Name]
ds of
        [G.ExecutableDefinitionOperation (G.OperationDefinitionTyped TypedOperationDefinition FragmentSpread Name
d)]
          | TypedOperationDefinition FragmentSpread Name -> OperationType
forall (frag :: * -> *) var.
TypedOperationDefinition frag var -> OperationType
G._todType TypedOperationDefinition FragmentSpread Name
d OperationType -> OperationType -> Bool
forall a. Eq a => a -> a -> Bool
== OperationType
G.OperationTypeSubscription ->
              Text -> m ()
forall (m :: * -> *) a. QErrM m => Text -> m a
throw405 (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"query with name " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QueryName -> Text
forall a. ToTxt a => a -> Text
toTxt QueryName
queryName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is a subscription"
          | Bool
otherwise -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        [] -> Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
BadRequest (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"query with name " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QueryName -> Text
forall a. ToTxt a => a -> Text
toTxt QueryName
queryName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" has no definitions."
        [ExecutableDefinition Name]
_ -> Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
BadRequest (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"query with name " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> QueryName -> Text
forall a. ToTxt a => a -> Text
toTxt QueryName
queryName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" has multiple definitions."

      GQLQueryWithText -> m GQLQueryWithText
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GQLQueryWithText
lq

    mkEventTriggerMetadataObject ::
      forall b a c.
      (Backend b) =>
      (CacheDynamicConfig, a, SourceName, c, TableName b, RecreateEventTriggers, EventTriggerConf b) ->
      MetadataObject
    mkEventTriggerMetadataObject :: forall (b :: BackendType) a c.
Backend b =>
(CacheDynamicConfig, a, SourceName, c, TableName b,
 RecreateEventTriggers, EventTriggerConf b)
-> MetadataObject
mkEventTriggerMetadataObject (CacheDynamicConfig
_, a
_, SourceName
source, c
_, TableName b
table, RecreateEventTriggers
_, EventTriggerConf b
eventTriggerConf) =
      SourceName -> TableName b -> EventTriggerConf b -> MetadataObject
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> EventTriggerConf b -> MetadataObject
mkEventTriggerMetadataObject' SourceName
source TableName b
table EventTriggerConf b
eventTriggerConf

    mkEventTriggerMetadataObject' ::
      forall b.
      (Backend b) =>
      SourceName ->
      TableName b ->
      EventTriggerConf b ->
      MetadataObject
    mkEventTriggerMetadataObject' :: forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> EventTriggerConf b -> MetadataObject
mkEventTriggerMetadataObject' SourceName
source TableName b
table EventTriggerConf b
eventTriggerConf =
      let objectId :: MetadataObjId
objectId =
            SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source
              (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
              (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableMetadataObjId -> SourceMetadataObjId b
SMOTableObj @b TableName b
table
              (TableMetadataObjId -> SourceMetadataObjId b)
-> TableMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$ TriggerName -> TableMetadataObjId
MTOTrigger
              (TriggerName -> TableMetadataObjId)
-> TriggerName -> TableMetadataObjId
forall a b. (a -> b) -> a -> b
$ EventTriggerConf b -> TriggerName
forall (b :: BackendType). EventTriggerConf b -> TriggerName
etcName EventTriggerConf b
eventTriggerConf
          definition :: Value
definition = [Pair] -> Value
object [Key
"table" Key -> TableName b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TableName b
table, Key
"configuration" Key -> EventTriggerConf b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= EventTriggerConf b
eventTriggerConf]
       in MetadataObjId -> Value -> MetadataObject
MetadataObject MetadataObjId
objectId Value
definition

    mkCronTriggerMetadataObject :: CronTriggerMetadata -> MetadataObject
mkCronTriggerMetadataObject CronTriggerMetadata
catalogCronTrigger =
      let definition :: Value
definition = CronTriggerMetadata -> Value
forall a. ToJSON a => a -> Value
toJSON CronTriggerMetadata
catalogCronTrigger
       in MetadataObjId -> Value -> MetadataObject
MetadataObject
            (TriggerName -> MetadataObjId
MOCronTrigger (CronTriggerMetadata -> TriggerName
ctName CronTriggerMetadata
catalogCronTrigger))
            Value
definition

    mkActionMetadataObject :: ActionMetadata -> MetadataObject
mkActionMetadataObject (ActionMetadata ActionName
name Maybe Text
comment ActionDefinitionInput
defn [ActionPermissionMetadata]
_) =
      MetadataObjId -> Value -> MetadataObject
MetadataObject (ActionName -> MetadataObjId
MOAction ActionName
name) (CreateAction -> Value
forall a. ToJSON a => a -> Value
toJSON (CreateAction -> Value) -> CreateAction -> Value
forall a b. (a -> b) -> a -> b
$ ActionName -> ActionDefinitionInput -> Maybe Text -> CreateAction
CreateAction ActionName
name ActionDefinitionInput
defn Maybe Text
comment)

    mkInheritedRoleMetadataObject :: Role -> MetadataObject
mkInheritedRoleMetadataObject inheritedRole :: Role
inheritedRole@(Role RoleName
roleName ParentRoles
_) =
      MetadataObjId -> Value -> MetadataObject
MetadataObject (RoleName -> MetadataObjId
MOInheritedRole RoleName
roleName) (Role -> Value
forall a. ToJSON a => a -> Value
toJSON Role
inheritedRole)

    buildTableEventTriggers ::
      forall arr m b.
      ( ArrowChoice arr,
        Inc.ArrowDistribute arr,
        ArrowWriter (Seq CollectItem) arr,
        Inc.ArrowCache m arr,
        MonadIO m,
        MonadBaseControl IO m,
        MonadReader BuildReason m,
        BackendMetadata b,
        BackendEventTrigger b,
        HasCacheStaticConfig m
      ) =>
      ( CacheDynamicConfig,
        SourceName,
        SourceConfig b,
        TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b),
        [EventTriggerConf b],
        Inc.Dependency Inc.InvalidationKey,
        RecreateEventTriggers
      )
        `arr` (EventTriggerInfoMap b)
    buildTableEventTriggers :: forall (arr :: * -> * -> *) (m :: * -> *) (b :: BackendType).
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectItem) arr, ArrowCache m arr, MonadIO m,
 MonadBaseControl IO m, MonadReader BuildReason m,
 BackendMetadata b, BackendEventTrigger b,
 HasCacheStaticConfig m) =>
arr
  (CacheDynamicConfig, SourceName, SourceConfig b,
   TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b),
   [EventTriggerConf b], Dependency InvalidationKey,
   RecreateEventTriggers)
  (EventTriggerInfoMap b)
buildTableEventTriggers = proc (CacheDynamicConfig
dynamicConfig, SourceName
sourceName, SourceConfig b
sourceConfig, TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
tableInfo, [EventTriggerConf b]
eventTriggerConfs, Dependency InvalidationKey
metadataInvalidationKey, RecreateEventTriggers
migrationRecreateEventTriggers) ->
      ((CacheDynamicConfig, Dependency InvalidationKey, SourceName,
  SourceConfig b, TableName b, RecreateEventTriggers,
  EventTriggerConf b)
 -> TriggerName)
-> ((CacheDynamicConfig, Dependency InvalidationKey, SourceName,
     SourceConfig b, TableName b, RecreateEventTriggers,
     EventTriggerConf b)
    -> MetadataObject)
-> arr
     (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
      (CacheDynamicConfig, Dependency InvalidationKey, SourceName,
       SourceConfig b, TableName b, RecreateEventTriggers,
       EventTriggerConf b))
     (Maybe (EventTriggerInfo b))
-> arr
     (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
      [(CacheDynamicConfig, Dependency InvalidationKey, SourceName,
        SourceConfig b, TableName b, RecreateEventTriggers,
        EventTriggerConf b)])
     (EventTriggerInfoMap b)
forall (arr :: * -> * -> *) k a e b.
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectItem) arr, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe b)
-> arr (e, [a]) (HashMap k b)
buildInfoMap (EventTriggerConf b -> TriggerName
forall (b :: BackendType). EventTriggerConf b -> TriggerName
etcName (EventTriggerConf b -> TriggerName)
-> ((CacheDynamicConfig, Dependency InvalidationKey, SourceName,
     SourceConfig b, TableName b, RecreateEventTriggers,
     EventTriggerConf b)
    -> EventTriggerConf b)
-> (CacheDynamicConfig, Dependency InvalidationKey, SourceName,
    SourceConfig b, TableName b, RecreateEventTriggers,
    EventTriggerConf b)
-> TriggerName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CacheDynamicConfig, Dependency InvalidationKey, SourceName,
 SourceConfig b, TableName b, RecreateEventTriggers,
 EventTriggerConf b)
-> Getting
     (EventTriggerConf b)
     (CacheDynamicConfig, Dependency InvalidationKey, SourceName,
      SourceConfig b, TableName b, RecreateEventTriggers,
      EventTriggerConf b)
     (EventTriggerConf b)
-> EventTriggerConf b
forall s a. s -> Getting a s a -> a
^. Getting
  (EventTriggerConf b)
  (CacheDynamicConfig, Dependency InvalidationKey, SourceName,
   SourceConfig b, TableName b, RecreateEventTriggers,
   EventTriggerConf b)
  (EventTriggerConf b)
forall s t a b. Field7 s t a b => Lens s t a b
Lens
  (CacheDynamicConfig, Dependency InvalidationKey, SourceName,
   SourceConfig b, TableName b, RecreateEventTriggers,
   EventTriggerConf b)
  (CacheDynamicConfig, Dependency InvalidationKey, SourceName,
   SourceConfig b, TableName b, RecreateEventTriggers,
   EventTriggerConf b)
  (EventTriggerConf b)
  (EventTriggerConf b)
_7)) (forall (b :: BackendType) a c.
Backend b =>
(CacheDynamicConfig, a, SourceName, c, TableName b,
 RecreateEventTriggers, EventTriggerConf b)
-> MetadataObject
mkEventTriggerMetadataObject @b) arr
  (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
   (CacheDynamicConfig, Dependency InvalidationKey, SourceName,
    SourceConfig b, TableName b, RecreateEventTriggers,
    EventTriggerConf b))
  (Maybe (EventTriggerInfo b))
buildEventTrigger
        -<
          (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
tableInfo TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
-> (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
    -> TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
-> TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
forall a b. a -> (a -> b) -> b
& (FieldInfoMap (StructuredColumnInfo b)
 -> Identity (FieldInfoMap (ColumnInfo b)))
-> TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
-> Identity (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
forall (b :: BackendType) field1 primaryKeyColumn field2
       (f :: * -> *).
Functor f =>
(FieldInfoMap field1 -> f (FieldInfoMap field2))
-> TableCoreInfoG b field1 primaryKeyColumn
-> f (TableCoreInfoG b field2 primaryKeyColumn)
tciFieldInfoMap ((FieldInfoMap (StructuredColumnInfo b)
  -> Identity (FieldInfoMap (ColumnInfo b)))
 -> TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
 -> Identity (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)))
-> (FieldInfoMap (StructuredColumnInfo b)
    -> FieldInfoMap (ColumnInfo b))
-> TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
-> TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (StructuredColumnInfo b -> Maybe (ColumnInfo b))
-> FieldInfoMap (StructuredColumnInfo b)
-> FieldInfoMap (ColumnInfo b)
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HashMap.mapMaybe StructuredColumnInfo b -> Maybe (ColumnInfo b)
forall (b :: BackendType).
StructuredColumnInfo b -> Maybe (ColumnInfo b)
toScalarColumnInfo, (EventTriggerConf b
 -> (CacheDynamicConfig, Dependency InvalidationKey, SourceName,
     SourceConfig b, TableName b, RecreateEventTriggers,
     EventTriggerConf b))
-> [EventTriggerConf b]
-> [(CacheDynamicConfig, Dependency InvalidationKey, SourceName,
     SourceConfig b, TableName b, RecreateEventTriggers,
     EventTriggerConf b)]
forall a b. (a -> b) -> [a] -> [b]
map (CacheDynamicConfig
dynamicConfig,Dependency InvalidationKey
metadataInvalidationKey,SourceName
sourceName,SourceConfig b
sourceConfig,TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
-> TableName b
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableName b
_tciName TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
tableInfo,RecreateEventTriggers
migrationRecreateEventTriggers,) [EventTriggerConf b]
eventTriggerConfs)
      where
        buildEventTrigger :: arr
  (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
   (CacheDynamicConfig, Dependency InvalidationKey, SourceName,
    SourceConfig b, TableName b, RecreateEventTriggers,
    EventTriggerConf b))
  (Maybe (EventTriggerInfo b))
buildEventTrigger = proc (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
tableInfo, (CacheDynamicConfig
dynamicConfig, Dependency InvalidationKey
_metadataInvalidationKey, SourceName
source, SourceConfig b
sourceConfig, TableName b
table, RecreateEventTriggers
migrationRecreateEventTriggers, EventTriggerConf b
eventTriggerConf)) -> do
          let triggerName :: TriggerName
triggerName = EventTriggerConf b -> TriggerName
forall (b :: BackendType). EventTriggerConf b -> TriggerName
etcName EventTriggerConf b
eventTriggerConf
              triggerOnReplication :: TriggerOnReplication
triggerOnReplication = EventTriggerConf b -> TriggerOnReplication
forall (b :: BackendType).
EventTriggerConf b -> TriggerOnReplication
etcTriggerOnReplication EventTriggerConf b
eventTriggerConf
              metadataObject :: MetadataObject
metadataObject = forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> EventTriggerConf b -> MetadataObject
mkEventTriggerMetadataObject' @b SourceName
source TableName b
table EventTriggerConf b
eventTriggerConf
              schemaObjectId :: SchemaObjId
schemaObjectId =
                SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
                  (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                  (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b TableName b
table
                  (TableObjId b -> SourceObjId b) -> TableObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$ TriggerName -> TableObjId b
forall (b :: BackendType). TriggerName -> TableObjId b
TOTrigger TriggerName
triggerName
              addTriggerContext :: Text -> Text
addTriggerContext Text
e = Text
"in event trigger " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TriggerName
triggerName TriggerName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
          BuildReason
buildReason <- arr (m BuildReason) BuildReason
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< m BuildReason
forall r (m :: * -> *). MonadReader r m => m r
ask
          let reloadMetadataRecreateEventTrigger :: RecreateEventTriggers
reloadMetadataRecreateEventTrigger =
                case BuildReason
buildReason of
                  BuildReason
CatalogSync -> RecreateEventTriggers
RETDoNothing
                  CatalogUpdate Maybe (HashSet SourceName)
Nothing -> RecreateEventTriggers
RETDoNothing
                  CatalogUpdate (Just HashSet SourceName
sources) -> if SourceName
source SourceName -> HashSet SourceName -> Bool
forall a. Eq a => a -> HashSet a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` HashSet SourceName
sources then RecreateEventTriggers
RETRecreate else RecreateEventTriggers
RETDoNothing
          (|
            ErrorA QErr arr (a, ()) (EventTriggerInfo b)
-> arr (a, (MetadataObject, ())) (Maybe (EventTriggerInfo b))
forall {a}.
ErrorA QErr arr (a, ()) (EventTriggerInfo b)
-> arr (a, (MetadataObject, ())) (Maybe (EventTriggerInfo b))
forall (arr :: * -> * -> *) e s a.
(ArrowChoice arr, ArrowWriter (Seq CollectItem) arr) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
              ( do
                  (EventTriggerInfo b
info, Seq SchemaDependency
dependencies) <- ErrorA
  QErr
  arr
  (ExceptT QErr m (EventTriggerInfo b, Seq SchemaDependency))
  (EventTriggerInfo b, Seq SchemaDependency)
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr) =>
arr (ExceptT e m a) a
bindErrorA -< (Text -> Text)
-> ExceptT QErr m (EventTriggerInfo b, Seq SchemaDependency)
-> ExceptT QErr m (EventTriggerInfo b, Seq SchemaDependency)
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr (forall (b :: BackendType). Backend b => TableName b -> Text -> Text
addTableContext @b TableName b
table (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
addTriggerContext) (ExceptT QErr m (EventTriggerInfo b, Seq SchemaDependency)
 -> ExceptT QErr m (EventTriggerInfo b, Seq SchemaDependency))
-> ExceptT QErr m (EventTriggerInfo b, Seq SchemaDependency)
-> ExceptT QErr m (EventTriggerInfo b, Seq SchemaDependency)
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) (m :: * -> *).
(Backend b, QErrM m) =>
Environment
-> SourceName
-> TableName b
-> EventTriggerConf b
-> m (EventTriggerInfo b, Seq SchemaDependency)
buildEventTriggerInfo @b Environment
env SourceName
source TableName b
table EventTriggerConf b
eventTriggerConf
                  CacheStaticConfig
staticConfig <- ErrorA QErr arr (m CacheStaticConfig) CacheStaticConfig
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< m CacheStaticConfig
forall (m :: * -> *). HasCacheStaticConfig m => m CacheStaticConfig
askCacheStaticConfig
                  let isCatalogUpdate :: Bool
isCatalogUpdate =
                        case BuildReason
buildReason of
                          CatalogUpdate Maybe (HashSet SourceName)
_ -> Bool
True
                          BuildReason
CatalogSync -> Bool
False
                      tableColumns :: [ColumnInfo b]
tableColumns = FieldInfoMap (ColumnInfo b) -> [ColumnInfo b]
forall k v. HashMap k v -> [v]
HashMap.elems (FieldInfoMap (ColumnInfo b) -> [ColumnInfo b])
-> FieldInfoMap (ColumnInfo b) -> [ColumnInfo b]
forall a b. (a -> b) -> a -> b
$ TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
-> FieldInfoMap (ColumnInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
tableInfo
                  if ( CacheStaticConfig -> MaintenanceMode ()
_cscMaintenanceMode CacheStaticConfig
staticConfig
                         MaintenanceMode () -> MaintenanceMode () -> Bool
forall a. Eq a => a -> a -> Bool
== MaintenanceMode ()
forall a. MaintenanceMode a
MaintenanceModeDisabled
                         Bool -> Bool -> Bool
&& CacheStaticConfig -> ReadOnlyMode
_cscReadOnlyMode CacheStaticConfig
staticConfig
                         ReadOnlyMode -> ReadOnlyMode -> Bool
forall a. Eq a => a -> a -> Bool
== ReadOnlyMode
ReadOnlyModeDisabled
                     )
                    then do
                      ErrorA QErr arr (ExceptT QErr m ()) ()
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr) =>
arr (ExceptT e m a) a
bindErrorA
                        -<
                          Bool -> ExceptT QErr m () -> ExceptT QErr m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RecreateEventTriggers
reloadMetadataRecreateEventTrigger RecreateEventTriggers -> RecreateEventTriggers -> Bool
forall a. Eq a => a -> a -> Bool
== RecreateEventTriggers
RETRecreate)
                            (ExceptT QErr m () -> ExceptT QErr m ())
-> ExceptT QErr m () -> ExceptT QErr m ()
forall a b. (a -> b) -> a -> b
$
                            -- This is the case when the user sets `recreate_event_triggers`
                            -- to `true` in `reload_metadata`, in this case, we recreate
                            -- the SQL trigger by force, even if it may not be necessary
                            -- TODO: Should we also mark the event trigger as inconsistent here?
                            ExceptT QErr m (Either QErr ()) -> ExceptT QErr m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM
                            (ExceptT QErr m (Either QErr ()) -> ExceptT QErr m ())
-> ExceptT QErr m (Either QErr ()) -> ExceptT QErr m ()
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) (m :: * -> *).
(BackendEventTrigger b, MonadBaseControl IO m, MonadIO m,
 MonadError QErr m) =>
SQLGenCtx
-> SourceConfig b
-> TableName b
-> [ColumnInfo b]
-> TriggerName
-> TriggerOnReplication
-> TriggerOpsDef b
-> Maybe (PrimaryKey b (ColumnInfo b))
-> m (Either QErr ())
createTableEventTrigger
                              @b
                              (CacheDynamicConfig -> SQLGenCtx
_cdcSQLGenCtx CacheDynamicConfig
dynamicConfig)
                              SourceConfig b
sourceConfig
                              TableName b
table
                              [ColumnInfo b]
tableColumns
                              TriggerName
triggerName
                              TriggerOnReplication
triggerOnReplication
                              (EventTriggerConf b -> TriggerOpsDef b
forall (b :: BackendType). EventTriggerConf b -> TriggerOpsDef b
etcDefinition EventTriggerConf b
eventTriggerConf)
                              (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
-> Maybe (PrimaryKey b (ColumnInfo b))
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> Maybe (PrimaryKey b primaryKeyColumn)
_tciPrimaryKey TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
tableInfo)
                      if Bool
isCatalogUpdate Bool -> Bool -> Bool
|| RecreateEventTriggers
migrationRecreateEventTriggers RecreateEventTriggers -> RecreateEventTriggers -> Bool
forall a. Eq a => a -> a -> Bool
== RecreateEventTriggers
RETRecreate
                        then do
                          ErrorA
  QErr
  arr
  (CacheDynamicConfig, TableName b, [ColumnInfo b], TriggerName,
   TriggerOnReplication, TriggerOpsDef b, SourceConfig b,
   Maybe (PrimaryKey b (ColumnInfo b)))
  ()
recreateTriggerIfNeeded
                            -<
                              ( CacheDynamicConfig
dynamicConfig,
                                TableName b
table,
                                [ColumnInfo b]
tableColumns,
                                TriggerName
triggerName,
                                TriggerOnReplication
triggerOnReplication,
                                EventTriggerConf b -> TriggerOpsDef b
forall (b :: BackendType). EventTriggerConf b -> TriggerOpsDef b
etcDefinition EventTriggerConf b
eventTriggerConf,
                                SourceConfig b
sourceConfig,
                                (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
-> Maybe (PrimaryKey b (ColumnInfo b))
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> Maybe (PrimaryKey b primaryKeyColumn)
_tciPrimaryKey TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
tableInfo)
                              )
                          -- We check if the SQL triggers for the event triggers
                          -- are present. If any SQL triggers are missing, those are
                          -- created.
                          ErrorA QErr arr (ExceptT QErr m ()) ()
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr) =>
arr (ExceptT e m a) a
bindErrorA
                            -<
                              SQLGenCtx
-> SourceConfig b
-> TableName b
-> ([ColumnInfo b], Maybe (PrimaryKey b (ColumnInfo b)))
-> TriggerName
-> TriggerOnReplication
-> TriggerOpsDef b
-> ExceptT QErr m ()
forall (b :: BackendType) (m :: * -> *).
(BackendEventTrigger b, MonadIO m, MonadError QErr m,
 MonadBaseControl IO m, Backend b) =>
SQLGenCtx
-> SourceConfig b
-> TableName b
-> ([ColumnInfo b], Maybe (PrimaryKey b (ColumnInfo b)))
-> TriggerName
-> TriggerOnReplication
-> TriggerOpsDef b
-> m ()
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadBaseControl IO m, Backend b) =>
SQLGenCtx
-> SourceConfig b
-> TableName b
-> ([ColumnInfo b], Maybe (PrimaryKey b (ColumnInfo b)))
-> TriggerName
-> TriggerOnReplication
-> TriggerOpsDef b
-> m ()
createMissingSQLTriggers
                                (CacheDynamicConfig -> SQLGenCtx
_cdcSQLGenCtx CacheDynamicConfig
dynamicConfig)
                                SourceConfig b
sourceConfig
                                TableName b
table
                                ([ColumnInfo b]
tableColumns, TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
-> Maybe (PrimaryKey b (ColumnInfo b))
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> Maybe (PrimaryKey b primaryKeyColumn)
_tciPrimaryKey TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
tableInfo)
                                TriggerName
triggerName
                                TriggerOnReplication
triggerOnReplication
                                (EventTriggerConf b -> TriggerOpsDef b
forall (b :: BackendType). EventTriggerConf b -> TriggerOpsDef b
etcDefinition EventTriggerConf b
eventTriggerConf)
                        else ErrorA QErr arr () ()
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< ()
                    else ErrorA QErr arr () ()
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< ()
                  ErrorA
  QErr arr (MetadataObject, SchemaObjId, Seq SchemaDependency) ()
forall (arr :: * -> * -> *).
ArrowWriter (Seq CollectItem) arr =>
arr (MetadataObject, SchemaObjId, Seq SchemaDependency) ()
recordDependencies -< (MetadataObject
metadataObject, SchemaObjId
schemaObjectId, Seq SchemaDependency
dependencies)
                  ErrorA QErr arr (EventTriggerInfo b) (EventTriggerInfo b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< EventTriggerInfo b
info
              )
            |)
            MetadataObject
metadataObject

        recreateTriggerIfNeeded :: ErrorA
  QErr
  arr
  (CacheDynamicConfig, TableName b, [ColumnInfo b], TriggerName,
   TriggerOnReplication, TriggerOpsDef b, SourceConfig b,
   Maybe (PrimaryKey b (ColumnInfo b)))
  ()
recreateTriggerIfNeeded =
          -- using `Inc.cache` here means that the response will be cached for the given output and the
          -- next time this arrow recieves the same input, the cached response will be returned and the
          -- computation will not be done again.
          ErrorA
  QErr
  arr
  (CacheDynamicConfig, TableName b, [ColumnInfo b], TriggerName,
   TriggerOnReplication, TriggerOpsDef b, SourceConfig b,
   Maybe (PrimaryKey b (ColumnInfo b)))
  ()
-> ErrorA
     QErr
     arr
     (CacheDynamicConfig, TableName b, [ColumnInfo b], TriggerName,
      TriggerOnReplication, TriggerOpsDef b, SourceConfig b,
      Maybe (PrimaryKey b (ColumnInfo b)))
     ()
forall a b.
(Given Accesses => Eq a) =>
ErrorA QErr arr a b -> ErrorA QErr arr a b
forall (m :: * -> *) (arr :: * -> * -> *) a b.
(ArrowCache m arr, Given Accesses => Eq a) =>
arr a b -> arr a b
Inc.cache
            proc
              ( CacheDynamicConfig
dynamicConfig,
                TableName b
tableName,
                [ColumnInfo b]
tableColumns,
                TriggerName
triggerName,
                TriggerOnReplication
triggerOnReplication,
                TriggerOpsDef b
triggerDefinition,
                SourceConfig b
sourceConfig,
                Maybe (PrimaryKey b (ColumnInfo b))
primaryKey
                )
            -> do
              ErrorA QErr arr (ExceptT QErr m ()) ()
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr) =>
arr (ExceptT e m a) a
bindErrorA
                -< do
                  ExceptT QErr m (Either QErr ()) -> ExceptT QErr m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM
                    (ExceptT QErr m (Either QErr ()) -> ExceptT QErr m ())
-> ExceptT QErr m (Either QErr ()) -> ExceptT QErr m ()
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) (m :: * -> *).
(BackendEventTrigger b, MonadBaseControl IO m, MonadIO m,
 MonadError QErr m) =>
SQLGenCtx
-> SourceConfig b
-> TableName b
-> [ColumnInfo b]
-> TriggerName
-> TriggerOnReplication
-> TriggerOpsDef b
-> Maybe (PrimaryKey b (ColumnInfo b))
-> m (Either QErr ())
createTableEventTrigger @b
                      (CacheDynamicConfig -> SQLGenCtx
_cdcSQLGenCtx CacheDynamicConfig
dynamicConfig)
                      SourceConfig b
sourceConfig
                      TableName b
tableName
                      [ColumnInfo b]
tableColumns
                      TriggerName
triggerName
                      TriggerOnReplication
triggerOnReplication
                      TriggerOpsDef b
triggerDefinition
                      Maybe (PrimaryKey b (ColumnInfo b))
primaryKey

    buildCronTriggers ::
      (MonadWriter (Seq CollectItem) m) =>
      [CronTriggerMetadata] ->
      m (HashMap TriggerName CronTriggerInfo)
    buildCronTriggers :: forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
[CronTriggerMetadata] -> m (HashMap TriggerName CronTriggerInfo)
buildCronTriggers = (CronTriggerMetadata -> TriggerName)
-> (CronTriggerMetadata -> MetadataObject)
-> (CronTriggerMetadata -> m (Maybe CronTriggerInfo))
-> [CronTriggerMetadata]
-> m (HashMap TriggerName CronTriggerInfo)
forall (m :: * -> *) k a b.
(MonadWriter (Seq CollectItem) m, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> (a -> m (Maybe b))
-> [a]
-> m (HashMap k b)
buildInfoMapM CronTriggerMetadata -> TriggerName
ctName CronTriggerMetadata -> MetadataObject
mkCronTriggerMetadataObject CronTriggerMetadata -> m (Maybe CronTriggerInfo)
buildCronTrigger
      where
        buildCronTrigger :: CronTriggerMetadata -> m (Maybe CronTriggerInfo)
buildCronTrigger CronTriggerMetadata
cronTrigger = do
          let triggerName :: Text
triggerName = TriggerName -> Text
triggerNameToTxt (TriggerName -> Text) -> TriggerName -> Text
forall a b. (a -> b) -> a -> b
$ CronTriggerMetadata -> TriggerName
ctName CronTriggerMetadata
cronTrigger
              addCronTriggerContext :: Text -> Text
addCronTriggerContext Text
e = Text
"in cron trigger " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
triggerName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
          MetadataObject
-> ExceptT QErr m CronTriggerInfo -> m (Maybe CronTriggerInfo)
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM (CronTriggerMetadata -> MetadataObject
mkCronTriggerMetadataObject CronTriggerMetadata
cronTrigger)
            (ExceptT QErr m CronTriggerInfo -> m (Maybe CronTriggerInfo))
-> ExceptT QErr m CronTriggerInfo -> m (Maybe CronTriggerInfo)
forall a b. (a -> b) -> a -> b
$ (Text -> Text)
-> ExceptT QErr m CronTriggerInfo -> ExceptT QErr m CronTriggerInfo
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr Text -> Text
addCronTriggerContext
            (ExceptT QErr m CronTriggerInfo -> ExceptT QErr m CronTriggerInfo)
-> ExceptT QErr m CronTriggerInfo -> ExceptT QErr m CronTriggerInfo
forall a b. (a -> b) -> a -> b
$ Environment
-> CronTriggerMetadata -> ExceptT QErr m CronTriggerInfo
forall (m :: * -> *).
QErrM m =>
Environment -> CronTriggerMetadata -> m CronTriggerInfo
resolveCronTrigger Environment
env CronTriggerMetadata
cronTrigger

    buildInheritedRoles ::
      (MonadWriter (Seq CollectItem) m) =>
      HashSet RoleName ->
      [InheritedRole] ->
      m (HashMap RoleName Role)
    buildInheritedRoles :: forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
HashSet RoleName -> [Role] -> m (HashMap RoleName Role)
buildInheritedRoles HashSet RoleName
allRoles = (Role -> RoleName)
-> (Role -> MetadataObject)
-> (Role -> m (Maybe Role))
-> [Role]
-> m (HashMap RoleName Role)
forall (m :: * -> *) k a b.
(MonadWriter (Seq CollectItem) m, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> (a -> m (Maybe b))
-> [a]
-> m (HashMap k b)
buildInfoMapM Role -> RoleName
_rRoleName Role -> MetadataObject
mkInheritedRoleMetadataObject Role -> m (Maybe Role)
buildInheritedRole
      where
        buildInheritedRole :: Role -> m (Maybe Role)
buildInheritedRole Role
inheritedRole = do
          let addInheritedRoleContext :: Text -> Text
addInheritedRoleContext Text
e = Text
"in inherited role " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName -> Text
roleNameToTxt (Role -> RoleName
_rRoleName Role
inheritedRole) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
              metadataObject :: MetadataObject
metadataObject = Role -> MetadataObject
mkInheritedRoleMetadataObject Role
inheritedRole
              schemaObject :: SchemaObjId
schemaObject = RoleName -> SchemaObjId
SORole (RoleName -> SchemaObjId) -> RoleName -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ Role -> RoleName
_rRoleName Role
inheritedRole
          MetadataObject -> ExceptT QErr m Role -> m (Maybe Role)
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM MetadataObject
metadataObject (ExceptT QErr m Role -> m (Maybe Role))
-> ExceptT QErr m Role -> m (Maybe Role)
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> ExceptT QErr m Role -> ExceptT QErr m Role
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr Text -> Text
addInheritedRoleContext do
            (Role
resolvedInheritedRole, Seq SchemaDependency
dependencies) <- HashSet RoleName
-> Role -> ExceptT QErr m (Role, Seq SchemaDependency)
forall (m :: * -> *).
MonadError QErr m =>
HashSet RoleName -> Role -> m (Role, Seq SchemaDependency)
resolveInheritedRole HashSet RoleName
allRoles Role
inheritedRole
            MetadataObject
-> SchemaObjId -> Seq SchemaDependency -> ExceptT QErr m ()
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
MetadataObject -> SchemaObjId -> Seq SchemaDependency -> m ()
recordDependenciesM MetadataObject
metadataObject SchemaObjId
schemaObject Seq SchemaDependency
dependencies
            Role -> ExceptT QErr m Role
forall a. a -> ExceptT QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
resolvedInheritedRole

    buildActions ::
      (MonadWriter (Seq CollectItem) m) =>
      AnnotatedCustomTypes ->
      BackendMap ScalarParsingMap ->
      OrderedRoles ->
      [ActionMetadata] ->
      m (HashMap ActionName ActionInfo)
    buildActions :: forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
AnnotatedCustomTypes
-> BackendMap ScalarParsingMap
-> OrderedRoles
-> [ActionMetadata]
-> m ActionCache
buildActions AnnotatedCustomTypes
resolvedCustomTypes BackendMap ScalarParsingMap
scalarsMap OrderedRoles
orderedRoles = (ActionMetadata -> ActionName)
-> (ActionMetadata -> MetadataObject)
-> (ActionMetadata -> m (Maybe ActionInfo))
-> [ActionMetadata]
-> m ActionCache
forall (m :: * -> *) k a b.
(MonadWriter (Seq CollectItem) m, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> (a -> m (Maybe b))
-> [a]
-> m (HashMap k b)
buildInfoMapM ActionMetadata -> ActionName
_amName ActionMetadata -> MetadataObject
mkActionMetadataObject ActionMetadata -> m (Maybe ActionInfo)
buildAction
      where
        buildAction :: ActionMetadata -> m (Maybe ActionInfo)
buildAction action :: ActionMetadata
action@(ActionMetadata ActionName
name Maybe Text
comment ActionDefinitionInput
def [ActionPermissionMetadata]
actionPermissions) = do
          let addActionContext :: Text -> Text
addActionContext Text
e = Text
"in action " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ActionName
name ActionName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
"; " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
              permissionInfos :: [ActionPermissionInfo]
permissionInfos = (ActionPermissionMetadata -> ActionPermissionInfo)
-> [ActionPermissionMetadata] -> [ActionPermissionInfo]
forall a b. (a -> b) -> [a] -> [b]
map (RoleName -> ActionPermissionInfo
ActionPermissionInfo (RoleName -> ActionPermissionInfo)
-> (ActionPermissionMetadata -> RoleName)
-> ActionPermissionMetadata
-> ActionPermissionInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionPermissionMetadata -> RoleName
_apmRole) [ActionPermissionMetadata]
actionPermissions
              metadataPermissionMap :: HashMap RoleName ActionPermissionInfo
metadataPermissionMap = (ActionPermissionInfo -> RoleName)
-> [ActionPermissionInfo] -> HashMap RoleName ActionPermissionInfo
forall k a. Hashable k => (a -> k) -> [a] -> HashMap k a
mapFromL ActionPermissionInfo -> RoleName
_apiRole [ActionPermissionInfo]
permissionInfos
              permissionsMap :: HashMap RoleName ActionPermissionInfo
permissionsMap = (RoleName -> ActionPermissionInfo)
-> HashMap RoleName ActionPermissionInfo
-> OrderedRoles
-> HashMap RoleName ActionPermissionInfo
forall a.
(RoleName -> a)
-> HashMap RoleName a -> OrderedRoles -> HashMap RoleName a
mkBooleanPermissionMap RoleName -> ActionPermissionInfo
ActionPermissionInfo HashMap RoleName ActionPermissionInfo
metadataPermissionMap OrderedRoles
orderedRoles
              outputType :: GType
outputType = GraphQLType -> GType
unGraphQLType (GraphQLType -> GType) -> GraphQLType -> GType
forall a b. (a -> b) -> a -> b
$ ActionDefinitionInput -> GraphQLType
forall arg webhook. ActionDefinition arg webhook -> GraphQLType
_adOutputType ActionDefinitionInput
def
          MetadataObject -> ExceptT QErr m ActionInfo -> m (Maybe ActionInfo)
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM (ActionMetadata -> MetadataObject
mkActionMetadataObject ActionMetadata
action) (ExceptT QErr m ActionInfo -> m (Maybe ActionInfo))
-> ExceptT QErr m ActionInfo -> m (Maybe ActionInfo)
forall a b. (a -> b) -> a -> b
$ (Text -> Text)
-> ExceptT QErr m ActionInfo -> ExceptT QErr m ActionInfo
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr Text -> Text
addActionContext do
            (ResolvedActionDefinition
resolvedDef, AnnotatedOutputType
outObject) <- Environment
-> AnnotatedCustomTypes
-> ActionDefinitionInput
-> BackendMap ScalarParsingMap
-> ExceptT QErr m (ResolvedActionDefinition, AnnotatedOutputType)
forall (m :: * -> *).
QErrM m =>
Environment
-> AnnotatedCustomTypes
-> ActionDefinitionInput
-> BackendMap ScalarParsingMap
-> m (ResolvedActionDefinition, AnnotatedOutputType)
resolveAction Environment
env AnnotatedCustomTypes
resolvedCustomTypes ActionDefinitionInput
def BackendMap ScalarParsingMap
scalarsMap
            let forwardClientHeaders :: Bool
forwardClientHeaders = ResolvedActionDefinition -> Bool
forall arg webhook. ActionDefinition arg webhook -> Bool
_adForwardClientHeaders ResolvedActionDefinition
resolvedDef
            ActionInfo -> ExceptT QErr m ActionInfo
forall a. a -> ExceptT QErr m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ActionInfo -> ExceptT QErr m ActionInfo)
-> ActionInfo -> ExceptT QErr m ActionInfo
forall a b. (a -> b) -> a -> b
$ ActionName
-> (GType, AnnotatedOutputType)
-> ResolvedActionDefinition
-> HashMap RoleName ActionPermissionInfo
-> Bool
-> Maybe Text
-> ActionInfo
ActionInfo ActionName
name (GType
outputType, AnnotatedOutputType
outObject) ResolvedActionDefinition
resolvedDef HashMap RoleName ActionPermissionInfo
permissionsMap Bool
forwardClientHeaders Maybe Text
comment

buildRemoteSchemaRemoteRelationship ::
  (MonadWriter (Seq CollectItem) m) =>
  HashMap SourceName (AB.AnyBackend PartiallyResolvedSource) ->
  PartiallyResolvedRemoteSchemaMap ->
  RemoteSchemaName ->
  RemoteSchemaIntrospection ->
  G.Name ->
  RemoteRelationship ->
  m (Maybe (RemoteFieldInfo G.Name))
buildRemoteSchemaRemoteRelationship :: forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> PartiallyResolvedRemoteSchemaMap
-> RemoteSchemaName
-> RemoteSchemaIntrospection
-> Name
-> RemoteRelationshipG RemoteRelationshipDefinition
-> m (Maybe (RemoteFieldInfo Name))
buildRemoteSchemaRemoteRelationship HashMap SourceName (AnyBackend PartiallyResolvedSource)
allSources PartiallyResolvedRemoteSchemaMap
remoteSchemaMap RemoteSchemaName
remoteSchema RemoteSchemaIntrospection
remoteSchemaIntrospection Name
typeName rr :: RemoteRelationshipG RemoteRelationshipDefinition
rr@RemoteRelationship {RelName
RemoteRelationshipDefinition
_rrName :: RelName
_rrDefinition :: RemoteRelationshipDefinition
_rrName :: forall definition. RemoteRelationshipG definition -> RelName
_rrDefinition :: forall definition. RemoteRelationshipG definition -> definition
..} = do
  let metadataObject :: MetadataObject
metadataObject =
        MetadataObjId -> Value -> MetadataObject
MetadataObject (RemoteSchemaName -> Name -> RelName -> MetadataObjId
MORemoteSchemaRemoteRelationship RemoteSchemaName
remoteSchema Name
typeName RelName
_rrName)
          (Value -> MetadataObject) -> Value -> MetadataObject
forall a b. (a -> b) -> a -> b
$ CreateRemoteSchemaRemoteRelationship -> Value
forall a. ToJSON a => a -> Value
toJSON
          (CreateRemoteSchemaRemoteRelationship -> Value)
-> CreateRemoteSchemaRemoteRelationship -> Value
forall a b. (a -> b) -> a -> b
$ RemoteSchemaName
-> Name
-> RelName
-> RemoteRelationshipDefinition
-> CreateRemoteSchemaRemoteRelationship
CreateRemoteSchemaRemoteRelationship RemoteSchemaName
remoteSchema Name
typeName RelName
_rrName RemoteRelationshipDefinition
_rrDefinition
      schemaObj :: SchemaObjId
schemaObj = RemoteSchemaName -> Name -> RelName -> SchemaObjId
SORemoteSchemaRemoteRelationship RemoteSchemaName
remoteSchema Name
typeName RelName
_rrName
      addRemoteRelationshipContext :: Text -> Text
addRemoteRelationshipContext Text
e = Text
"in remote relationship " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName
_rrName RelName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
      -- buildRemoteFieldInfo only knows how to construct dependencies on the RHS of the join condition,
      -- so the dependencies on the remote relationship on the LHS entity have to be computed here
      lhsDependency :: SchemaDependency
lhsDependency =
        -- a direct dependency on the remote schema on which this is defined
        SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency (RemoteSchemaName -> SchemaObjId
SORemoteSchema RemoteSchemaName
remoteSchema) DependencyReason
DRRemoteRelationship
  MetadataObject
-> ExceptT QErr m (RemoteFieldInfo Name)
-> m (Maybe (RemoteFieldInfo Name))
forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM MetadataObject
metadataObject (ExceptT QErr m (RemoteFieldInfo Name)
 -> m (Maybe (RemoteFieldInfo Name)))
-> ExceptT QErr m (RemoteFieldInfo Name)
-> m (Maybe (RemoteFieldInfo Name))
forall a b. (a -> b) -> a -> b
$ (Text -> Text)
-> ExceptT QErr m (RemoteFieldInfo Name)
-> ExceptT QErr m (RemoteFieldInfo Name)
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr Text -> Text
addRemoteRelationshipContext do
    HashMap FieldName Name
allowedLHSJoinFields <- RemoteSchemaName
-> RemoteSchemaIntrospection
-> Name
-> ExceptT QErr m (HashMap FieldName Name)
forall (m :: * -> *).
MonadError QErr m =>
RemoteSchemaName
-> RemoteSchemaIntrospection -> Name -> m (HashMap FieldName Name)
getRemoteSchemaEntityJoinColumns RemoteSchemaName
remoteSchema RemoteSchemaIntrospection
remoteSchemaIntrospection Name
typeName
    (RemoteFieldInfo Name
remoteField, Seq SchemaDependency
rhsDependencies) <-
      LHSIdentifier
-> HashMap FieldName Name
-> RemoteRelationshipG RemoteRelationshipDefinition
-> HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> PartiallyResolvedRemoteSchemaMap
-> ExceptT QErr m (RemoteFieldInfo Name, Seq SchemaDependency)
forall (m :: * -> *) lhsJoinField.
QErrM m =>
LHSIdentifier
-> HashMap FieldName lhsJoinField
-> RemoteRelationshipG RemoteRelationshipDefinition
-> HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> PartiallyResolvedRemoteSchemaMap
-> m (RemoteFieldInfo lhsJoinField, Seq SchemaDependency)
buildRemoteFieldInfo (RemoteSchemaName -> LHSIdentifier
remoteSchemaToLHSIdentifier RemoteSchemaName
remoteSchema) HashMap FieldName Name
allowedLHSJoinFields RemoteRelationshipG RemoteRelationshipDefinition
rr HashMap SourceName (AnyBackend PartiallyResolvedSource)
allSources PartiallyResolvedRemoteSchemaMap
remoteSchemaMap
    MetadataObject
-> SchemaObjId -> Seq SchemaDependency -> ExceptT QErr m ()
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
MetadataObject -> SchemaObjId -> Seq SchemaDependency -> m ()
recordDependenciesM MetadataObject
metadataObject SchemaObjId
schemaObj (SchemaDependency
lhsDependency SchemaDependency -> Seq SchemaDependency -> Seq SchemaDependency
forall a. a -> Seq a -> Seq a
Seq.:<| Seq SchemaDependency
rhsDependencies)
    RemoteFieldInfo Name -> ExceptT QErr m (RemoteFieldInfo Name)
forall a. a -> ExceptT QErr m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RemoteFieldInfo Name
remoteField

data BackendInfoAndSourceMetadata b = BackendInfoAndSourceMetadata
  { forall (b :: BackendType).
BackendInfoAndSourceMetadata b -> BackendInfo b
_bcasmBackendInfo :: BackendInfo b,
    forall (b :: BackendType).
BackendInfoAndSourceMetadata b -> SourceMetadata b
_bcasmSourceMetadata :: SourceMetadata b
  }
  deriving stock ((forall x.
 BackendInfoAndSourceMetadata b
 -> Rep (BackendInfoAndSourceMetadata b) x)
-> (forall x.
    Rep (BackendInfoAndSourceMetadata b) x
    -> BackendInfoAndSourceMetadata b)
-> Generic (BackendInfoAndSourceMetadata b)
forall x.
Rep (BackendInfoAndSourceMetadata b) x
-> BackendInfoAndSourceMetadata b
forall x.
BackendInfoAndSourceMetadata b
-> Rep (BackendInfoAndSourceMetadata b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (BackendInfoAndSourceMetadata b) x
-> BackendInfoAndSourceMetadata b
forall (b :: BackendType) x.
BackendInfoAndSourceMetadata b
-> Rep (BackendInfoAndSourceMetadata b) x
$cfrom :: forall (b :: BackendType) x.
BackendInfoAndSourceMetadata b
-> Rep (BackendInfoAndSourceMetadata b) x
from :: forall x.
BackendInfoAndSourceMetadata b
-> Rep (BackendInfoAndSourceMetadata b) x
$cto :: forall (b :: BackendType) x.
Rep (BackendInfoAndSourceMetadata b) x
-> BackendInfoAndSourceMetadata b
to :: forall x.
Rep (BackendInfoAndSourceMetadata b) x
-> BackendInfoAndSourceMetadata b
Generic)

deriving instance (Backend b) => Show (BackendInfoAndSourceMetadata b)

deriving instance (Backend b) => Eq (BackendInfoAndSourceMetadata b)

joinBackendInfosToSources ::
  BackendCache ->
  InsOrdHashMap SourceName BackendSourceMetadata ->
  InsOrdHashMap SourceName (AB.AnyBackend BackendInfoAndSourceMetadata)
joinBackendInfosToSources :: BackendCache
-> InsOrdHashMap SourceName BackendSourceMetadata
-> InsOrdHashMap
     SourceName (AnyBackend BackendInfoAndSourceMetadata)
joinBackendInfosToSources BackendCache
backendInfos InsOrdHashMap SourceName BackendSourceMetadata
sources =
  ((BackendSourceMetadata -> AnyBackend BackendInfoAndSourceMetadata)
 -> InsOrdHashMap SourceName BackendSourceMetadata
 -> InsOrdHashMap
      SourceName (AnyBackend BackendInfoAndSourceMetadata))
-> InsOrdHashMap SourceName BackendSourceMetadata
-> (BackendSourceMetadata
    -> AnyBackend BackendInfoAndSourceMetadata)
-> InsOrdHashMap
     SourceName (AnyBackend BackendInfoAndSourceMetadata)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (BackendSourceMetadata -> AnyBackend BackendInfoAndSourceMetadata)
-> InsOrdHashMap SourceName BackendSourceMetadata
-> InsOrdHashMap
     SourceName (AnyBackend BackendInfoAndSourceMetadata)
forall v1 v2 k.
(v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
InsOrdHashMap.map InsOrdHashMap SourceName BackendSourceMetadata
sources ((BackendSourceMetadata -> AnyBackend BackendInfoAndSourceMetadata)
 -> InsOrdHashMap
      SourceName (AnyBackend BackendInfoAndSourceMetadata))
-> (BackendSourceMetadata
    -> AnyBackend BackendInfoAndSourceMetadata)
-> InsOrdHashMap
     SourceName (AnyBackend BackendInfoAndSourceMetadata)
forall a b. (a -> b) -> a -> b
$ \BackendSourceMetadata
abSourceMetadata ->
    forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend (BackendSourceMetadata -> AnyBackend SourceMetadata
unBackendSourceMetadata BackendSourceMetadata
abSourceMetadata) ((forall (b :: BackendType).
  Backend b =>
  SourceMetadata b -> AnyBackend BackendInfoAndSourceMetadata)
 -> AnyBackend BackendInfoAndSourceMetadata)
-> (forall (b :: BackendType).
    Backend b =>
    SourceMetadata b -> AnyBackend BackendInfoAndSourceMetadata)
-> AnyBackend BackendInfoAndSourceMetadata
forall a b. (a -> b) -> a -> b
$ \(SourceMetadata b
sourceMetadata :: SourceMetadata b) ->
      let _bcasmBackendInfo :: BackendInfo b
_bcasmBackendInfo = BackendInfo b
-> (BackendInfoWrapper b -> BackendInfo b)
-> Maybe (BackendInfoWrapper b)
-> BackendInfo b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BackendInfo b
forall a. Monoid a => a
mempty BackendInfoWrapper b -> BackendInfo b
forall (b :: BackendType). BackendInfoWrapper b -> BackendInfo b
unBackendInfoWrapper (forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
BackendMap i -> Maybe (i b)
BackendMap.lookup @b BackendCache
backendInfos)
          _bcasmSourceMetadata :: SourceMetadata b
_bcasmSourceMetadata = SourceMetadata b
sourceMetadata
       in forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend @b BackendInfoAndSourceMetadata {BackendInfo b
SourceMetadata b
_bcasmBackendInfo :: BackendInfo b
_bcasmSourceMetadata :: SourceMetadata b
_bcasmBackendInfo :: BackendInfo b
_bcasmSourceMetadata :: SourceMetadata b
..}

{- Note [Keep invalidation keys for inconsistent objects]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
After building the schema cache, we prune InvalidationKeys for objects
that no longer exist in the schema to avoid leaking memory for objects
that have been dropped. However, note that we *don’t* want to drop
keys for objects that are simply inconsistent!

Why? The object is still in the metadata, so next time we reload it,
we’ll reprocess that object. We want to reuse the cache if its
definition hasn’t changed, but if we dropped the invalidation key, it
will incorrectly be reprocessed (since the invalidation key changed
from present to absent). -}