{-# LANGUAGE Arrows #-}
{-# 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,
    buildRebuildableSchemaCacheWithReason,
    CacheRWT,
    runCacheRWT,
    mkBooleanPermissionMap,
  )
where

import Control.Arrow.Extended
import Control.Arrow.Interpret
import Control.Concurrent.Extended (forConcurrentlyEIO)
import Control.Lens hiding ((.=))
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Retry qualified as Retry
import Data.Aeson
import Data.Align (align)
import Data.Either (isLeft)
import Data.Environment qualified as Env
import Data.HashMap.Strict.Extended qualified as M
import Data.HashMap.Strict.InsOrd.Extended qualified as OMap
import Data.HashSet qualified as HS
import Data.Proxy
import Data.Set qualified as S
import Data.Text.Extended
import Data.These (These (..))
import Hasura.Base.Error
import Hasura.GraphQL.Execute.Types
import Hasura.GraphQL.Schema (buildGQLContext)
import Hasura.GraphQL.Schema.NamingCase
import Hasura.Incremental qualified as Inc
import Hasura.Logging
import Hasura.Metadata.Class
import Hasura.Prelude
import Hasura.RQL.DDL.Action
import Hasura.RQL.DDL.CustomTypes
import Hasura.RQL.DDL.EventTrigger (buildEventTriggerInfo)
import Hasura.RQL.DDL.InheritedRoles (resolveInheritedRole)
import Hasura.RQL.DDL.RemoteRelationship (CreateRemoteSchemaRemoteRelationship (..), PartiallyResolvedSource (..), buildRemoteFieldInfo, getRemoteSchemaEntityJoinColumns)
import Hasura.RQL.DDL.RemoteSchema
import Hasura.RQL.DDL.RemoteSchema.Permission (resolveRoleBasedRemoteSchema)
import Hasura.RQL.DDL.ScheduledTrigger
import Hasura.RQL.DDL.Schema.Cache.Common
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.Schema.Function
import Hasura.RQL.DDL.Schema.Table
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.Allowlist
import Hasura.RQL.Types.Backend
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.Eventing.Backend
import Hasura.RQL.Types.Function
import Hasura.RQL.Types.Metadata hiding (fmFunction, tmTable)
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.Network
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.Relationships.Remote
import Hasura.RQL.Types.Relationships.ToSchema
import Hasura.RQL.Types.RemoteSchema
import Hasura.RQL.Types.Roles
import Hasura.RQL.Types.Roles.Internal (CheckPermission (..))
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.RQL.Types.Table
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.Backend
import Hasura.SQL.BackendMap (BackendMap)
import Hasura.SQL.BackendMap qualified as BackendMap
import Hasura.Server.Types
import Hasura.Session
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Syntax qualified as G
import Network.HTTP.Client.Manager (HasHttpManagerM (..))

{- 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 ->
  Metadata ->
  CacheBuild RebuildableSchemaCache
buildRebuildableSchemaCache :: Logger Hasura
-> Environment -> Metadata -> CacheBuild RebuildableSchemaCache
buildRebuildableSchemaCache =
  BuildReason
-> Logger Hasura
-> Environment
-> Metadata
-> CacheBuild RebuildableSchemaCache
buildRebuildableSchemaCacheWithReason BuildReason
CatalogSync

buildRebuildableSchemaCacheWithReason ::
  BuildReason ->
  Logger Hasura ->
  Env.Environment ->
  Metadata ->
  CacheBuild RebuildableSchemaCache
buildRebuildableSchemaCacheWithReason :: BuildReason
-> Logger Hasura
-> Environment
-> Metadata
-> CacheBuild RebuildableSchemaCache
buildRebuildableSchemaCacheWithReason BuildReason
reason Logger Hasura
logger Environment
env Metadata
metadata = do
  Result
  (ReaderT BuildReason CacheBuild)
  (Metadata, InvalidationKeys)
  SchemaCache
result <-
    (ReaderT
   BuildReason
   CacheBuild
   (Result
      (ReaderT BuildReason CacheBuild)
      (Metadata, InvalidationKeys)
      SchemaCache)
 -> BuildReason
 -> CacheBuild
      (Result
         (ReaderT BuildReason CacheBuild)
         (Metadata, InvalidationKeys)
         SchemaCache))
-> BuildReason
-> ReaderT
     BuildReason
     CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
-> CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  BuildReason
  CacheBuild
  (Result
     (ReaderT BuildReason CacheBuild)
     (Metadata, InvalidationKeys)
     SchemaCache)
-> BuildReason
-> CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT BuildReason
reason (ReaderT
   BuildReason
   CacheBuild
   (Result
      (ReaderT BuildReason CacheBuild)
      (Metadata, InvalidationKeys)
      SchemaCache)
 -> CacheBuild
      (Result
         (ReaderT BuildReason CacheBuild)
         (Metadata, InvalidationKeys)
         SchemaCache))
-> ReaderT
     BuildReason
     CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
-> CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
forall a b. (a -> b) -> a -> b
$
      Rule
  (ReaderT BuildReason CacheBuild)
  (Metadata, InvalidationKeys)
  SchemaCache
-> (Metadata, InvalidationKeys)
-> ReaderT
     BuildReason
     CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
forall (m :: * -> *) a b.
Applicative m =>
Rule m a b -> a -> m (Result m a b)
Inc.build (Logger Hasura
-> Environment
-> Rule
     (ReaderT BuildReason CacheBuild)
     (Metadata, InvalidationKeys)
     SchemaCache
forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowDistribute arr, ArrowCache m arr, MonadIO m,
 MonadBaseControl IO m, MonadError QErr m,
 MonadReader BuildReason m, HasHttpManagerM m, MonadResolveSource m,
 HasServerConfigCtx m) =>
Logger Hasura
-> Environment -> arr (Metadata, InvalidationKeys) SchemaCache
buildSchemaCacheRule Logger Hasura
logger Environment
env) (Metadata
metadata, InvalidationKeys
initialInvalidationKeys)

  RebuildableSchemaCache -> CacheBuild RebuildableSchemaCache
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)
     (Metadata, InvalidationKeys)
     SchemaCache
-> RebuildableSchemaCache
RebuildableSchemaCache (Result
  (ReaderT BuildReason CacheBuild)
  (Metadata, InvalidationKeys)
  SchemaCache
-> SchemaCache
forall (m :: * -> *) a b. Result m a b -> b
Inc.result Result
  (ReaderT BuildReason CacheBuild)
  (Metadata, InvalidationKeys)
  SchemaCache
result) InvalidationKeys
initialInvalidationKeys (Result
  (ReaderT BuildReason CacheBuild)
  (Metadata, InvalidationKeys)
  SchemaCache
-> Rule
     (ReaderT BuildReason CacheBuild)
     (Metadata, InvalidationKeys)
     SchemaCache
forall (m :: * -> *) a b. Result m a b -> Rule m a b
Inc.rebuildRule Result
  (ReaderT BuildReason CacheBuild)
  (Metadata, InvalidationKeys)
  SchemaCache
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.
    CacheRWT (StateT (RebuildableSchemaCache, CacheInvalidations) m a)
  deriving
    ( a -> CacheRWT m b -> CacheRWT m a
(a -> b) -> CacheRWT m a -> CacheRWT m b
(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
<$ :: a -> CacheRWT m b -> CacheRWT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> CacheRWT m b -> CacheRWT m a
fmap :: (a -> b) -> CacheRWT m a -> CacheRWT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> CacheRWT m a -> CacheRWT m b
Functor,
      Functor (CacheRWT m)
a -> CacheRWT m a
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)
CacheRWT m a -> CacheRWT m b -> CacheRWT m b
CacheRWT m a -> CacheRWT m b -> CacheRWT m a
CacheRWT m (a -> b) -> CacheRWT m a -> CacheRWT m b
(a -> b -> c) -> CacheRWT m a -> CacheRWT m b -> CacheRWT m c
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
<* :: CacheRWT m a -> CacheRWT m b -> CacheRWT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
CacheRWT m a -> CacheRWT m b -> CacheRWT m a
*> :: CacheRWT m a -> CacheRWT m b -> CacheRWT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
CacheRWT m a -> CacheRWT m b -> CacheRWT m b
liftA2 :: (a -> b -> c) -> CacheRWT m a -> CacheRWT m b -> CacheRWT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> CacheRWT m a -> CacheRWT m b -> CacheRWT m c
<*> :: CacheRWT m (a -> b) -> CacheRWT m a -> CacheRWT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
CacheRWT m (a -> b) -> CacheRWT m a -> CacheRWT m b
pure :: a -> CacheRWT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> CacheRWT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (CacheRWT m)
Applicative,
      Applicative (CacheRWT m)
a -> CacheRWT m a
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)
CacheRWT m a -> (a -> CacheRWT m b) -> CacheRWT m b
CacheRWT m a -> CacheRWT m b -> CacheRWT m b
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
return :: a -> CacheRWT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> CacheRWT m a
>> :: CacheRWT m a -> CacheRWT m b -> CacheRWT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
CacheRWT m a -> CacheRWT m b -> CacheRWT m b
>>= :: CacheRWT m a -> (a -> CacheRWT m b) -> CacheRWT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
CacheRWT m a -> (a -> CacheRWT m b) -> CacheRWT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (CacheRWT m)
Monad,
      Monad (CacheRWT m)
Monad (CacheRWT m)
-> (forall a. IO a -> CacheRWT m a) -> MonadIO (CacheRWT m)
IO a -> CacheRWT m a
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
liftIO :: IO a -> CacheRWT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> CacheRWT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (CacheRWT m)
MonadIO,
      MonadReader r,
      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
askUserInfo :: CacheRWT m UserInfo
$caskUserInfo :: forall (m :: * -> *). UserInfoM m => CacheRWT m UserInfo
$cp1UserInfoM :: forall (m :: * -> *). UserInfoM m => Monad (CacheRWT m)
UserInfoM,
      Monad (CacheRWT m)
CacheRWT m Manager
Monad (CacheRWT m)
-> CacheRWT m Manager -> HasHttpManagerM (CacheRWT m)
forall (m :: * -> *). Monad m -> m Manager -> HasHttpManagerM m
forall (m :: * -> *). HasHttpManagerM m => Monad (CacheRWT m)
forall (m :: * -> *). HasHttpManagerM m => CacheRWT m Manager
askHttpManager :: CacheRWT m Manager
$caskHttpManager :: forall (m :: * -> *). HasHttpManagerM m => CacheRWT m Manager
$cp1HasHttpManagerM :: forall (m :: * -> *). HasHttpManagerM m => Monad (CacheRWT m)
HasHttpManagerM,
      MonadError QErr (CacheRWT m)
CacheRWT m [ActionLogItem]
CacheRWT m ()
CacheRWT m ([CronEvent], [OneOffScheduledEvent])
CacheRWT m (Metadata, MetadataResourceVersion)
CacheRWT m MetadataDbId
CacheRWT m CatalogState
CacheRWT m MetadataResourceVersion
[TriggerName] -> CacheRWT m [CronTriggerStats]
[CronEventSeed] -> CacheRWT m ()
MonadError QErr (CacheRWT m)
-> CacheRWT m MetadataResourceVersion
-> CacheRWT m (Metadata, MetadataResourceVersion)
-> (MetadataResourceVersion
    -> InstanceId
    -> CacheRWT m [(MetadataResourceVersion, CacheInvalidations)])
-> (MetadataResourceVersion
    -> Metadata -> CacheRWT m MetadataResourceVersion)
-> (MetadataResourceVersion
    -> InstanceId -> CacheInvalidations -> CacheRWT m ())
-> CacheRWT m CatalogState
-> (CatalogStateType -> Value -> CacheRWT m ())
-> CacheRWT m MetadataDbId
-> CacheRWT m ()
-> ([TriggerName] -> CacheRWT m [CronTriggerStats])
-> CacheRWT m ([CronEvent], [OneOffScheduledEvent])
-> ([CronEventSeed] -> CacheRWT m ())
-> (OneOffEvent -> CacheRWT m EventId)
-> (Invocation 'ScheduledType
    -> ScheduledEventType -> CacheRWT m ())
-> (EventId
    -> ScheduledEventOp -> ScheduledEventType -> CacheRWT m ())
-> (ScheduledEventType -> [EventId] -> CacheRWT m Int)
-> CacheRWT m ()
-> (ClearCronEvents -> CacheRWT m ())
-> (ScheduledEventPagination
    -> [ScheduledEventStatus]
    -> CacheRWT m (WithTotalCount [OneOffScheduledEvent]))
-> (TriggerName
    -> ScheduledEventPagination
    -> [ScheduledEventStatus]
    -> CacheRWT m (WithTotalCount [CronEvent]))
-> (GetInvocationsBy
    -> ScheduledEventPagination
    -> CacheRWT m (WithTotalCount [ScheduledEventInvocation]))
-> (EventId -> ScheduledEventType -> CacheRWT m ())
-> (ActionName
    -> SessionVariables -> [Header] -> Value -> CacheRWT m ActionId)
-> CacheRWT m [ActionLogItem]
-> (ActionId -> AsyncActionStatus -> CacheRWT m ())
-> (ActionId -> CacheRWT m ActionLogResponse)
-> (ActionName -> CacheRWT m ())
-> (LockedActionIdArray -> CacheRWT m ())
-> MonadMetadataStorage (CacheRWT m)
EventId -> ScheduledEventType -> CacheRWT m ()
EventId -> ScheduledEventOp -> ScheduledEventType -> CacheRWT m ()
Invocation 'ScheduledType -> ScheduledEventType -> CacheRWT m ()
TriggerName
-> ScheduledEventPagination
-> [ScheduledEventStatus]
-> CacheRWT m (WithTotalCount [CronEvent])
OneOffEvent -> CacheRWT m EventId
ScheduledEventType -> [EventId] -> CacheRWT m Int
ScheduledEventPagination
-> [ScheduledEventStatus]
-> CacheRWT m (WithTotalCount [OneOffScheduledEvent])
ClearCronEvents -> CacheRWT m ()
GetInvocationsBy
-> ScheduledEventPagination
-> CacheRWT m (WithTotalCount [ScheduledEventInvocation])
LockedActionIdArray -> CacheRWT m ()
ActionId -> CacheRWT m ActionLogResponse
ActionId -> AsyncActionStatus -> CacheRWT m ()
ActionName -> CacheRWT m ()
ActionName
-> SessionVariables -> [Header] -> Value -> CacheRWT m ActionId
CatalogStateType -> Value -> CacheRWT m ()
MetadataResourceVersion
-> InstanceId
-> CacheRWT m [(MetadataResourceVersion, CacheInvalidations)]
MetadataResourceVersion
-> InstanceId -> CacheInvalidations -> CacheRWT m ()
MetadataResourceVersion
-> Metadata -> CacheRWT m MetadataResourceVersion
forall (m :: * -> *).
MonadError QErr m
-> m MetadataResourceVersion
-> m (Metadata, MetadataResourceVersion)
-> (MetadataResourceVersion
    -> InstanceId -> m [(MetadataResourceVersion, CacheInvalidations)])
-> (MetadataResourceVersion
    -> Metadata -> m MetadataResourceVersion)
-> (MetadataResourceVersion
    -> InstanceId -> CacheInvalidations -> m ())
-> m CatalogState
-> (CatalogStateType -> Value -> m ())
-> m MetadataDbId
-> m ()
-> ([TriggerName] -> m [CronTriggerStats])
-> m ([CronEvent], [OneOffScheduledEvent])
-> ([CronEventSeed] -> m ())
-> (OneOffEvent -> m EventId)
-> (Invocation 'ScheduledType -> ScheduledEventType -> m ())
-> (EventId -> ScheduledEventOp -> ScheduledEventType -> m ())
-> (ScheduledEventType -> [EventId] -> m Int)
-> m ()
-> (ClearCronEvents -> m ())
-> (ScheduledEventPagination
    -> [ScheduledEventStatus]
    -> m (WithTotalCount [OneOffScheduledEvent]))
-> (TriggerName
    -> ScheduledEventPagination
    -> [ScheduledEventStatus]
    -> m (WithTotalCount [CronEvent]))
-> (GetInvocationsBy
    -> ScheduledEventPagination
    -> m (WithTotalCount [ScheduledEventInvocation]))
-> (EventId -> ScheduledEventType -> m ())
-> (ActionName
    -> SessionVariables -> [Header] -> Value -> m ActionId)
-> m [ActionLogItem]
-> (ActionId -> AsyncActionStatus -> m ())
-> (ActionId -> m ActionLogResponse)
-> (ActionName -> m ())
-> (LockedActionIdArray -> m ())
-> MonadMetadataStorage m
forall (m :: * -> *).
MonadMetadataStorage m =>
MonadError QErr (CacheRWT m)
forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m [ActionLogItem]
forall (m :: * -> *). MonadMetadataStorage m => CacheRWT m ()
forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m ([CronEvent], [OneOffScheduledEvent])
forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m (Metadata, MetadataResourceVersion)
forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m MetadataDbId
forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m CatalogState
forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m MetadataResourceVersion
forall (m :: * -> *).
MonadMetadataStorage m =>
[TriggerName] -> CacheRWT m [CronTriggerStats]
forall (m :: * -> *).
MonadMetadataStorage m =>
[CronEventSeed] -> CacheRWT m ()
forall (m :: * -> *).
MonadMetadataStorage m =>
EventId -> ScheduledEventType -> CacheRWT m ()
forall (m :: * -> *).
MonadMetadataStorage m =>
EventId -> ScheduledEventOp -> ScheduledEventType -> CacheRWT m ()
forall (m :: * -> *).
MonadMetadataStorage m =>
Invocation 'ScheduledType -> ScheduledEventType -> CacheRWT m ()
forall (m :: * -> *).
MonadMetadataStorage m =>
TriggerName
-> ScheduledEventPagination
-> [ScheduledEventStatus]
-> CacheRWT m (WithTotalCount [CronEvent])
forall (m :: * -> *).
MonadMetadataStorage m =>
OneOffEvent -> CacheRWT m EventId
forall (m :: * -> *).
MonadMetadataStorage m =>
ScheduledEventType -> [EventId] -> CacheRWT m Int
forall (m :: * -> *).
MonadMetadataStorage m =>
ScheduledEventPagination
-> [ScheduledEventStatus]
-> CacheRWT m (WithTotalCount [OneOffScheduledEvent])
forall (m :: * -> *).
MonadMetadataStorage m =>
ClearCronEvents -> CacheRWT m ()
forall (m :: * -> *).
MonadMetadataStorage m =>
GetInvocationsBy
-> ScheduledEventPagination
-> CacheRWT m (WithTotalCount [ScheduledEventInvocation])
forall (m :: * -> *).
MonadMetadataStorage m =>
LockedActionIdArray -> CacheRWT m ()
forall (m :: * -> *).
MonadMetadataStorage m =>
ActionId -> CacheRWT m ActionLogResponse
forall (m :: * -> *).
MonadMetadataStorage m =>
ActionId -> AsyncActionStatus -> CacheRWT m ()
forall (m :: * -> *).
MonadMetadataStorage m =>
ActionName -> CacheRWT m ()
forall (m :: * -> *).
MonadMetadataStorage m =>
ActionName
-> SessionVariables -> [Header] -> Value -> CacheRWT m ActionId
forall (m :: * -> *).
MonadMetadataStorage m =>
CatalogStateType -> Value -> CacheRWT m ()
forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> InstanceId
-> CacheRWT m [(MetadataResourceVersion, CacheInvalidations)]
forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> InstanceId -> CacheInvalidations -> CacheRWT m ()
forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> Metadata -> CacheRWT m MetadataResourceVersion
setProcessingActionLogsToPending :: LockedActionIdArray -> CacheRWT m ()
$csetProcessingActionLogsToPending :: forall (m :: * -> *).
MonadMetadataStorage m =>
LockedActionIdArray -> CacheRWT m ()
clearActionData :: ActionName -> CacheRWT m ()
$cclearActionData :: forall (m :: * -> *).
MonadMetadataStorage m =>
ActionName -> CacheRWT m ()
fetchActionResponse :: ActionId -> CacheRWT m ActionLogResponse
$cfetchActionResponse :: forall (m :: * -> *).
MonadMetadataStorage m =>
ActionId -> CacheRWT m ActionLogResponse
setActionStatus :: ActionId -> AsyncActionStatus -> CacheRWT m ()
$csetActionStatus :: forall (m :: * -> *).
MonadMetadataStorage m =>
ActionId -> AsyncActionStatus -> CacheRWT m ()
fetchUndeliveredActionEvents :: CacheRWT m [ActionLogItem]
$cfetchUndeliveredActionEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m [ActionLogItem]
insertAction :: ActionName
-> SessionVariables -> [Header] -> Value -> CacheRWT m ActionId
$cinsertAction :: forall (m :: * -> *).
MonadMetadataStorage m =>
ActionName
-> SessionVariables -> [Header] -> Value -> CacheRWT m ActionId
deleteScheduledEvent :: EventId -> ScheduledEventType -> CacheRWT m ()
$cdeleteScheduledEvent :: forall (m :: * -> *).
MonadMetadataStorage m =>
EventId -> ScheduledEventType -> CacheRWT m ()
getInvocations :: GetInvocationsBy
-> ScheduledEventPagination
-> CacheRWT m (WithTotalCount [ScheduledEventInvocation])
$cgetInvocations :: forall (m :: * -> *).
MonadMetadataStorage m =>
GetInvocationsBy
-> ScheduledEventPagination
-> CacheRWT m (WithTotalCount [ScheduledEventInvocation])
getCronEvents :: TriggerName
-> ScheduledEventPagination
-> [ScheduledEventStatus]
-> CacheRWT m (WithTotalCount [CronEvent])
$cgetCronEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
TriggerName
-> ScheduledEventPagination
-> [ScheduledEventStatus]
-> CacheRWT m (WithTotalCount [CronEvent])
getOneOffScheduledEvents :: ScheduledEventPagination
-> [ScheduledEventStatus]
-> CacheRWT m (WithTotalCount [OneOffScheduledEvent])
$cgetOneOffScheduledEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
ScheduledEventPagination
-> [ScheduledEventStatus]
-> CacheRWT m (WithTotalCount [OneOffScheduledEvent])
clearFutureCronEvents :: ClearCronEvents -> CacheRWT m ()
$cclearFutureCronEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
ClearCronEvents -> CacheRWT m ()
unlockAllLockedScheduledEvents :: CacheRWT m ()
$cunlockAllLockedScheduledEvents :: forall (m :: * -> *). MonadMetadataStorage m => CacheRWT m ()
unlockScheduledEvents :: ScheduledEventType -> [EventId] -> CacheRWT m Int
$cunlockScheduledEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
ScheduledEventType -> [EventId] -> CacheRWT m Int
setScheduledEventOp :: EventId -> ScheduledEventOp -> ScheduledEventType -> CacheRWT m ()
$csetScheduledEventOp :: forall (m :: * -> *).
MonadMetadataStorage m =>
EventId -> ScheduledEventOp -> ScheduledEventType -> CacheRWT m ()
insertScheduledEventInvocation :: Invocation 'ScheduledType -> ScheduledEventType -> CacheRWT m ()
$cinsertScheduledEventInvocation :: forall (m :: * -> *).
MonadMetadataStorage m =>
Invocation 'ScheduledType -> ScheduledEventType -> CacheRWT m ()
insertOneOffScheduledEvent :: OneOffEvent -> CacheRWT m EventId
$cinsertOneOffScheduledEvent :: forall (m :: * -> *).
MonadMetadataStorage m =>
OneOffEvent -> CacheRWT m EventId
insertCronEvents :: [CronEventSeed] -> CacheRWT m ()
$cinsertCronEvents :: forall (m :: * -> *).
MonadMetadataStorage m =>
[CronEventSeed] -> CacheRWT m ()
getScheduledEventsForDelivery :: CacheRWT m ([CronEvent], [OneOffScheduledEvent])
$cgetScheduledEventsForDelivery :: forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m ([CronEvent], [OneOffScheduledEvent])
getDeprivedCronTriggerStats :: [TriggerName] -> CacheRWT m [CronTriggerStats]
$cgetDeprivedCronTriggerStats :: forall (m :: * -> *).
MonadMetadataStorage m =>
[TriggerName] -> CacheRWT m [CronTriggerStats]
checkMetadataStorageHealth :: CacheRWT m ()
$ccheckMetadataStorageHealth :: forall (m :: * -> *). MonadMetadataStorage m => CacheRWT m ()
getMetadataDbUid :: CacheRWT m MetadataDbId
$cgetMetadataDbUid :: forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m MetadataDbId
setCatalogState :: CatalogStateType -> Value -> CacheRWT m ()
$csetCatalogState :: forall (m :: * -> *).
MonadMetadataStorage m =>
CatalogStateType -> Value -> CacheRWT m ()
getCatalogState :: CacheRWT m CatalogState
$cgetCatalogState :: forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m CatalogState
notifySchemaCacheSync :: MetadataResourceVersion
-> InstanceId -> CacheInvalidations -> CacheRWT m ()
$cnotifySchemaCacheSync :: forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> InstanceId -> CacheInvalidations -> CacheRWT m ()
setMetadata :: MetadataResourceVersion
-> Metadata -> CacheRWT m MetadataResourceVersion
$csetMetadata :: forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> Metadata -> CacheRWT m MetadataResourceVersion
fetchMetadataNotifications :: MetadataResourceVersion
-> InstanceId
-> CacheRWT m [(MetadataResourceVersion, CacheInvalidations)]
$cfetchMetadataNotifications :: forall (m :: * -> *).
MonadMetadataStorage m =>
MetadataResourceVersion
-> InstanceId
-> CacheRWT m [(MetadataResourceVersion, CacheInvalidations)]
fetchMetadata :: CacheRWT m (Metadata, MetadataResourceVersion)
$cfetchMetadata :: forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m (Metadata, MetadataResourceVersion)
fetchMetadataResourceVersion :: CacheRWT m MetadataResourceVersion
$cfetchMetadataResourceVersion :: forall (m :: * -> *).
MonadMetadataStorage m =>
CacheRWT m MetadataResourceVersion
$cp1MonadMetadataStorage :: forall (m :: * -> *).
MonadMetadataStorage m =>
MonadError QErr (CacheRWT m)
MonadMetadataStorage,
      MonadMetadataStorage (CacheRWT m)
CacheRWT m CatalogState
[CronEventSeed] -> CacheRWT m ()
EventId -> ScheduledEventType -> CacheRWT m ()
OneOffEvent -> CacheRWT m EventId
GetScheduledEvents -> CacheRWT m Value
ClearCronEvents -> CacheRWT m ()
GetInvocationsBy
-> ScheduledEventPagination
-> CacheRWT m (WithTotalCount [ScheduledEventInvocation])
ActionName -> CacheRWT m ()
CatalogStateType -> Value -> CacheRWT m ()
MonadMetadataStorage (CacheRWT m)
-> (OneOffEvent -> CacheRWT m EventId)
-> ([CronEventSeed] -> CacheRWT m ())
-> (ClearCronEvents -> CacheRWT m ())
-> (ActionName -> CacheRWT m ())
-> (GetInvocationsBy
    -> ScheduledEventPagination
    -> CacheRWT m (WithTotalCount [ScheduledEventInvocation]))
-> (GetScheduledEvents -> CacheRWT m Value)
-> (EventId -> ScheduledEventType -> CacheRWT m ())
-> CacheRWT m CatalogState
-> (CatalogStateType -> Value -> CacheRWT m ())
-> MonadMetadataStorageQueryAPI (CacheRWT m)
forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
MonadMetadataStorage (CacheRWT m)
forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
CacheRWT m CatalogState
forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
[CronEventSeed] -> CacheRWT m ()
forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
EventId -> ScheduledEventType -> CacheRWT m ()
forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
OneOffEvent -> CacheRWT m EventId
forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
GetScheduledEvents -> CacheRWT m Value
forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
ClearCronEvents -> CacheRWT m ()
forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
GetInvocationsBy
-> ScheduledEventPagination
-> CacheRWT m (WithTotalCount [ScheduledEventInvocation])
forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
ActionName -> CacheRWT m ()
forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
CatalogStateType -> Value -> CacheRWT m ()
forall (m :: * -> *).
MonadMetadataStorage m
-> (OneOffEvent -> m EventId)
-> ([CronEventSeed] -> m ())
-> (ClearCronEvents -> m ())
-> (ActionName -> m ())
-> (GetInvocationsBy
    -> ScheduledEventPagination
    -> m (WithTotalCount [ScheduledEventInvocation]))
-> (GetScheduledEvents -> m Value)
-> (EventId -> ScheduledEventType -> m ())
-> m CatalogState
-> (CatalogStateType -> Value -> m ())
-> MonadMetadataStorageQueryAPI m
updateCatalogState :: CatalogStateType -> Value -> CacheRWT m ()
$cupdateCatalogState :: forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
CatalogStateType -> Value -> CacheRWT m ()
fetchCatalogState :: CacheRWT m CatalogState
$cfetchCatalogState :: forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
CacheRWT m CatalogState
dropEvent :: EventId -> ScheduledEventType -> CacheRWT m ()
$cdropEvent :: forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
EventId -> ScheduledEventType -> CacheRWT m ()
fetchScheduledEvents :: GetScheduledEvents -> CacheRWT m Value
$cfetchScheduledEvents :: forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
GetScheduledEvents -> CacheRWT m Value
fetchInvocations :: GetInvocationsBy
-> ScheduledEventPagination
-> CacheRWT m (WithTotalCount [ScheduledEventInvocation])
$cfetchInvocations :: forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
GetInvocationsBy
-> ScheduledEventPagination
-> CacheRWT m (WithTotalCount [ScheduledEventInvocation])
deleteActionData :: ActionName -> CacheRWT m ()
$cdeleteActionData :: forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
ActionName -> CacheRWT m ()
dropFutureCronEvents :: ClearCronEvents -> CacheRWT m ()
$cdropFutureCronEvents :: forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
ClearCronEvents -> CacheRWT m ()
createCronEvents :: [CronEventSeed] -> CacheRWT m ()
$ccreateCronEvents :: forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
[CronEventSeed] -> CacheRWT m ()
createOneOffScheduledEvent :: OneOffEvent -> CacheRWT m EventId
$ccreateOneOffScheduledEvent :: forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
OneOffEvent -> CacheRWT m EventId
$cp1MonadMetadataStorageQueryAPI :: forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
MonadMetadataStorage (CacheRWT m)
MonadMetadataStorageQueryAPI,
      Monad (CacheRWT m)
CacheRWT m TraceContext
CacheRWT m Reporter
Monad (CacheRWT m)
-> (forall a. Text -> CacheRWT m a -> CacheRWT m a)
-> CacheRWT m TraceContext
-> CacheRWT m Reporter
-> (TracingMetadata -> CacheRWT m ())
-> MonadTrace (CacheRWT m)
TracingMetadata -> CacheRWT m ()
Text -> CacheRWT m a -> CacheRWT m a
forall a. Text -> CacheRWT m a -> CacheRWT m a
forall (m :: * -> *).
Monad m
-> (forall a. Text -> m a -> m a)
-> m TraceContext
-> m Reporter
-> (TracingMetadata -> m ())
-> MonadTrace m
forall (m :: * -> *). MonadTrace m => Monad (CacheRWT m)
forall (m :: * -> *). MonadTrace m => CacheRWT m TraceContext
forall (m :: * -> *). MonadTrace m => CacheRWT m Reporter
forall (m :: * -> *).
MonadTrace m =>
TracingMetadata -> CacheRWT m ()
forall (m :: * -> *) a.
MonadTrace m =>
Text -> CacheRWT m a -> CacheRWT m a
attachMetadata :: TracingMetadata -> CacheRWT m ()
$cattachMetadata :: forall (m :: * -> *).
MonadTrace m =>
TracingMetadata -> CacheRWT m ()
currentReporter :: CacheRWT m Reporter
$ccurrentReporter :: forall (m :: * -> *). MonadTrace m => CacheRWT m Reporter
currentContext :: CacheRWT m TraceContext
$ccurrentContext :: forall (m :: * -> *). MonadTrace m => CacheRWT m TraceContext
trace :: Text -> CacheRWT m a -> CacheRWT m a
$ctrace :: forall (m :: * -> *) a.
MonadTrace m =>
Text -> CacheRWT m a -> CacheRWT m a
$cp1MonadTrace :: forall (m :: * -> *). MonadTrace m => Monad (CacheRWT m)
Tracing.MonadTrace,
      Monad (CacheRWT m)
CacheRWT m ServerConfigCtx
Monad (CacheRWT m)
-> CacheRWT m ServerConfigCtx -> HasServerConfigCtx (CacheRWT m)
forall (m :: * -> *).
Monad m -> m ServerConfigCtx -> HasServerConfigCtx m
forall (m :: * -> *). HasServerConfigCtx m => Monad (CacheRWT m)
forall (m :: * -> *).
HasServerConfigCtx m =>
CacheRWT m ServerConfigCtx
askServerConfigCtx :: CacheRWT m ServerConfigCtx
$caskServerConfigCtx :: forall (m :: * -> *).
HasServerConfigCtx m =>
CacheRWT m ServerConfigCtx
$cp1HasServerConfigCtx :: forall (m :: * -> *). HasServerConfigCtx m => Monad (CacheRWT m)
HasServerConfigCtx,
      MonadBase b,
      MonadBaseControl b
    )

runCacheRWT ::
  Functor m =>
  RebuildableSchemaCache ->
  CacheRWT m a ->
  m (a, RebuildableSchemaCache, CacheInvalidations)
runCacheRWT :: RebuildableSchemaCache
-> CacheRWT m a
-> m (a, RebuildableSchemaCache, CacheInvalidations)
runCacheRWT RebuildableSchemaCache
cache (CacheRWT StateT (RebuildableSchemaCache, CacheInvalidations) m a
m) =
  StateT (RebuildableSchemaCache, CacheInvalidations) m a
-> (RebuildableSchemaCache, CacheInvalidations)
-> m (a, (RebuildableSchemaCache, CacheInvalidations))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT (RebuildableSchemaCache, CacheInvalidations) m a
m (RebuildableSchemaCache
cache, CacheInvalidations
forall a. Monoid a => a
mempty) m (a, (RebuildableSchemaCache, CacheInvalidations))
-> ((a, (RebuildableSchemaCache, CacheInvalidations))
    -> (a, RebuildableSchemaCache, CacheInvalidations))
-> m (a, RebuildableSchemaCache, CacheInvalidations)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(a
v, (RebuildableSchemaCache
newCache, CacheInvalidations
invalidations)) -> (a
v, RebuildableSchemaCache
newCache, CacheInvalidations
invalidations)

instance MonadTrans CacheRWT where
  lift :: m a -> CacheRWT m a
lift = StateT (RebuildableSchemaCache, CacheInvalidations) m a
-> CacheRWT m a
forall (m :: * -> *) a.
StateT (RebuildableSchemaCache, CacheInvalidations) m a
-> CacheRWT m a
CacheRWT (StateT (RebuildableSchemaCache, CacheInvalidations) m a
 -> CacheRWT m a)
-> (m a -> StateT (RebuildableSchemaCache, CacheInvalidations) m a)
-> m a
-> CacheRWT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT (RebuildableSchemaCache, CacheInvalidations) 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 = StateT (RebuildableSchemaCache, CacheInvalidations) m SchemaCache
-> CacheRWT m SchemaCache
forall (m :: * -> *) a.
StateT (RebuildableSchemaCache, CacheInvalidations) m a
-> CacheRWT m a
CacheRWT (StateT (RebuildableSchemaCache, CacheInvalidations) m SchemaCache
 -> CacheRWT m SchemaCache)
-> StateT
     (RebuildableSchemaCache, CacheInvalidations) m SchemaCache
-> CacheRWT m SchemaCache
forall a b. (a -> b) -> a -> b
$ ((RebuildableSchemaCache, CacheInvalidations) -> SchemaCache)
-> StateT
     (RebuildableSchemaCache, CacheInvalidations) m SchemaCache
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (RebuildableSchemaCache -> SchemaCache
lastBuiltSchemaCache (RebuildableSchemaCache -> SchemaCache)
-> ((RebuildableSchemaCache, CacheInvalidations)
    -> RebuildableSchemaCache)
-> (RebuildableSchemaCache, CacheInvalidations)
-> SchemaCache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RebuildableSchemaCache, CacheInvalidations)
-> Getting
     RebuildableSchemaCache
     (RebuildableSchemaCache, CacheInvalidations)
     RebuildableSchemaCache
-> RebuildableSchemaCache
forall s a. s -> Getting a s a -> a
^. Getting
  RebuildableSchemaCache
  (RebuildableSchemaCache, CacheInvalidations)
  RebuildableSchemaCache
forall s t a b. Field1 s t a b => Lens s t a b
_1))

instance
  ( MonadIO m,
    MonadError QErr m,
    HasHttpManagerM m,
    MonadResolveSource m,
    HasServerConfigCtx m
  ) =>
  CacheRWM (CacheRWT m)
  where
  buildSchemaCacheWithOptions :: BuildReason -> CacheInvalidations -> Metadata -> CacheRWT m ()
buildSchemaCacheWithOptions BuildReason
buildReason CacheInvalidations
invalidations Metadata
metadata = StateT (RebuildableSchemaCache, CacheInvalidations) m ()
-> CacheRWT m ()
forall (m :: * -> *) a.
StateT (RebuildableSchemaCache, CacheInvalidations) m a
-> CacheRWT m a
CacheRWT do
    (RebuildableSchemaCache SchemaCache
lastBuiltSC InvalidationKeys
invalidationKeys Rule
  (ReaderT BuildReason CacheBuild)
  (Metadata, InvalidationKeys)
  SchemaCache
rule, CacheInvalidations
oldInvalidations) <- StateT
  (RebuildableSchemaCache, CacheInvalidations)
  m
  (RebuildableSchemaCache, CacheInvalidations)
forall s (m :: * -> *). MonadState s m => m s
get
    let metadataVersion :: Maybe MetadataResourceVersion
metadataVersion = SchemaCache -> Maybe MetadataResourceVersion
scMetadataResourceVersion SchemaCache
lastBuiltSC
        newInvalidationKeys :: InvalidationKeys
newInvalidationKeys = CacheInvalidations -> InvalidationKeys -> InvalidationKeys
invalidateKeys CacheInvalidations
invalidations InvalidationKeys
invalidationKeys
    Result
  (ReaderT BuildReason CacheBuild)
  (Metadata, InvalidationKeys)
  SchemaCache
result <-
      m (Result
     (ReaderT BuildReason CacheBuild)
     (Metadata, InvalidationKeys)
     SchemaCache)
-> StateT
     (RebuildableSchemaCache, CacheInvalidations)
     m
     (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Result
      (ReaderT BuildReason CacheBuild)
      (Metadata, InvalidationKeys)
      SchemaCache)
 -> StateT
      (RebuildableSchemaCache, CacheInvalidations)
      m
      (Result
         (ReaderT BuildReason CacheBuild)
         (Metadata, InvalidationKeys)
         SchemaCache))
-> m (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
-> StateT
     (RebuildableSchemaCache, CacheInvalidations)
     m
     (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
forall a b. (a -> b) -> a -> b
$
        CacheBuild
  (Result
     (ReaderT BuildReason CacheBuild)
     (Metadata, InvalidationKeys)
     SchemaCache)
-> m (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
forall (m :: * -> *) a.
(MonadIO m, MonadError QErr m, HasHttpManagerM m,
 HasServerConfigCtx m, MonadResolveSource m) =>
CacheBuild a -> m a
runCacheBuildM (CacheBuild
   (Result
      (ReaderT BuildReason CacheBuild)
      (Metadata, InvalidationKeys)
      SchemaCache)
 -> m (Result
         (ReaderT BuildReason CacheBuild)
         (Metadata, InvalidationKeys)
         SchemaCache))
-> CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
-> m (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
forall a b. (a -> b) -> a -> b
$
          (ReaderT
   BuildReason
   CacheBuild
   (Result
      (ReaderT BuildReason CacheBuild)
      (Metadata, InvalidationKeys)
      SchemaCache)
 -> BuildReason
 -> CacheBuild
      (Result
         (ReaderT BuildReason CacheBuild)
         (Metadata, InvalidationKeys)
         SchemaCache))
-> BuildReason
-> ReaderT
     BuildReason
     CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
-> CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  BuildReason
  CacheBuild
  (Result
     (ReaderT BuildReason CacheBuild)
     (Metadata, InvalidationKeys)
     SchemaCache)
-> BuildReason
-> CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT BuildReason
buildReason (ReaderT
   BuildReason
   CacheBuild
   (Result
      (ReaderT BuildReason CacheBuild)
      (Metadata, InvalidationKeys)
      SchemaCache)
 -> CacheBuild
      (Result
         (ReaderT BuildReason CacheBuild)
         (Metadata, InvalidationKeys)
         SchemaCache))
-> ReaderT
     BuildReason
     CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
-> CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
forall a b. (a -> b) -> a -> b
$
            Rule
  (ReaderT BuildReason CacheBuild)
  (Metadata, InvalidationKeys)
  SchemaCache
-> (Metadata, InvalidationKeys)
-> ReaderT
     BuildReason
     CacheBuild
     (Result
        (ReaderT BuildReason CacheBuild)
        (Metadata, InvalidationKeys)
        SchemaCache)
forall (m :: * -> *) a b.
Applicative m =>
Rule m a b -> a -> m (Result m a b)
Inc.build Rule
  (ReaderT BuildReason CacheBuild)
  (Metadata, InvalidationKeys)
  SchemaCache
rule (Metadata
metadata, InvalidationKeys
newInvalidationKeys)
    let schemaCache :: SchemaCache
schemaCache = (Result
  (ReaderT BuildReason CacheBuild)
  (Metadata, InvalidationKeys)
  SchemaCache
-> SchemaCache
forall (m :: * -> *) a b. Result m a b -> b
Inc.result Result
  (ReaderT BuildReason CacheBuild)
  (Metadata, InvalidationKeys)
  SchemaCache
result) {scMetadataResourceVersion :: Maybe MetadataResourceVersion
scMetadataResourceVersion = Maybe MetadataResourceVersion
metadataVersion}
        prunedInvalidationKeys :: InvalidationKeys
prunedInvalidationKeys = SchemaCache -> InvalidationKeys -> InvalidationKeys
pruneInvalidationKeys SchemaCache
schemaCache InvalidationKeys
newInvalidationKeys
        !newCache :: RebuildableSchemaCache
newCache = SchemaCache
-> InvalidationKeys
-> Rule
     (ReaderT BuildReason CacheBuild)
     (Metadata, InvalidationKeys)
     SchemaCache
-> RebuildableSchemaCache
RebuildableSchemaCache SchemaCache
schemaCache InvalidationKeys
prunedInvalidationKeys (Result
  (ReaderT BuildReason CacheBuild)
  (Metadata, InvalidationKeys)
  SchemaCache
-> Rule
     (ReaderT BuildReason CacheBuild)
     (Metadata, InvalidationKeys)
     SchemaCache
forall (m :: * -> *) a b. Result m a b -> Rule m a b
Inc.rebuildRule Result
  (ReaderT BuildReason CacheBuild)
  (Metadata, InvalidationKeys)
  SchemaCache
result)
        !newInvalidations :: CacheInvalidations
newInvalidations = CacheInvalidations
oldInvalidations CacheInvalidations -> CacheInvalidations -> CacheInvalidations
forall a. Semigroup a => a -> a -> a
<> CacheInvalidations
invalidations
    (RebuildableSchemaCache, CacheInvalidations)
-> StateT (RebuildableSchemaCache, CacheInvalidations) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (RebuildableSchemaCache
newCache, CacheInvalidations
newInvalidations)
    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
M.filterWithKey \RemoteSchemaName
name InvalidationKey
_ ->
        -- see Note [Keep invalidation keys for inconsistent objects]
        RemoteSchemaName
name RemoteSchemaName -> [RemoteSchemaName] -> 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 = StateT (RebuildableSchemaCache, CacheInvalidations) m ()
-> CacheRWT m ()
forall (m :: * -> *) a.
StateT (RebuildableSchemaCache, CacheInvalidations) m a
-> CacheRWT m a
CacheRWT (StateT (RebuildableSchemaCache, CacheInvalidations) m ()
 -> CacheRWT m ())
-> StateT (RebuildableSchemaCache, CacheInvalidations) m ()
-> CacheRWT m ()
forall a b. (a -> b) -> a -> b
$ do
    (RebuildableSchemaCache
rebuildableSchemaCache, CacheInvalidations
invalidations) <- StateT
  (RebuildableSchemaCache, CacheInvalidations)
  m
  (RebuildableSchemaCache, CacheInvalidations)
forall s (m :: * -> *). MonadState s m => m s
get
    (RebuildableSchemaCache, CacheInvalidations)
-> StateT (RebuildableSchemaCache, CacheInvalidations) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
      ( RebuildableSchemaCache
rebuildableSchemaCache
          { lastBuiltSchemaCache :: SchemaCache
lastBuiltSchemaCache =
              (RebuildableSchemaCache -> SchemaCache
lastBuiltSchemaCache RebuildableSchemaCache
rebuildableSchemaCache)
                { scMetadataResourceVersion :: Maybe MetadataResourceVersion
scMetadataResourceVersion = MetadataResourceVersion -> Maybe MetadataResourceVersion
forall a. a -> Maybe a
Just MetadataResourceVersion
resourceVersion
                }
          },
        CacheInvalidations
invalidations
      )

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,
    HasHttpManagerM m,
    MonadResolveSource m,
    HasServerConfigCtx m
  ) =>
  Logger Hasura ->
  Env.Environment ->
  (Metadata, InvalidationKeys) `arr` SchemaCache
buildSchemaCacheRule :: Logger Hasura
-> Environment -> arr (Metadata, InvalidationKeys) SchemaCache
buildSchemaCacheRule Logger Hasura
logger Environment
env = proc (Metadata
metadata, InvalidationKeys
invalidationKeys) -> do
  Dependency InvalidationKeys
invalidationKeysDep <- arr InvalidationKeys (Dependency InvalidationKeys)
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowCache m arr =>
arr a (Dependency a)
Inc.newDependency -< InvalidationKeys
invalidationKeys

  -- Step 1: Process metadata and collect dependency information.
  (BuildOutputs
outputs, Seq CollectedInfo
collectedInfo) <-
    WriterA
  (Seq CollectedInfo)
  arr
  (Metadata, Dependency InvalidationKeys)
  BuildOutputs
-> (Monoid (Seq CollectedInfo), Arrow arr) =>
   arr
     (Metadata, Dependency InvalidationKeys)
     (BuildOutputs, Seq CollectedInfo)
forall w (arr :: * -> * -> *) a b.
WriterA w arr a b -> (Monoid w, Arrow arr) => arr a (b, w)
runWriterA WriterA
  (Seq CollectedInfo)
  arr
  (Metadata, Dependency InvalidationKeys)
  BuildOutputs
forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowDistribute arr, ArrowCache m arr,
 ArrowWriter (Seq CollectedInfo) arr, MonadIO m, MonadError QErr m,
 MonadReader BuildReason m, MonadBaseControl IO m,
 HasHttpManagerM m, HasServerConfigCtx m, MonadResolveSource m) =>
arr (Metadata, Dependency InvalidationKeys) BuildOutputs
buildAndCollectInfo -< (Metadata
metadata, Dependency InvalidationKeys
invalidationKeysDep)
  let ([InconsistentMetadata]
inconsistentObjects, [(MetadataObject, SchemaObjId, SchemaDependency)]
unresolvedDependencies) = Seq CollectedInfo
-> ([InconsistentMetadata],
    [(MetadataObject, SchemaObjId, SchemaDependency)])
partitionCollectedInfo Seq CollectedInfo
collectedInfo

  -- Step 2: Resolve dependency information and drop dangling dependents.
  (BuildOutputs
resolvedOutputs, [InconsistentMetadata]
dependencyInconsistentObjects, DepMap
resolvedDependencies) <-
    arr
  (BuildOutputs, [(MetadataObject, SchemaObjId, SchemaDependency)])
  (BuildOutputs, [InconsistentMetadata], DepMap)
forall (m :: * -> *) (arr :: * -> * -> *).
(ArrowKleisli m arr, QErrM m) =>
arr
  (BuildOutputs, [(MetadataObject, SchemaObjId, SchemaDependency)])
  (BuildOutputs, [InconsistentMetadata], DepMap)
resolveDependencies -< (BuildOutputs
outputs, [(MetadataObject, SchemaObjId, SchemaDependency)]
unresolvedDependencies)

  -- Steps 3 and 4: Build the regular and relay GraphQL schemas in parallel
  [(SchemaIntrospection
adminIntrospection, HashMap RoleName (RoleContext GQLContext)
gqlContext, GQLContext
gqlContextUnauth, HashSet InconsistentMetadata
inconsistentRemoteSchemas), (SchemaIntrospection
_, HashMap RoleName (RoleContext GQLContext)
relayContext, GQLContext
relayContextUnauth, HashSet InconsistentMetadata
_)] <-
    arr
  (m [(SchemaIntrospection,
       HashMap RoleName (RoleContext GQLContext), GQLContext,
       HashSet InconsistentMetadata)])
  [(SchemaIntrospection, HashMap RoleName (RoleContext GQLContext),
    GQLContext, HashSet InconsistentMetadata)]
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA
      -< do
        ServerConfigCtx
cxt <- m ServerConfigCtx
forall (m :: * -> *). HasServerConfigCtx m => m ServerConfigCtx
askServerConfigCtx
        Int
-> [GraphQLQueryType]
-> (GraphQLQueryType
    -> ExceptT
         QErr
         IO
         (SchemaIntrospection, HashMap RoleName (RoleContext GQLContext),
          GQLContext, HashSet InconsistentMetadata))
-> m [(SchemaIntrospection,
       HashMap RoleName (RoleContext GQLContext), GQLContext,
       HashSet InconsistentMetadata)]
forall (m :: * -> *) e a b.
(MonadIO m, MonadError e m) =>
Int -> [a] -> (a -> ExceptT e IO b) -> m [b]
forConcurrentlyEIO Int
1 [GraphQLQueryType
QueryHasura, GraphQLQueryType
QueryRelay] ((GraphQLQueryType
  -> ExceptT
       QErr
       IO
       (SchemaIntrospection, HashMap RoleName (RoleContext GQLContext),
        GQLContext, HashSet InconsistentMetadata))
 -> m [(SchemaIntrospection,
        HashMap RoleName (RoleContext GQLContext), GQLContext,
        HashSet InconsistentMetadata)])
-> (GraphQLQueryType
    -> ExceptT
         QErr
         IO
         (SchemaIntrospection, HashMap RoleName (RoleContext GQLContext),
          GQLContext, HashSet InconsistentMetadata))
-> m [(SchemaIntrospection,
       HashMap RoleName (RoleContext GQLContext), GQLContext,
       HashSet InconsistentMetadata)]
forall a b. (a -> b) -> a -> b
$ \GraphQLQueryType
queryType -> do
          ServerConfigCtx
-> GraphQLQueryType
-> SourceCache
-> HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
-> ActionCache
-> AnnotatedCustomTypes
-> ExceptT
     QErr
     IO
     (SchemaIntrospection, HashMap RoleName (RoleContext GQLContext),
      GQLContext, HashSet InconsistentMetadata)
forall (m :: * -> *).
(MonadError QErr m, MonadIO m) =>
ServerConfigCtx
-> GraphQLQueryType
-> SourceCache
-> HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
-> ActionCache
-> AnnotatedCustomTypes
-> m (SchemaIntrospection,
      HashMap RoleName (RoleContext GQLContext), GQLContext,
      HashSet InconsistentMetadata)
buildGQLContext
            ServerConfigCtx
cxt
            GraphQLQueryType
queryType
            (BuildOutputs -> SourceCache
_boSources BuildOutputs
resolvedOutputs)
            (BuildOutputs
-> HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
_boRemoteSchemas BuildOutputs
resolvedOutputs)
            (BuildOutputs -> ActionCache
_boActions BuildOutputs
resolvedOutputs)
            (BuildOutputs -> AnnotatedCustomTypes
_boCustomTypes BuildOutputs
resolvedOutputs)

  let duplicateVariables :: EndpointMetadata a -> Bool
      duplicateVariables :: 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 (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 (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 :: 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 :: 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
-> InsOrdHashMap EndpointName CreateEndpoint
-> Maybe CreateEndpoint
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
OMap.lookup (EndpointMetadata q -> EndpointName
forall query. EndpointMetadata query -> EndpointName
_ceName EndpointMetadata q
md) (InsOrdHashMap EndpointName CreateEndpoint -> Maybe CreateEndpoint)
-> InsOrdHashMap EndpointName CreateEndpoint
-> Maybe CreateEndpoint
forall a b. (a -> b) -> a -> b
$ Metadata -> InsOrdHashMap EndpointName CreateEndpoint
_metaRestEndpoints Metadata
metadata)

      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 :: EndpointMetadata query -> Bool
hasInvalidSegments EndpointMetadata query
m = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> [Text] -> 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]
M.elems (HashMap EndpointName (EndpointMetadata GQLQueryWithText)
 -> [EndpointMetadata GQLQueryWithText])
-> HashMap EndpointName (EndpointMetadata GQLQueryWithText)
-> [EndpointMetadata GQLQueryWithText]
forall a b. (a -> b) -> a -> b
$ BuildOutputs
-> HashMap EndpointName (EndpointMetadata GQLQueryWithText)
_boEndpoints BuildOutputs
resolvedOutputs)

      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]
M.elems (HashMap EndpointName (EndpointMetadata GQLQueryWithText)
 -> [EndpointMetadata GQLQueryWithText])
-> HashMap EndpointName (EndpointMetadata GQLQueryWithText)
-> [EndpointMetadata GQLQueryWithText]
forall a b. (a -> b) -> a -> b
$ BuildOutputs
-> HashMap EndpointName (EndpointMetadata GQLQueryWithText)
_boEndpoints BuildOutputs
resolvedOutputs)

      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]
M.elems (HashMap EndpointName (EndpointMetadata GQLQueryWithText)
 -> [EndpointMetadata GQLQueryWithText])
-> HashMap EndpointName (EndpointMetadata GQLQueryWithText)
-> [EndpointMetadata GQLQueryWithText]
forall a b. (a -> b) -> a -> b
$ BuildOutputs
-> HashMap EndpointName (EndpointMetadata GQLQueryWithText)
_boEndpoints BuildOutputs
resolvedOutputs)

      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, Eq k, Hashable k, Ord v, Ord a) =>
MultiMapPathTrie a k v -> [(Set [PathComponent a], Set v)]
ambiguousPathsGrouped EndpointTrie GQLQueryWithText
endpoints

      queryCollections :: QueryCollections
queryCollections = BuildOutputs -> QueryCollections
_boQueryCollections BuildOutputs
resolvedOutputs
      allowLists :: [NormalizedQuery]
allowLists = HashSet NormalizedQuery -> [NormalizedQuery]
forall a. HashSet a -> [a]
HS.toList (HashSet NormalizedQuery -> [NormalizedQuery])
-> (BuildOutputs -> HashSet NormalizedQuery)
-> BuildOutputs
-> [NormalizedQuery]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InlinedAllowlist -> HashSet NormalizedQuery
iaGlobal (InlinedAllowlist -> HashSet NormalizedQuery)
-> (BuildOutputs -> InlinedAllowlist)
-> BuildOutputs
-> HashSet NormalizedQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildOutputs -> InlinedAllowlist
_boAllowlist (BuildOutputs -> [NormalizedQuery])
-> BuildOutputs -> [NormalizedQuery]
forall a b. (a -> b) -> a -> b
$ BuildOutputs
resolvedOutputs

  [InconsistentMetadata]
inconsistentQueryCollections <- arr (m [InconsistentMetadata]) [InconsistentMetadata]
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< do SchemaIntrospection
-> QueryCollections
-> ((CollectionName, ListedQuery) -> MetadataObject)
-> EndpointTrie GQLQueryWithText
-> [NormalizedQuery]
-> m [InconsistentMetadata]
forall (m :: * -> *).
MonadError QErr m =>
SchemaIntrospection
-> QueryCollections
-> ((CollectionName, ListedQuery) -> MetadataObject)
-> EndpointTrie GQLQueryWithText
-> [NormalizedQuery]
-> m [InconsistentMetadata]
getInconsistentQueryCollections SchemaIntrospection
adminIntrospection QueryCollections
queryCollections (CollectionName, ListedQuery) -> MetadataObject
listedQueryObjects EndpointTrie GQLQueryWithText
endpoints [NormalizedQuery]
allowLists

  arr SchemaCache SchemaCache
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA
    -<
      SchemaCache :: SourceCache
-> ActionCache
-> RemoteSchemaMap
-> InlinedAllowlist
-> SchemaIntrospection
-> HashMap RoleName (RoleContext GQLContext)
-> GQLContext
-> HashMap RoleName (RoleContext GQLContext)
-> GQLContext
-> DepMap
-> [InconsistentMetadata]
-> HashMap TriggerName CronTriggerInfo
-> EndpointTrie GQLQueryWithText
-> ApiLimit
-> MetricsConfig
-> Maybe MetadataResourceVersion
-> SetGraphqlIntrospectionOptions
-> [TlsAllow]
-> QueryCollections
-> 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 (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 = BuildOutputs -> InlinedAllowlist
_boAllowlist BuildOutputs
resolvedOutputs,
          -- , 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 = BuildOutputs -> HashMap TriggerName CronTriggerInfo
_boCronTriggers BuildOutputs
resolvedOutputs,
          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 (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]
inconsistentQueryCollections,
          scApiLimits :: ApiLimit
scApiLimits = BuildOutputs -> ApiLimit
_boApiLimits BuildOutputs
resolvedOutputs,
          scMetricsConfig :: MetricsConfig
scMetricsConfig = BuildOutputs -> MetricsConfig
_boMetricsConfig BuildOutputs
resolvedOutputs,
          scMetadataResourceVersion :: Maybe MetadataResourceVersion
scMetadataResourceVersion = Maybe MetadataResourceVersion
forall a. Maybe a
Nothing,
          scSetGraphqlIntrospectionOptions :: SetGraphqlIntrospectionOptions
scSetGraphqlIntrospectionOptions = Metadata -> SetGraphqlIntrospectionOptions
_metaSetGraphqlIntrospectionOptions Metadata
metadata,
          scTlsAllowlist :: [TlsAllow]
scTlsAllowlist = BuildOutputs -> [TlsAllow]
_boTlsAllowlist BuildOutputs
resolvedOutputs,
          scQueryCollections :: QueryCollections
scQueryCollections = BuildOutputs -> QueryCollections
_boQueryCollections BuildOutputs
resolvedOutputs
        }
  where
    getSourceConfigIfNeeded ::
      forall b arr m.
      ( ArrowChoice arr,
        Inc.ArrowCache m arr,
        ArrowWriter (Seq CollectedInfo) arr,
        MonadIO m,
        MonadResolveSource m,
        HasHttpManagerM m,
        BackendMetadata b
      ) =>
      ( Inc.Dependency (HashMap SourceName Inc.InvalidationKey),
        SourceName,
        SourceConnConfiguration b,
        BackendSourceKind b,
        BackendConfig b
      )
        `arr` Maybe (SourceConfig b)
    getSourceConfigIfNeeded :: arr
  (Dependency (HashMap SourceName InvalidationKey), SourceName,
   SourceConnConfiguration b, BackendSourceKind b, BackendConfig b)
  (Maybe (SourceConfig b))
getSourceConfigIfNeeded = arr
  (Dependency (HashMap SourceName InvalidationKey), SourceName,
   SourceConnConfiguration b, BackendSourceKind b, BackendConfig b)
  (Maybe (SourceConfig b))
-> arr
     (Dependency (HashMap SourceName InvalidationKey), SourceName,
      SourceConnConfiguration b, BackendSourceKind b, BackendConfig b)
     (Maybe (SourceConfig b))
forall (m :: * -> *) (arr :: * -> * -> *) a b.
(ArrowCache m arr, Cacheable a) =>
arr a b -> arr a b
Inc.cache proc (Dependency (HashMap SourceName InvalidationKey)
invalidationKeys, SourceName
sourceName, SourceConnConfiguration b
sourceConfig, BackendSourceKind b
backendKind, BackendConfig b
backendConfig) -> 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
      Manager
httpMgr <- arr (m Manager) Manager
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< m Manager
forall (m :: * -> *). HasHttpManagerM m => m Manager
askHttpManager
      arr (Dependency (Maybe InvalidationKey)) (Maybe InvalidationKey)
forall (m :: * -> *) (arr :: * -> * -> *) a.
(ArrowCache m arr, Cacheable 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
      (|
        forall a.
ErrorA QErr arr (a, ()) (SourceConfig b)
-> arr (a, (MetadataObject, ())) (Maybe (SourceConfig b))
forall (arr :: * -> * -> *) w e s a.
(ArrowChoice arr, ArrowWriter (Seq w) arr,
 AsInconsistentMetadata w) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
          ( ErrorA QErr arr (Either QErr (SourceConfig b)) (SourceConfig b)
forall (arr :: * -> * -> *) e a.
(ArrowChoice arr, ArrowError e arr) =>
arr (Either e a) a
liftEitherA ErrorA QErr arr (Either QErr (SourceConfig b)) (SourceConfig b)
-> ErrorA
     QErr
     arr
     (m (Either QErr (SourceConfig b)))
     (Either QErr (SourceConfig b))
-> ErrorA
     QErr arr (m (Either QErr (SourceConfig b))) (SourceConfig b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< ErrorA
  QErr
  arr
  (m (Either QErr (SourceConfig b)))
  (Either QErr (SourceConfig b))
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< Logger Hasura
-> SourceName
-> SourceConnConfiguration b
-> BackendSourceKind b
-> BackendConfig b
-> Environment
-> Manager
-> m (Either QErr (SourceConfig b))
forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadIO m, MonadResolveSource m) =>
Logger Hasura
-> SourceName
-> SourceConnConfiguration b
-> BackendSourceKind b
-> BackendConfig b
-> Environment
-> Manager
-> m (Either QErr (SourceConfig b))
resolveSourceConfig @b Logger Hasura
logger SourceName
sourceName SourceConnConfiguration b
sourceConfig BackendSourceKind b
backendKind BackendConfig b
backendConfig Environment
env Manager
httpMgr
          )
        |) MetadataObject
metadataObj

    resolveSourceIfNeeded ::
      forall b arr m.
      ( ArrowChoice arr,
        Inc.ArrowCache m arr,
        ArrowWriter (Seq CollectedInfo) arr,
        MonadIO m,
        MonadBaseControl IO m,
        MonadResolveSource m,
        HasHttpManagerM m,
        BackendMetadata b
      ) =>
      ( Inc.Dependency (HashMap SourceName Inc.InvalidationKey),
        BackendConfigAndSourceMetadata b
      )
        `arr` Maybe (ResolvedSource b)
    resolveSourceIfNeeded :: arr
  (Dependency (HashMap SourceName InvalidationKey),
   BackendConfigAndSourceMetadata b)
  (Maybe (ResolvedSource b))
resolveSourceIfNeeded = arr
  (Dependency (HashMap SourceName InvalidationKey),
   BackendConfigAndSourceMetadata b)
  (Maybe (ResolvedSource b))
-> arr
     (Dependency (HashMap SourceName InvalidationKey),
      BackendConfigAndSourceMetadata b)
     (Maybe (ResolvedSource b))
forall (m :: * -> *) (arr :: * -> * -> *) a b.
(ArrowCache m arr, Cacheable a) =>
arr a b -> arr a b
Inc.cache proc (Dependency (HashMap SourceName InvalidationKey)
invalidationKeys, BackendConfigAndSourceMetadata {BackendConfig b
SourceMetadata b
_bcasmSourceMetadata :: forall (b :: BackendType).
BackendConfigAndSourceMetadata b -> SourceMetadata b
_bcasmBackendConfig :: forall (b :: BackendType).
BackendConfigAndSourceMetadata b -> BackendConfig b
_bcasmSourceMetadata :: SourceMetadata b
_bcasmBackendConfig :: BackendConfig 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
          logAndResolveDatabaseMetadata :: SourceConfig b -> SourceTypeCustomization -> m (Either QErr (ResolvedSource b))
          logAndResolveDatabaseMetadata :: SourceConfig b
-> SourceTypeCustomization -> m (Either QErr (ResolvedSource b))
logAndResolveDatabaseMetadata SourceConfig b
scConfig SourceTypeCustomization
sType = do
            Either QErr (ResolvedSource b)
resSource <- SourceMetadata b
-> SourceConfig b
-> SourceTypeCustomization
-> m (Either QErr (ResolvedSource b))
forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadIO m, MonadBaseControl IO m,
 MonadResolveSource m) =>
SourceMetadata b
-> SourceConfig b
-> SourceTypeCustomization
-> m (Either QErr (ResolvedSource b))
resolveDatabaseMetadata SourceMetadata b
_bcasmSourceMetadata SourceConfig b
scConfig SourceTypeCustomization
sType
            Either QErr (ResolvedSource b)
-> (ResolvedSource b -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Either QErr (ResolvedSource b)
resSource ((ResolvedSource b -> m ()) -> m ())
-> (ResolvedSource b -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (ResolvedSource b -> IO ()) -> ResolvedSource b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
            Either QErr (ResolvedSource b)
-> m (Either QErr (ResolvedSource b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either QErr (ResolvedSource b)
resSource

      Maybe (SourceConfig b)
maybeSourceConfig <- forall (b :: BackendType) (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowCache m arr,
 ArrowWriter (Seq CollectedInfo) arr, MonadIO m,
 MonadResolveSource m, HasHttpManagerM m, BackendMetadata b) =>
arr
  (Dependency (HashMap SourceName InvalidationKey), SourceName,
   SourceConnConfiguration b, BackendSourceKind b, BackendConfig b)
  (Maybe (SourceConfig b))
forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowCache m arr,
 ArrowWriter (Seq CollectedInfo) arr, MonadIO m,
 MonadResolveSource m, HasHttpManagerM m, BackendMetadata b) =>
arr
  (Dependency (HashMap SourceName InvalidationKey), SourceName,
   SourceConnConfiguration b, BackendSourceKind b, BackendConfig b)
  (Maybe (SourceConfig b))
getSourceConfigIfNeeded @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, BackendConfig b
_bcasmBackendConfig)
      case Maybe (SourceConfig b)
maybeSourceConfig of
        Maybe (SourceConfig b)
Nothing -> arr (Maybe (ResolvedSource b)) (Maybe (ResolvedSource b))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Maybe (ResolvedSource b)
forall a. Maybe a
Nothing
        Just SourceConfig b
sourceConfig ->
          (|
            forall a.
ErrorA QErr arr (a, ()) (ResolvedSource b)
-> arr (a, (MetadataObject, ())) (Maybe (ResolvedSource b))
forall (arr :: * -> * -> *) w e s a.
(ArrowChoice arr, ArrowWriter (Seq w) arr,
 AsInconsistentMetadata w) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
              ( ErrorA QErr arr (Either QErr (ResolvedSource b)) (ResolvedSource b)
forall (arr :: * -> * -> *) e a.
(ArrowChoice arr, ArrowError e arr) =>
arr (Either e a) a
liftEitherA ErrorA QErr arr (Either QErr (ResolvedSource b)) (ResolvedSource b)
-> ErrorA
     QErr
     arr
     (m (Either QErr (ResolvedSource b)))
     (Either QErr (ResolvedSource b))
-> ErrorA
     QErr arr (m (Either QErr (ResolvedSource b))) (ResolvedSource b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< ErrorA
  QErr
  arr
  (m (Either QErr (ResolvedSource b)))
  (Either QErr (ResolvedSource b))
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< SourceConfig b
-> SourceTypeCustomization -> m (Either QErr (ResolvedSource b))
logAndResolveDatabaseMetadata SourceConfig b
sourceConfig (SourceCustomization -> SourceTypeCustomization
getSourceTypeCustomization (SourceCustomization -> SourceTypeCustomization)
-> SourceCustomization -> SourceTypeCustomization
forall a b. (a -> b) -> a -> b
$ SourceMetadata b -> SourceCustomization
forall (b :: BackendType). SourceMetadata b -> SourceCustomization
_smCustomization SourceMetadata b
_bcasmSourceMetadata)
              )
          |) MetadataObject
metadataObj

    -- 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,
        MonadIO m,
        BackendMetadata b,
        HasServerConfigCtx m,
        MonadError QErr m,
        MonadBaseControl IO m
      ) =>
      (Proxy b, Bool, SourceConfig b) `arr` RecreateEventTriggers
    initCatalogIfNeeded :: arr (Proxy b, Bool, SourceConfig b) RecreateEventTriggers
initCatalogIfNeeded = arr (Proxy b, Bool, SourceConfig b) RecreateEventTriggers
-> arr (Proxy b, Bool, SourceConfig b) RecreateEventTriggers
forall (m :: * -> *) (arr :: * -> * -> *) a b.
(ArrowCache m arr, Cacheable a) =>
arr a b -> arr a b
Inc.cache proc (Proxy b
Proxy, Bool
atleastOneTrigger, SourceConfig b
sourceConfig) -> do
      (m RecreateEventTriggers -> m RecreateEventTriggers)
-> arr (m RecreateEventTriggers) RecreateEventTriggers
forall (m :: * -> *) (arr :: * -> * -> *) a b.
ArrowKleisli m arr =>
(a -> m b) -> arr a b
arrM m RecreateEventTriggers -> m RecreateEventTriggers
forall a. a -> a
id
        -< do
          if Bool
atleastOneTrigger
            then do
              MaintenanceMode ()
maintenanceMode <- ServerConfigCtx -> MaintenanceMode ()
_sccMaintenanceMode (ServerConfigCtx -> MaintenanceMode ())
-> m ServerConfigCtx -> m (MaintenanceMode ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ServerConfigCtx
forall (m :: * -> *). HasServerConfigCtx m => m ServerConfigCtx
askServerConfigCtx
              EventingMode
eventingMode <- ServerConfigCtx -> EventingMode
_sccEventingMode (ServerConfigCtx -> EventingMode)
-> m ServerConfigCtx -> m EventingMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ServerConfigCtx
forall (m :: * -> *). HasServerConfigCtx m => m ServerConfigCtx
askServerConfigCtx
              ReadOnlyMode
readOnlyMode <- ServerConfigCtx -> ReadOnlyMode
_sccReadOnlyMode (ServerConfigCtx -> ReadOnlyMode)
-> m ServerConfigCtx -> m ReadOnlyMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ServerConfigCtx
forall (m :: * -> *). HasServerConfigCtx m => m ServerConfigCtx
askServerConfigCtx

              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 -> m RecreateEventTriggers
forall (f :: * -> *) a. Applicative f => a -> f a
pure RecreateEventTriggers
RETDoNothing
                  -- 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 -> m RecreateEventTriggers
forall (f :: * -> *) a. Applicative f => a -> f a
pure RecreateEventTriggers
RETDoNothing
                  -- 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 -> m RecreateEventTriggers
forall (f :: * -> *) a. Applicative f => a -> f a
pure RecreateEventTriggers
RETDoNothing
                  | 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 -> m RecreateEventTriggers
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
                      (Either QErr RecreateEventTriggers -> m RecreateEventTriggers)
-> m (Either QErr RecreateEventTriggers) -> m RecreateEventTriggers
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RetryPolicyM m
-> (RetryStatus -> Either QErr RecreateEventTriggers -> m Bool)
-> (RetryStatus -> m (Either QErr RecreateEventTriggers))
-> m (Either QErr RecreateEventTriggers)
forall (m :: * -> *) b.
MonadIO m =>
RetryPolicyM m
-> (RetryStatus -> b -> m Bool) -> (RetryStatus -> m b) -> m b
Retry.retrying
                        ( Int -> RetryPolicyM 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 m -> RetryPolicyM m -> RetryPolicyM m
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicy
Retry.limitRetries Int
3
                        )
                        ((Either QErr RecreateEventTriggers -> m Bool)
-> RetryStatus -> Either QErr RecreateEventTriggers -> m Bool
forall a b. a -> b -> a
const ((Either QErr RecreateEventTriggers -> m Bool)
 -> RetryStatus -> Either QErr RecreateEventTriggers -> m Bool)
-> (Either QErr RecreateEventTriggers -> m Bool)
-> RetryStatus
-> Either QErr RecreateEventTriggers
-> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool)
-> (Either QErr RecreateEventTriggers -> Bool)
-> Either QErr RecreateEventTriggers
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either QErr RecreateEventTriggers -> Bool
forall a b. Either a b -> Bool
isLeft)
                        (m (Either QErr RecreateEventTriggers)
-> RetryStatus -> m (Either QErr RecreateEventTriggers)
forall a b. a -> b -> a
const (m (Either QErr RecreateEventTriggers)
 -> RetryStatus -> m (Either QErr RecreateEventTriggers))
-> m (Either QErr RecreateEventTriggers)
-> RetryStatus
-> m (Either QErr RecreateEventTriggers)
forall a b. (a -> b) -> a -> b
$ ExceptT QErr m RecreateEventTriggers
-> m (Either QErr RecreateEventTriggers)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr m RecreateEventTriggers
 -> m (Either QErr RecreateEventTriggers))
-> ExceptT QErr m RecreateEventTriggers
-> m (Either QErr RecreateEventTriggers)
forall a b. (a -> b) -> a -> b
$ SourceConfig b -> ExceptT QErr m RecreateEventTriggers
forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadIO m, MonadBaseControl IO m) =>
SourceConfig b -> ExceptT QErr m RecreateEventTriggers
prepareCatalog @b SourceConfig b
sourceConfig)
            else RecreateEventTriggers -> m RecreateEventTriggers
forall (f :: * -> *) a. Applicative f => a -> f a
pure RecreateEventTriggers
RETDoNothing

    buildSource ::
      forall b arr m.
      ( ArrowChoice arr,
        Inc.ArrowDistribute arr,
        Inc.ArrowCache m arr,
        ArrowWriter (Seq CollectedInfo) arr,
        HasServerConfigCtx m,
        MonadError QErr m,
        BackendMetadata b,
        GetAggregationPredicatesDeps b
      ) =>
      ( HashMap SourceName (AB.AnyBackend PartiallyResolvedSource),
        SourceMetadata b,
        SourceConfig b,
        HashMap (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)),
        HashMap (TableName b) (EventTriggerInfoMap b),
        DBTablesMetadata b,
        DBFunctionsMetadata b,
        RemoteSchemaMap,
        OrderedRoles
      )
        `arr` BackendSourceInfo
    buildSource :: arr
  (HashMap SourceName (AnyBackend PartiallyResolvedSource),
   SourceMetadata b, SourceConfig b,
   HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)),
   HashMap (TableName b) (EventTriggerInfoMap b), DBTablesMetadata b,
   DBFunctionsMetadata b, RemoteSchemaMap, OrderedRoles)
  BackendSourceInfo
buildSource = proc (HashMap SourceName (AnyBackend PartiallyResolvedSource)
allSources, SourceMetadata b
sourceMetadata, SourceConfig b
sourceConfig, HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
tablesRawInfo, HashMap (TableName b) (EventTriggerInfoMap b)
eventTriggerInfoMaps, DBTablesMetadata b
_dbTables, DBFunctionsMetadata b
dbFunctions, RemoteSchemaMap
remoteSchemaMap, OrderedRoles
orderedRoles) -> do
      let SourceMetadata SourceName
sourceName BackendSourceKind b
_backendKind Tables b
tables Functions b
functions SourceConnConfiguration b
_ Maybe QueryTagsConfig
queryTagsConfig SourceCustomization
sourceCustomization = SourceMetadata b
sourceMetadata
          tablesMetadata :: [TableMetadata b]
tablesMetadata = Tables b -> [TableMetadata b]
forall k v. InsOrdHashMap k v -> [v]
OMap.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 :: 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
M.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. (Eq k, Hashable k) => (a -> k) -> [a] -> HashMap k a
mapFromL NonColumnTableInputs b -> TableName b
forall (b :: BackendType). NonColumnTableInputs b -> TableName b
_nctiTable [NonColumnTableInputs b]
nonColumnInputs
      tableCoreInfos :: HashMap (TableName b) (TableCoreInfo b) <-
        (|
          forall a.
arr
  (a,
   (TableName b,
    ((TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
      NonColumnTableInputs b),
     ())))
  (TableCoreInfo b)
-> arr
     (a,
      (HashMap
         (TableName b)
         (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
          NonColumnTableInputs b),
       ()))
     (HashMap (TableName b) (TableCoreInfo b))
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Eq k, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed
            ( \TableName b
_ (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
tableRawInfo, NonColumnTableInputs b
nonColumnInput) -> do
                let columns :: FieldInfoMap (ColumnInfo b)
columns = 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)
tableRawInfo
                FieldInfoMap (FieldInfo b)
allFields :: FieldInfoMap (FieldInfo b) <- arr
  (HashMap SourceName (AnyBackend PartiallyResolvedSource),
   SourceName,
   HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)),
   FieldInfoMap (ColumnInfo b), RemoteSchemaMap,
   DBFunctionsMetadata b, NonColumnTableInputs b)
  (FieldInfoMap (FieldInfo b))
forall (b :: BackendType) (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, ArrowKleisli m arr,
 MonadError QErr m, BackendMetadata b) =>
arr
  (HashMap SourceName (AnyBackend PartiallyResolvedSource),
   SourceName,
   HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)),
   FieldInfoMap (ColumnInfo b), RemoteSchemaMap,
   DBFunctionsMetadata b, NonColumnTableInputs b)
  (FieldInfoMap (FieldInfo b))
addNonColumnFields -< (HashMap SourceName (AnyBackend PartiallyResolvedSource)
allSources, SourceName
sourceName, HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
tablesRawInfo, FieldInfoMap (ColumnInfo b)
columns, RemoteSchemaMap
remoteSchemaMap, DBFunctionsMetadata b
dbFunctions, NonColumnTableInputs b
nonColumnInput)
                arr (TableCoreInfo b) (TableCoreInfo b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
tableRawInfo {_tciFieldInfoMap :: FieldInfoMap (FieldInfo b)
_tciFieldInfoMap = FieldInfoMap (FieldInfo b)
allFields})
            )
          |) (HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
tablesRawInfo HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
-> HashMap (TableName b) (NonColumnTableInputs b)
-> HashMap
     (TableName b)
     (TableCoreInfoG b (ColumnInfo 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)

      Dependency (HashMap (TableName b) (TableCoreInfo b))
tableCoreInfosDep <- arr
  (HashMap (TableName b) (TableCoreInfo b))
  (Dependency (HashMap (TableName b) (TableCoreInfo b)))
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowCache m arr =>
arr a (Dependency a)
Inc.newDependency -< HashMap (TableName b) (TableCoreInfo b)
tableCoreInfos

      -- permissions
      HashMap (TableName b) (TableInfo b)
tableCache <-
        (|
          forall a.
arr
  (a,
   (TableName b,
    (((TableCoreInfo b, TablePermissionInputs b),
      EventTriggerInfoMap b),
     ())))
  (TableInfo b)
-> arr
     (a,
      (HashMap
         (TableName b)
         ((TableCoreInfo b, TablePermissionInputs b),
          EventTriggerInfoMap b),
       ()))
     (HashMap (TableName b) (TableInfo b))
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Eq k, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed
            ( \TableName b
_ ((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 <-
                  arr
  (Proxy b, SourceName,
   Dependency (HashMap (TableName b) (TableCoreInfo b)),
   FieldInfoMap (FieldInfo b), TablePermissionInputs b, OrderedRoles)
  (RolePermInfoMap b)
forall (b :: BackendType) (m :: * -> *) (arr :: * -> * -> *).
(ArrowChoice arr, ArrowDistribute arr, ArrowCache m arr,
 MonadError QErr m, ArrowWriter (Seq CollectedInfo) arr,
 BackendMetadata b, Cacheable (Proxy b),
 GetAggregationPredicatesDeps b) =>
arr
  (Proxy b, SourceName, Dependency (TableCoreCache b),
   FieldInfoMap (FieldInfo b), TablePermissionInputs b, OrderedRoles)
  (RolePermInfoMap b)
buildTablePermissions
                    -<
                      (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b, SourceName
sourceName, Dependency (HashMap (TableName b) (TableCoreInfo b))
tableCoreInfosDep, FieldInfoMap (FieldInfo b)
tableFields, TablePermissionInputs b
permissionInputs, OrderedRoles
orderedRoles)
                arr (TableInfo b) (TableInfo b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< 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)
            )
          |) (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. (Eq k, 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)

      !Maybe NamingCase
defaultNC <- arr (m (Maybe NamingCase)) (Maybe NamingCase)
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< ServerConfigCtx -> Maybe NamingCase
_sccDefaultNamingConvention (ServerConfigCtx -> Maybe NamingCase)
-> m ServerConfigCtx -> m (Maybe NamingCase)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ServerConfigCtx
forall (m :: * -> *). HasServerConfigCtx m => m ServerConfigCtx
askServerConfigCtx
      !Bool
isNamingConventionEnabled <- arr (m Bool) Bool
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< ((ExperimentalFeature
EFNamingConventions ExperimentalFeature -> HashSet ExperimentalFeature -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) (HashSet ExperimentalFeature -> Bool)
-> (ServerConfigCtx -> HashSet ExperimentalFeature)
-> ServerConfigCtx
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerConfigCtx -> HashSet ExperimentalFeature
_sccExperimentalFeatures) (ServerConfigCtx -> Bool) -> m ServerConfigCtx -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ServerConfigCtx
forall (m :: * -> *). HasServerConfigCtx m => m ServerConfigCtx
askServerConfigCtx

      -- sql functions
      HashMap (FunctionName b) (FunctionInfo b)
functionCache <-
        ((FunctionMetadata b -> FunctionName b)
-> [FunctionMetadata b]
-> HashMap (FunctionName b) (FunctionMetadata b)
forall k a. (Eq k, Hashable k) => (a -> k) -> [a] -> HashMap k a
mapFromL FunctionMetadata b -> FunctionName b
forall (b :: BackendType). FunctionMetadata b -> FunctionName b
_fmFunction (Functions b -> [FunctionMetadata b]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems Functions b
functions) >- arr
  (HashMap (FunctionName b) (FunctionMetadata b))
  (HashMap (FunctionName b) (FunctionMetadata b))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA)
          forall a.
arr (a, ()) (HashMap (FunctionName b) (FunctionMetadata b))
-> arr
     (a, (HashMap (FunctionName b) (FunctionMetadata b), ()))
     (HashMap (FunctionName b) (Maybe (FunctionInfo b)))
-> arr (a, ()) (HashMap (FunctionName b) (Maybe (FunctionInfo b)))
forall (arr :: * -> * -> *) e s a b.
Arrow arr =>
arr (e, s) a -> arr (e, (a, s)) b -> arr (e, s) b
>-> (|
                forall a.
arr
  (a, (FunctionName b, (FunctionMetadata b, ())))
  (Maybe (FunctionInfo b))
-> arr
     (a, (HashMap (FunctionName b) (FunctionMetadata b), ()))
     (HashMap (FunctionName b) (Maybe (FunctionInfo b)))
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Eq k, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed
                  ( \FunctionName b
_ (FunctionMetadata FunctionName b
qf FunctionConfig
config [FunctionPermissionInfo]
functionPermissions Maybe Text
comment) -> do
                      let systemDefined :: SystemDefined
systemDefined = Bool -> SystemDefined
SystemDefined Bool
False
                          definition :: Value
definition = TrackFunction b -> Value
forall a. ToJSON a => a -> Value
toJSON (TrackFunction b -> Value) -> TrackFunction b -> Value
forall a b. (a -> b) -> a -> b
$ FunctionName b -> TrackFunction b
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
$
                                    FunctionName b -> SourceMetadataObjId b
forall (b :: BackendType). FunctionName b -> SourceMetadataObjId b
SMOFunction @b FunctionName b
qf
                              )
                              Value
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
$
                                FunctionName b -> SourceObjId 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
                      (|
                        forall a.
ErrorA QErr arr (a, ()) (FunctionInfo b)
-> arr (a, (MetadataObject, ())) (Maybe (FunctionInfo b))
forall (arr :: * -> * -> *) w e s a.
(ArrowChoice arr, ArrowWriter (Seq w) arr,
 AsInconsistentMetadata w) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
                          ( (|
                              forall a.
ErrorA QErr arr (a, ()) (FunctionInfo b)
-> ErrorA QErr arr (a, (Text -> Text, ())) (FunctionInfo b)
forall (arr :: * -> * -> *) e s a.
ArrowError QErr arr =>
arr (e, s) a -> arr (e, (Text -> Text, s)) a
modifyErrA
                                ( do
                                    let funcDefs :: [RawFunctionInfo b]
funcDefs = [RawFunctionInfo b]
-> Maybe [RawFunctionInfo b] -> [RawFunctionInfo b]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [RawFunctionInfo b] -> [RawFunctionInfo b])
-> Maybe [RawFunctionInfo b] -> [RawFunctionInfo b]
forall a b. (a -> b) -> a -> b
$ FunctionName b
-> DBFunctionsMetadata b -> Maybe [RawFunctionInfo b]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup FunctionName b
qf DBFunctionsMetadata b
dbFunctions
                                    RawFunctionInfo b
rawfunctionInfo <- ErrorA QErr arr (m (RawFunctionInfo b)) (RawFunctionInfo b)
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr,
 MonadError e m) =>
arr (m a) a
bindErrorA -< FunctionName b -> [RawFunctionInfo b] -> m (RawFunctionInfo b)
forall (b :: BackendType) (m :: * -> *) a.
(QErrM m, Backend b) =>
FunctionName b -> [a] -> m a
handleMultipleFunctions @b FunctionName b
qf [RawFunctionInfo b]
funcDefs
                                    let metadataPermissions :: HashMap RoleName FunctionPermissionInfo
metadataPermissions = (FunctionPermissionInfo -> RoleName)
-> [FunctionPermissionInfo]
-> HashMap RoleName FunctionPermissionInfo
forall k a. (Eq k, 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
                                    let !namingConv :: NamingCase
namingConv = if Bool
isNamingConventionEnabled then SourceCustomization -> Maybe NamingCase -> NamingCase
getNamingConvention SourceCustomization
sourceCustomization Maybe NamingCase
defaultNC else NamingCase
HasuraCase
                                    (FunctionInfo b
functionInfo, SchemaDependency
dep) <- ErrorA
  QErr
  arr
  (m (FunctionInfo b, SchemaDependency))
  (FunctionInfo b, SchemaDependency)
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr,
 MonadError e m) =>
arr (m a) a
bindErrorA -< SourceName
-> FunctionName b
-> SystemDefined
-> FunctionConfig
-> HashMap RoleName FunctionPermissionInfo
-> RawFunctionInfo b
-> Maybe Text
-> NamingCase
-> m (FunctionInfo b, SchemaDependency)
forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadError QErr m) =>
SourceName
-> FunctionName b
-> SystemDefined
-> FunctionConfig
-> HashMap RoleName FunctionPermissionInfo
-> RawFunctionInfo b
-> Maybe Text
-> NamingCase
-> m (FunctionInfo b, SchemaDependency)
buildFunctionInfo SourceName
sourceName FunctionName b
qf SystemDefined
systemDefined FunctionConfig
config HashMap RoleName FunctionPermissionInfo
permissionsMap RawFunctionInfo b
rawfunctionInfo Maybe Text
comment NamingCase
namingConv
                                    ErrorA
  QErr arr (MetadataObject, SchemaObjId, [SchemaDependency]) ()
forall (arr :: * -> * -> *).
ArrowWriter (Seq CollectedInfo) arr =>
arr (MetadataObject, SchemaObjId, [SchemaDependency]) ()
recordDependencies -< (MetadataObject
metadataObject, SchemaObjId
schemaObject, [SchemaDependency
dep])
                                    ErrorA QErr arr (FunctionInfo b) (FunctionInfo b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< FunctionInfo b
functionInfo
                                )
                            |) Text -> Text
addFunctionContext
                          )
                        |) MetadataObject
metadataObject
                  )
              |)
          forall a.
arr (a, ()) (HashMap (FunctionName b) (Maybe (FunctionInfo b)))
-> arr
     (a, (HashMap (FunctionName b) (Maybe (FunctionInfo b)), ()))
     (HashMap (FunctionName b) (FunctionInfo b))
-> arr (a, ()) (HashMap (FunctionName b) (FunctionInfo b))
forall (arr :: * -> * -> *) e s a b.
Arrow arr =>
arr (e, s) a -> arr (e, (a, s)) b -> arr (e, s) b
>-> (\HashMap (FunctionName b) (Maybe (FunctionInfo b))
infos -> HashMap (FunctionName b) (Maybe (FunctionInfo b))
-> HashMap (FunctionName b) (FunctionInfo b)
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes HashMap (FunctionName b) (Maybe (FunctionInfo b))
infos >- arr
  (HashMap (FunctionName b) (FunctionInfo b))
  (HashMap (FunctionName b) (FunctionInfo b))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA)

      arr BackendSourceInfo BackendSourceInfo
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< SourceInfo b -> BackendSourceInfo
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceInfo b -> BackendSourceInfo)
-> SourceInfo b -> BackendSourceInfo
forall a b. (a -> b) -> a -> b
$ SourceName
-> HashMap (TableName b) (TableInfo b)
-> HashMap (FunctionName b) (FunctionInfo b)
-> SourceConfig b
-> Maybe QueryTagsConfig
-> SourceCustomization
-> SourceInfo b
forall (b :: BackendType).
SourceName
-> TableCache b
-> FunctionCache b
-> SourceConfig b
-> Maybe QueryTagsConfig
-> SourceCustomization
-> SourceInfo b
SourceInfo SourceName
sourceName HashMap (TableName b) (TableInfo b)
tableCache HashMap (FunctionName b) (FunctionInfo b)
functionCache SourceConfig b
sourceConfig Maybe QueryTagsConfig
queryTagsConfig SourceCustomization
sourceCustomization

    buildAndCollectInfo ::
      forall arr m.
      ( ArrowChoice arr,
        Inc.ArrowDistribute arr,
        Inc.ArrowCache m arr,
        ArrowWriter (Seq CollectedInfo) arr,
        MonadIO m,
        MonadError QErr m,
        MonadReader BuildReason m,
        MonadBaseControl IO m,
        HasHttpManagerM m,
        HasServerConfigCtx m,
        MonadResolveSource m
      ) =>
      (Metadata, Inc.Dependency InvalidationKeys) `arr` BuildOutputs
    buildAndCollectInfo :: arr (Metadata, Dependency InvalidationKeys) BuildOutputs
buildAndCollectInfo = proc (Metadata
metadata, Dependency InvalidationKeys
invalidationKeys) -> do
      let Metadata
            Sources
sources
            RemoteSchemas
remoteSchemas
            QueryCollections
collections
            MetadataAllowlist
metadataAllowlist
            CustomTypes
customTypes
            Actions
actions
            CronTriggers
cronTriggers
            InsOrdHashMap EndpointName CreateEndpoint
endpoints
            ApiLimit
apiLimits
            MetricsConfig
metricsConfig
            InheritedRoles
inheritedRoles
            SetGraphqlIntrospectionOptions
_introspectionDisabledRoles
            Network
networkConfig
            BackendMap BackendConfigWrapper
backendConfigs = Metadata
metadata
          backendConfigAndSourceMetadata :: InsOrdHashMap
  SourceName (AnyBackend BackendConfigAndSourceMetadata)
backendConfigAndSourceMetadata = BackendMap BackendConfigWrapper
-> Sources
-> InsOrdHashMap
     SourceName (AnyBackend BackendConfigAndSourceMetadata)
joinBackendConfigsToSources BackendMap BackendConfigWrapper
backendConfigs Sources
sources
          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]
OMap.elems Actions
actions
          remoteSchemaRoles :: [RoleName]
remoteSchemaRoles = (RemoteSchemaPermissionMetadata -> RoleName)
-> [RemoteSchemaPermissionMetadata] -> [RoleName]
forall a b. (a -> b) -> [a] -> [b]
map RemoteSchemaPermissionMetadata -> RoleName
_rspmRole ([RemoteSchemaPermissionMetadata] -> [RoleName])
-> (RemoteSchemaMetadata -> [RemoteSchemaPermissionMetadata])
-> RemoteSchemaMetadata
-> [RoleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteSchemaMetadata -> [RemoteSchemaPermissionMetadata]
_rsmPermissions (RemoteSchemaMetadata -> [RoleName])
-> [RemoteSchemaMetadata] -> [RoleName]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RemoteSchemas -> [RemoteSchemaMetadata]
forall k v. InsOrdHashMap k v -> [v]
OMap.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
$
                Sources -> [BackendSourceMetadata]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems Sources
sources [BackendSourceMetadata]
-> (BackendSourceMetadata -> [[RoleName]]) -> [[RoleName]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(BackendSourceMetadata AnyBackend SourceMetadata
e) ->
                  AnyBackend SourceMetadata
-> (forall (b :: BackendType).
    Backend b =>
    SourceMetadata b -> [[RoleName]])
-> [[RoleName]]
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 SourceConnConfiguration b
_ Maybe QueryTagsConfig
_ SourceCustomization
_) -> do
                    TableMetadata b
table <- Tables b -> [TableMetadata b]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems Tables b
tables
                    [RoleName] -> [[RoleName]]
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]
OMap.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]
OMap.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]
OMap.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]
OMap.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]
OMap.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)

          remoteSchemaPermissions :: [AddRemoteSchemaPermission]
remoteSchemaPermissions =
            let remoteSchemaPermsList :: [(RemoteSchemaName, [RemoteSchemaPermissionMetadata])]
remoteSchemaPermsList = InsOrdHashMap RemoteSchemaName [RemoteSchemaPermissionMetadata]
-> [(RemoteSchemaName, [RemoteSchemaPermissionMetadata])]
forall k v. InsOrdHashMap k v -> [(k, v)]
OMap.toList (InsOrdHashMap RemoteSchemaName [RemoteSchemaPermissionMetadata]
 -> [(RemoteSchemaName, [RemoteSchemaPermissionMetadata])])
-> InsOrdHashMap RemoteSchemaName [RemoteSchemaPermissionMetadata]
-> [(RemoteSchemaName, [RemoteSchemaPermissionMetadata])]
forall a b. (a -> b) -> a -> b
$ RemoteSchemaMetadata -> [RemoteSchemaPermissionMetadata]
_rsmPermissions (RemoteSchemaMetadata -> [RemoteSchemaPermissionMetadata])
-> RemoteSchemas
-> InsOrdHashMap RemoteSchemaName [RemoteSchemaPermissionMetadata]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RemoteSchemas
remoteSchemas
             in [[AddRemoteSchemaPermission]] -> [AddRemoteSchemaPermission]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[AddRemoteSchemaPermission]] -> [AddRemoteSchemaPermission])
-> [[AddRemoteSchemaPermission]] -> [AddRemoteSchemaPermission]
forall a b. (a -> b) -> a -> b
$
                  (((RemoteSchemaName, [RemoteSchemaPermissionMetadata])
  -> [AddRemoteSchemaPermission])
 -> [(RemoteSchemaName, [RemoteSchemaPermissionMetadata])]
 -> [[AddRemoteSchemaPermission]])
-> [(RemoteSchemaName, [RemoteSchemaPermissionMetadata])]
-> ((RemoteSchemaName, [RemoteSchemaPermissionMetadata])
    -> [AddRemoteSchemaPermission])
-> [[AddRemoteSchemaPermission]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((RemoteSchemaName, [RemoteSchemaPermissionMetadata])
 -> [AddRemoteSchemaPermission])
-> [(RemoteSchemaName, [RemoteSchemaPermissionMetadata])]
-> [[AddRemoteSchemaPermission]]
forall a b. (a -> b) -> [a] -> [b]
map [(RemoteSchemaName, [RemoteSchemaPermissionMetadata])]
remoteSchemaPermsList (((RemoteSchemaName, [RemoteSchemaPermissionMetadata])
  -> [AddRemoteSchemaPermission])
 -> [[AddRemoteSchemaPermission]])
-> ((RemoteSchemaName, [RemoteSchemaPermissionMetadata])
    -> [AddRemoteSchemaPermission])
-> [[AddRemoteSchemaPermission]]
forall a b. (a -> b) -> a -> b
$
                    ( \(RemoteSchemaName
remoteSchemaName, [RemoteSchemaPermissionMetadata]
remoteSchemaPerms) ->
                        ((RemoteSchemaPermissionMetadata -> AddRemoteSchemaPermission)
 -> [RemoteSchemaPermissionMetadata] -> [AddRemoteSchemaPermission])
-> [RemoteSchemaPermissionMetadata]
-> (RemoteSchemaPermissionMetadata -> AddRemoteSchemaPermission)
-> [AddRemoteSchemaPermission]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (RemoteSchemaPermissionMetadata -> AddRemoteSchemaPermission)
-> [RemoteSchemaPermissionMetadata] -> [AddRemoteSchemaPermission]
forall a b. (a -> b) -> [a] -> [b]
map [RemoteSchemaPermissionMetadata]
remoteSchemaPerms ((RemoteSchemaPermissionMetadata -> AddRemoteSchemaPermission)
 -> [AddRemoteSchemaPermission])
-> (RemoteSchemaPermissionMetadata -> AddRemoteSchemaPermission)
-> [AddRemoteSchemaPermission]
forall a b. (a -> b) -> a -> b
$ \(RemoteSchemaPermissionMetadata RoleName
role RemoteSchemaPermissionDefinition
defn Maybe Text
comment) ->
                          RemoteSchemaName
-> RoleName
-> RemoteSchemaPermissionDefinition
-> Maybe Text
-> AddRemoteSchemaPermission
AddRemoteSchemaPermission RemoteSchemaName
remoteSchemaName RoleName
role RemoteSchemaPermissionDefinition
defn Maybe Text
comment
                    )

      -- 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. (Eq k, 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 (t :: * -> *) a. Foldable t => t a -> [a]
toList HashSet RoleName
allRoleNames

      HashMap RoleName Role
resolvedInheritedRoles <- arr (HashSet RoleName, [Role]) (HashMap RoleName Role)
forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, ArrowCache m arr,
 MonadError QErr m) =>
arr (HashSet RoleName, [Role]) (HashMap RoleName Role)
buildInheritedRoles -< (HashSet RoleName
allRoleNames, InheritedRoles -> [Role]
forall k v. InsOrdHashMap k v -> [v]
OMap.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
`M.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]
M.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 IsLabel
  "_ikRemoteSchemas"
  (FieldS
     InvalidationKeys (HashMap RemoteSchemaName InvalidationKey))
Selector
  InvalidationKeys (HashMap RemoteSchemaName InvalidationKey)
#_ikRemoteSchemas Dependency InvalidationKeys
invalidationKeys
      HashMap
  RemoteSchemaName
  ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject)
remoteSchemaMap <- arr
  (Dependency (HashMap RemoteSchemaName InvalidationKey),
   [RemoteSchemaMetadata])
  (HashMap
     RemoteSchemaName
     ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject))
forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, ArrowCache m arr, MonadIO m,
 HasHttpManagerM m) =>
arr
  (Dependency (HashMap RemoteSchemaName InvalidationKey),
   [RemoteSchemaMetadata])
  (HashMap
     RemoteSchemaName
     ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject))
buildRemoteSchemas -< (Dependency (HashMap RemoteSchemaName InvalidationKey)
remoteSchemaInvalidationKeys, RemoteSchemas -> [RemoteSchemaMetadata]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems RemoteSchemas
remoteSchemas)
      let remoteSchemaCtxMap :: RemoteSchemaMap
remoteSchemaCtxMap = (((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject)
 -> RemoteSchemaCtx)
-> HashMap
     RemoteSchemaName
     ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject)
-> RemoteSchemaMap
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
M.map ((RemoteSchemaCtx, SchemaRemoteRelationships) -> RemoteSchemaCtx
forall a b. (a, b) -> a
fst ((RemoteSchemaCtx, SchemaRemoteRelationships) -> RemoteSchemaCtx)
-> (((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject)
    -> (RemoteSchemaCtx, SchemaRemoteRelationships))
-> ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject)
-> RemoteSchemaCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject)
-> (RemoteSchemaCtx, SchemaRemoteRelationships)
forall a b. (a, b) -> a
fst) HashMap
  RemoteSchemaName
  ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject)
remoteSchemaMap

      !Maybe NamingCase
defaultNC <- arr (m (Maybe NamingCase)) (Maybe NamingCase)
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< ServerConfigCtx -> Maybe NamingCase
_sccDefaultNamingConvention (ServerConfigCtx -> Maybe NamingCase)
-> m ServerConfigCtx -> m (Maybe NamingCase)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ServerConfigCtx
forall (m :: * -> *). HasServerConfigCtx m => m ServerConfigCtx
askServerConfigCtx
      !Bool
isNamingConventionEnabled <- arr (m Bool) Bool
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< ((ExperimentalFeature
EFNamingConventions ExperimentalFeature -> HashSet ExperimentalFeature -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) (HashSet ExperimentalFeature -> Bool)
-> (ServerConfigCtx -> HashSet ExperimentalFeature)
-> ServerConfigCtx
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerConfigCtx -> HashSet ExperimentalFeature
_sccExperimentalFeatures) (ServerConfigCtx -> Bool) -> m ServerConfigCtx -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ServerConfigCtx
forall (m :: * -> *). HasServerConfigCtx m => m ServerConfigCtx
askServerConfigCtx

      -- sources are build in two steps
      -- first we resolve them, and build the table cache
      HashMap SourceName (AnyBackend PartiallyResolvedSource)
partiallyResolvedSources <-
        (|
          forall a.
arr
  (a, (SourceName, (AnyBackend BackendConfigAndSourceMetadata, ())))
  (Maybe (AnyBackend PartiallyResolvedSource))
-> arr
     (a,
      (HashMap SourceName (AnyBackend BackendConfigAndSourceMetadata),
       ()))
     (HashMap SourceName (Maybe (AnyBackend PartiallyResolvedSource)))
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Eq k, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed
            ( \SourceName
_ AnyBackend BackendConfigAndSourceMetadata
exists ->
                (forall (b :: BackendType).
 (BackendMetadata b, BackendEventTrigger b) =>
 arr
   (BackendConfigAndSourceMetadata b,
    (Dependency InvalidationKeys, Maybe NamingCase, Bool))
   (Maybe (AnyBackend PartiallyResolvedSource)))
-> arr
     (AnyBackend BackendConfigAndSourceMetadata,
      (Dependency InvalidationKeys, Maybe NamingCase, Bool))
     (Maybe (AnyBackend PartiallyResolvedSource))
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 (BackendConfigAndSourceMetadata b
backendConfigAndSourceMetadata, (invalidationKeys, defaultNC, isNamingConventionEnabled)) -> do
                      let sourceMetadata :: SourceMetadata b
sourceMetadata = BackendConfigAndSourceMetadata b -> SourceMetadata b
forall (b :: BackendType).
BackendConfigAndSourceMetadata b -> SourceMetadata b
_bcasmSourceMetadata BackendConfigAndSourceMetadata b
backendConfigAndSourceMetadata
                          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 IsLabel
  "_ikSources"
  (FieldS InvalidationKeys (HashMap SourceName InvalidationKey))
Selector InvalidationKeys (HashMap SourceName InvalidationKey)
#_ikSources Dependency InvalidationKeys
invalidationKeys
                      Maybe (ResolvedSource b)
maybeResolvedSource <- arr
  (Dependency (HashMap SourceName InvalidationKey),
   BackendConfigAndSourceMetadata b)
  (Maybe (ResolvedSource b))
forall (b :: BackendType) (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowCache m arr,
 ArrowWriter (Seq CollectedInfo) arr, MonadIO m,
 MonadBaseControl IO m, MonadResolveSource m, HasHttpManagerM m,
 BackendMetadata b) =>
arr
  (Dependency (HashMap SourceName InvalidationKey),
   BackendConfigAndSourceMetadata b)
  (Maybe (ResolvedSource b))
resolveSourceIfNeeded -< (Dependency (HashMap SourceName InvalidationKey)
sourceInvalidationsKeys, BackendConfigAndSourceMetadata b
backendConfigAndSourceMetadata)
                      case Maybe (ResolvedSource b)
maybeResolvedSource of
                        Maybe (ResolvedSource 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 (ResolvedSource b
source :: ResolvedSource b) -> 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 IsLabel "_ikMetadata" (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]
OMap.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
                              !namingConv :: NamingCase
namingConv = if Bool
isNamingConventionEnabled then SourceCustomization -> Maybe NamingCase -> NamingCase
getNamingConvention (SourceMetadata b -> SourceCustomization
forall (b :: BackendType). SourceMetadata b -> SourceCustomization
_smCustomization SourceMetadata b
sourceMetadata) Maybe NamingCase
defaultNC else NamingCase
HasuraCase
                          HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
tablesCoreInfo <-
                            arr
  (SourceName, SourceConfig b,
   HashMap (TableName b) (DBTableMetadata b), [TableBuildInput b],
   Dependency InvalidationKey, NamingCase)
  (HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)))
forall (arr :: * -> * -> *) (m :: * -> *) (b :: BackendType).
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, ArrowCache m arr, MonadIO m,
 MonadBaseControl IO m, BackendMetadata b) =>
arr
  (SourceName, SourceConfig b, DBTablesMetadata b,
   [TableBuildInput b], Dependency InvalidationKey, NamingCase)
  (HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)))
buildTableCache
                              -<
                                ( SourceName
sourceName,
                                  ResolvedSource b -> SourceConfig b
forall (b :: BackendType). ResolvedSource b -> SourceConfig b
_rsConfig ResolvedSource b
source,
                                  ResolvedSource b -> HashMap (TableName b) (DBTableMetadata b)
forall (b :: BackendType). ResolvedSource b -> DBTablesMetadata b
_rsTables ResolvedSource b
source,
                                  [TableBuildInput b]
tableInputs,
                                  Dependency InvalidationKey
metadataInvalidationKey,
                                  NamingCase
namingConv
                                )

                          let tablesMetadata :: [TableMetadata b]
tablesMetadata = InsOrdHashMap (TableName b) (TableMetadata b) -> [TableMetadata b]
forall k v. InsOrdHashMap k v -> [v]
OMap.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 (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]
OMap.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
                              numEventTriggers :: Int
numEventTriggers = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((TableName b, [EventTriggerConf b]) -> Int)
-> [(TableName b, [EventTriggerConf b])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([EventTriggerConf b] -> 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
                              sourceConfig :: SourceConfig b
sourceConfig = ResolvedSource b -> SourceConfig b
forall (b :: BackendType). ResolvedSource b -> SourceConfig b
_rsConfig ResolvedSource b
source

                          RecreateEventTriggers
recreateEventTriggers <- arr (Proxy b, Bool, SourceConfig b) RecreateEventTriggers
forall (b :: BackendType) (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowCache m arr, MonadIO m, BackendMetadata b,
 HasServerConfigCtx m, MonadError QErr m, MonadBaseControl IO m) =>
arr (Proxy b, Bool, SourceConfig b) RecreateEventTriggers
initCatalogIfNeeded -< (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b, Int
numEventTriggers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0, SourceConfig b
sourceConfig)

                          let alignTableMap :: HashMap (TableName b) a -> HashMap (TableName b) c -> HashMap (TableName b) (a, c)
                              alignTableMap :: 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
M.intersectionWith (,)

                          HashMap (TableName b) (EventTriggerInfoMap b)
eventTriggerInfoMaps <-
                            (|
                              forall a.
arr
  (a,
   (TableName b,
    ((TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
      (TableName b, [EventTriggerConf b])),
     ())))
  (EventTriggerInfoMap b)
-> arr
     (a,
      (HashMap
         (TableName b)
         (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
          (TableName b, [EventTriggerConf b])),
       ()))
     (HashMap (TableName b) (EventTriggerInfoMap b))
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Eq k, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed
                                ( \TableName b
_ (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
tableCoreInfo, (TableName b
_, [EventTriggerConf b]
eventTriggerConfs)) ->
                                    arr
  (SourceName, SourceConfig b,
   TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
   [EventTriggerConf b], Dependency InvalidationKey,
   RecreateEventTriggers)
  (EventTriggerInfoMap b)
forall (arr :: * -> * -> *) (m :: * -> *) (b :: BackendType).
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, ArrowCache m arr, MonadIO m,
 MonadError QErr m, MonadBaseControl IO m,
 MonadReader BuildReason m, HasServerConfigCtx m, BackendMetadata b,
 BackendEventTrigger b) =>
arr
  (SourceName, SourceConfig b,
   TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
   [EventTriggerConf b], Dependency InvalidationKey,
   RecreateEventTriggers)
  (EventTriggerInfoMap b)
buildTableEventTriggers -< (SourceName
sourceName, SourceConfig b
sourceConfig, TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
tableCoreInfo, [EventTriggerConf b]
eventTriggerConfs, Dependency InvalidationKey
metadataInvalidationKey, RecreateEventTriggers
recreateEventTriggers)
                                )
                              |) (HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
tablesCoreInfo HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
-> HashMap (TableName b) (TableName b, [EventTriggerConf b])
-> HashMap
     (TableName b)
     (TableCoreInfoG b (ColumnInfo 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. (Eq k, 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
forall (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
-> ResolvedSource b
-> HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
-> HashMap (TableName b) (EventTriggerInfoMap b)
-> PartiallyResolvedSource b
forall (b :: BackendType).
SourceMetadata b
-> ResolvedSource b
-> HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
-> HashMap (TableName b) (EventTriggerInfoMap b)
-> PartiallyResolvedSource b
PartiallyResolvedSource SourceMetadata b
sourceMetadata ResolvedSource b
source HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
tablesCoreInfo HashMap (TableName b) (EventTriggerInfoMap b)
eventTriggerInfoMaps
                  )
                  -<
                    (AnyBackend BackendConfigAndSourceMetadata
exists, (Dependency InvalidationKeys
invalidationKeys, Maybe NamingCase
defaultNC, Bool
isNamingConventionEnabled))
            )
        |) ([(SourceName, AnyBackend BackendConfigAndSourceMetadata)]
-> HashMap SourceName (AnyBackend BackendConfigAndSourceMetadata)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(SourceName, AnyBackend BackendConfigAndSourceMetadata)]
 -> HashMap SourceName (AnyBackend BackendConfigAndSourceMetadata))
-> [(SourceName, AnyBackend BackendConfigAndSourceMetadata)]
-> HashMap SourceName (AnyBackend BackendConfigAndSourceMetadata)
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap
  SourceName (AnyBackend BackendConfigAndSourceMetadata)
-> [(SourceName, AnyBackend BackendConfigAndSourceMetadata)]
forall k v. InsOrdHashMap k v -> [(k, v)]
OMap.toList InsOrdHashMap
  SourceName (AnyBackend BackendConfigAndSourceMetadata)
backendConfigAndSourceMetadata)
          forall a.
arr
  (a, ())
  (HashMap SourceName (Maybe (AnyBackend PartiallyResolvedSource)))
-> arr
     (a,
      (HashMap SourceName (Maybe (AnyBackend PartiallyResolvedSource)),
       ()))
     (HashMap SourceName (AnyBackend PartiallyResolvedSource))
-> arr
     (a, ()) (HashMap SourceName (AnyBackend PartiallyResolvedSource))
forall (arr :: * -> * -> *) e s a b.
Arrow arr =>
arr (e, s) a -> arr (e, (a, s)) b -> arr (e, s) b
>-> (\HashMap SourceName (Maybe (AnyBackend PartiallyResolvedSource))
infos -> HashMap SourceName (Maybe (AnyBackend PartiallyResolvedSource))
-> HashMap SourceName (AnyBackend PartiallyResolvedSource)
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes HashMap SourceName (Maybe (AnyBackend PartiallyResolvedSource))
infos >- arr
  (HashMap SourceName (AnyBackend PartiallyResolvedSource))
  (HashMap SourceName (AnyBackend PartiallyResolvedSource))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA)

      -- 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 (BackendSourceInfo, BackendMap ScalarMap)
sourcesOutput <-
        (|
          forall a.
arr
  (a, (SourceName, (AnyBackend PartiallyResolvedSource, ())))
  (BackendSourceInfo, BackendMap ScalarMap)
-> arr
     (a, (HashMap SourceName (AnyBackend PartiallyResolvedSource), ()))
     (HashMap SourceName (BackendSourceInfo, BackendMap ScalarMap))
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Eq k, 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 (b :: BackendType).
 (BackendMetadata b, GetAggregationPredicatesDeps b) =>
 arr
   (PartiallyResolvedSource b,
    (HashMap SourceName (AnyBackend PartiallyResolvedSource),
     RemoteSchemaMap, OrderedRoles))
   (BackendSourceInfo, BackendMap ScalarMap))
-> arr
     (AnyBackend PartiallyResolvedSource,
      (HashMap SourceName (AnyBackend PartiallyResolvedSource),
       RemoteSchemaMap, OrderedRoles))
     (BackendSourceInfo, BackendMap ScalarMap)
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 :: PartiallyResolvedSource b,
                        (allResolvedSources, remoteSchemaCtxMap, orderedRoles)
                        )
                    -> do
                      let PartiallyResolvedSource SourceMetadata b
sourceMetadata ResolvedSource b
resolvedSource HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
tablesInfo HashMap (TableName b) (EventTriggerInfoMap b)
eventTriggers = PartiallyResolvedSource b
partiallyResolvedSource
                          ResolvedSource SourceConfig b
sourceConfig SourceTypeCustomization
_sourceCustomization DBTablesMetadata b
tablesMeta DBFunctionsMetadata b
functionsMeta ScalarMap b
scalars = ResolvedSource b
resolvedSource
                      BackendSourceInfo
so <-
                        arr
  (HashMap SourceName (AnyBackend PartiallyResolvedSource),
   SourceMetadata b, SourceConfig b,
   HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)),
   HashMap (TableName b) (EventTriggerInfoMap b), DBTablesMetadata b,
   DBFunctionsMetadata b, RemoteSchemaMap, OrderedRoles)
  BackendSourceInfo
forall (b :: BackendType) (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowDistribute arr, ArrowCache m arr,
 ArrowWriter (Seq CollectedInfo) arr, HasServerConfigCtx m,
 MonadError QErr m, BackendMetadata b,
 GetAggregationPredicatesDeps b) =>
arr
  (HashMap SourceName (AnyBackend PartiallyResolvedSource),
   SourceMetadata b, SourceConfig b,
   HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)),
   HashMap (TableName b) (EventTriggerInfoMap b), DBTablesMetadata b,
   DBFunctionsMetadata b, RemoteSchemaMap, OrderedRoles)
  BackendSourceInfo
buildSource
                          -<
                            ( HashMap SourceName (AnyBackend PartiallyResolvedSource)
allResolvedSources,
                              SourceMetadata b
sourceMetadata,
                              SourceConfig b
sourceConfig,
                              HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
tablesInfo,
                              HashMap (TableName b) (EventTriggerInfoMap b)
eventTriggers,
                              DBTablesMetadata b
tablesMeta,
                              DBFunctionsMetadata b
functionsMeta,
                              RemoteSchemaMap
remoteSchemaCtxMap,
                              OrderedRoles
orderedRoles
                            )
                      arr
  (BackendSourceInfo, BackendMap ScalarMap)
  (BackendSourceInfo, BackendMap ScalarMap)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (BackendSourceInfo
so, ScalarMap b -> BackendMap ScalarMap
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> BackendMap i
BackendMap.singleton ScalarMap b
scalars)
                  )
                  -<
                    ( AnyBackend PartiallyResolvedSource
exists,
                      (HashMap SourceName (AnyBackend PartiallyResolvedSource)
partiallyResolvedSources, RemoteSchemaMap
remoteSchemaCtxMap, OrderedRoles
orderedRoles)
                    )
            )
          |) HashMap SourceName (AnyBackend PartiallyResolvedSource)
partiallyResolvedSources

      HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
remoteSchemaCache <-
        (HashMap
  RemoteSchemaName
  ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject)
remoteSchemaMap >- arr
  (HashMap
     RemoteSchemaName
     ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject))
  (HashMap
     RemoteSchemaName
     ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA)
          forall a.
arr
  (a, ())
  (HashMap
     RemoteSchemaName
     ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject))
-> arr
     (a,
      (HashMap
         RemoteSchemaName
         ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject),
       ()))
     (HashMap
        RemoteSchemaName
        (((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject),
         [AddRemoteSchemaPermission]))
-> arr
     (a, ())
     (HashMap
        RemoteSchemaName
        (((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject),
         [AddRemoteSchemaPermission]))
forall (arr :: * -> * -> *) e s a b.
Arrow arr =>
arr (e, s) a -> arr (e, (a, s)) b -> arr (e, s) b
>-> ( \HashMap
  RemoteSchemaName
  ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject)
info ->
                  (HashMap
  RemoteSchemaName
  ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject)
info, (AddRemoteSchemaPermission -> RemoteSchemaName)
-> [AddRemoteSchemaPermission]
-> HashMap RemoteSchemaName [AddRemoteSchemaPermission]
forall k (t :: * -> *) v.
(Eq k, Hashable k, Foldable t) =>
(v -> k) -> t v -> HashMap k [v]
M.groupOn AddRemoteSchemaPermission -> RemoteSchemaName
_arspRemoteSchema [AddRemoteSchemaPermission]
remoteSchemaPermissions)
                    >-
                      (AddRemoteSchemaPermission -> MetadataObject)
-> arr
     (HashMap
        RemoteSchemaName
        ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject),
      HashMap RemoteSchemaName [AddRemoteSchemaPermission])
     (HashMap
        RemoteSchemaName
        (((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject),
         [AddRemoteSchemaPermission]))
forall a b (arr :: * -> * -> *).
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr) =>
(b -> MetadataObject)
-> arr
     (HashMap RemoteSchemaName a, HashMap RemoteSchemaName [b])
     (HashMap RemoteSchemaName (a, [b]))
alignExtraRemoteSchemaInfo AddRemoteSchemaPermission -> MetadataObject
mkRemoteSchemaPermissionMetadataObject
              )
          forall a.
arr
  (a, ())
  (HashMap
     RemoteSchemaName
     (((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject),
      [AddRemoteSchemaPermission]))
-> arr
     (a,
      (HashMap
         RemoteSchemaName
         (((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject),
          [AddRemoteSchemaPermission]),
       ()))
     (HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject))
-> arr
     (a, ())
     (HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject))
forall (arr :: * -> * -> *) e s a b.
Arrow arr =>
arr (e, s) a -> arr (e, (a, s)) b -> arr (e, s) b
>-> (|
                forall a.
arr
  (a,
   (RemoteSchemaName,
    ((((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject),
      [AddRemoteSchemaPermission]),
     ())))
  (RemoteSchemaCtx, MetadataObject)
-> arr
     (a,
      (HashMap
         RemoteSchemaName
         (((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject),
          [AddRemoteSchemaPermission]),
       ()))
     (HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject))
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Eq k, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed
                  ( \RemoteSchemaName
_ (((RemoteSchemaCtx
remoteSchemaCtx, SchemaRemoteRelationships
relationships), MetadataObject
metadataObj), [AddRemoteSchemaPermission]
remoteSchemaPerms) -> do
                      HashMap RoleName IntrospectionResult
metadataPermissionsMap <-
                        arr
  (RemoteSchemaCtx, [AddRemoteSchemaPermission])
  (HashMap RoleName IntrospectionResult)
forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, ArrowCache m arr,
 MonadError QErr m) =>
arr
  (RemoteSchemaCtx, [AddRemoteSchemaPermission])
  (HashMap RoleName IntrospectionResult)
buildRemoteSchemaPermissions -< (RemoteSchemaCtx
remoteSchemaCtx, [AddRemoteSchemaPermission]
remoteSchemaPerms)
                      -- convert to the intermediate form `CheckPermission` whose `Semigroup`
                      -- instance is used to combine permissions
                      let metadataCheckPermissionsMap :: HashMap RoleName (CheckPermission IntrospectionResult)
metadataCheckPermissionsMap = IntrospectionResult -> CheckPermission IntrospectionResult
forall permissionType.
permissionType -> CheckPermission permissionType
CPDefined (IntrospectionResult -> CheckPermission IntrospectionResult)
-> HashMap RoleName IntrospectionResult
-> HashMap RoleName (CheckPermission IntrospectionResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap RoleName IntrospectionResult
metadataPermissionsMap
                      HashMap RoleName (CheckPermission IntrospectionResult)
allRolesUnresolvedPermissionsMap <-
                        arr
  (m (HashMap RoleName (CheckPermission IntrospectionResult)))
  (HashMap RoleName (CheckPermission IntrospectionResult))
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA
                          -<
                            (HashMap RoleName (CheckPermission IntrospectionResult)
 -> Role
 -> m (HashMap RoleName (CheckPermission IntrospectionResult)))
-> HashMap RoleName (CheckPermission IntrospectionResult)
-> [Role]
-> m (HashMap RoleName (CheckPermission IntrospectionResult))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
                              ( \HashMap RoleName (CheckPermission IntrospectionResult)
accumulatedRolePermMap (Role RoleName
roleName (ParentRoles HashSet RoleName
parentRoles)) -> do
                                  CheckPermission IntrospectionResult
rolePermission <- Maybe (CheckPermission IntrospectionResult)
-> m (CheckPermission IntrospectionResult)
-> m (CheckPermission IntrospectionResult)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (RoleName
-> HashMap RoleName (CheckPermission IntrospectionResult)
-> Maybe (CheckPermission IntrospectionResult)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup RoleName
roleName HashMap RoleName (CheckPermission IntrospectionResult)
accumulatedRolePermMap) (m (CheckPermission IntrospectionResult)
 -> m (CheckPermission IntrospectionResult))
-> m (CheckPermission IntrospectionResult)
-> m (CheckPermission IntrospectionResult)
forall a b. (a -> b) -> a -> b
$ do
                                    [CheckPermission IntrospectionResult]
parentRolePermissions <-
                                      [RoleName]
-> (RoleName -> m (CheckPermission IntrospectionResult))
-> m [CheckPermission IntrospectionResult]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (HashSet RoleName -> [RoleName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList HashSet RoleName
parentRoles) ((RoleName -> m (CheckPermission IntrospectionResult))
 -> m [CheckPermission IntrospectionResult])
-> (RoleName -> m (CheckPermission IntrospectionResult))
-> m [CheckPermission IntrospectionResult]
forall a b. (a -> b) -> a -> b
$ \RoleName
role ->
                                        Maybe (CheckPermission IntrospectionResult)
-> m (CheckPermission IntrospectionResult)
-> m (CheckPermission IntrospectionResult)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (RoleName
-> HashMap RoleName (CheckPermission IntrospectionResult)
-> Maybe (CheckPermission IntrospectionResult)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup RoleName
role HashMap RoleName (CheckPermission IntrospectionResult)
accumulatedRolePermMap) (m (CheckPermission IntrospectionResult)
 -> m (CheckPermission IntrospectionResult))
-> m (CheckPermission IntrospectionResult)
-> m (CheckPermission IntrospectionResult)
forall a b. (a -> b) -> a -> b
$
                                          Text -> m (CheckPermission IntrospectionResult)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m (CheckPermission IntrospectionResult))
-> Text -> m (CheckPermission IntrospectionResult)
forall a b. (a -> b) -> a -> b
$
                                            Text
"remote schema permissions: bad ordering of roles, could not find the permission of role: " Text -> RoleName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> RoleName
role
                                    let combinedPermission :: Maybe (CheckPermission IntrospectionResult)
combinedPermission = NonEmpty (CheckPermission IntrospectionResult)
-> CheckPermission IntrospectionResult
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty (CheckPermission IntrospectionResult)
 -> CheckPermission IntrospectionResult)
-> Maybe (NonEmpty (CheckPermission IntrospectionResult))
-> Maybe (CheckPermission IntrospectionResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CheckPermission IntrospectionResult]
-> Maybe (NonEmpty (CheckPermission IntrospectionResult))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [CheckPermission IntrospectionResult]
parentRolePermissions
                                    CheckPermission IntrospectionResult
-> m (CheckPermission IntrospectionResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CheckPermission IntrospectionResult
 -> m (CheckPermission IntrospectionResult))
-> CheckPermission IntrospectionResult
-> m (CheckPermission IntrospectionResult)
forall a b. (a -> b) -> a -> b
$ CheckPermission IntrospectionResult
-> Maybe (CheckPermission IntrospectionResult)
-> CheckPermission IntrospectionResult
forall a. a -> Maybe a -> a
fromMaybe CheckPermission IntrospectionResult
forall permissionType. CheckPermission permissionType
CPUndefined Maybe (CheckPermission IntrospectionResult)
combinedPermission
                                  HashMap RoleName (CheckPermission IntrospectionResult)
-> m (HashMap RoleName (CheckPermission IntrospectionResult))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap RoleName (CheckPermission IntrospectionResult)
 -> m (HashMap RoleName (CheckPermission IntrospectionResult)))
-> HashMap RoleName (CheckPermission IntrospectionResult)
-> m (HashMap RoleName (CheckPermission IntrospectionResult))
forall a b. (a -> b) -> a -> b
$ RoleName
-> CheckPermission IntrospectionResult
-> HashMap RoleName (CheckPermission IntrospectionResult)
-> HashMap RoleName (CheckPermission IntrospectionResult)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert RoleName
roleName CheckPermission IntrospectionResult
rolePermission HashMap RoleName (CheckPermission IntrospectionResult)
accumulatedRolePermMap
                              )
                              HashMap RoleName (CheckPermission IntrospectionResult)
metadataCheckPermissionsMap
                              (OrderedRoles -> [Role]
_unOrderedRoles OrderedRoles
orderedRoles)
                      -- traverse through `allRolesUnresolvedPermissionsMap` to record any inconsistencies (if exists)
                      [(RoleName, Maybe IntrospectionResult)]
resolvedPermissions <-
                        (|
                          forall a.
arr
  (a, ((RoleName, CheckPermission IntrospectionResult), ()))
  (RoleName, Maybe IntrospectionResult)
-> arr
     (a, ([(RoleName, CheckPermission IntrospectionResult)], ()))
     [(RoleName, Maybe IntrospectionResult)]
forall (arr :: * -> * -> *) (t :: * -> *) e a s b.
(ArrowChoice arr, Traversable t) =>
arr (e, (a, s)) b -> arr (e, (t a, s)) (t b)
traverseA
                            ( \(RoleName
roleName, CheckPermission IntrospectionResult
checkPermission) -> do
                                let inconsistentRoleEntity :: InconsistentRoleEntity
inconsistentRoleEntity = RemoteSchemaName -> InconsistentRoleEntity
InconsistentRemoteSchemaPermission (RemoteSchemaName -> InconsistentRoleEntity)
-> RemoteSchemaName -> InconsistentRoleEntity
forall a b. (a -> b) -> a -> b
$ RemoteSchemaCtx -> RemoteSchemaName
_rscName RemoteSchemaCtx
remoteSchemaCtx
                                Maybe IntrospectionResult
resolvedCheckPermission <- arr
  (Writer (Seq CollectedInfo) (Maybe IntrospectionResult))
  (Maybe IntrospectionResult)
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter -< CheckPermission IntrospectionResult
-> RoleName
-> InconsistentRoleEntity
-> Writer (Seq CollectedInfo) (Maybe IntrospectionResult)
forall (m :: * -> *) p.
MonadWriter (Seq CollectedInfo) m =>
CheckPermission p
-> RoleName -> InconsistentRoleEntity -> m (Maybe p)
resolveCheckPermission CheckPermission IntrospectionResult
checkPermission RoleName
roleName InconsistentRoleEntity
inconsistentRoleEntity
                                arr
  (RoleName, Maybe IntrospectionResult)
  (RoleName, Maybe IntrospectionResult)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (RoleName
roleName, Maybe IntrospectionResult
resolvedCheckPermission)
                            )
                          |) (HashMap RoleName (CheckPermission IntrospectionResult)
-> [(RoleName, CheckPermission IntrospectionResult)]
forall k v. HashMap k v -> [(k, v)]
M.toList HashMap RoleName (CheckPermission IntrospectionResult)
allRolesUnresolvedPermissionsMap)
                      let remoteSchemaIntrospection :: RemoteSchemaIntrospection
remoteSchemaIntrospection = IntrospectionResult -> RemoteSchemaIntrospection
irDoc (IntrospectionResult -> RemoteSchemaIntrospection)
-> IntrospectionResult -> RemoteSchemaIntrospection
forall a b. (a -> b) -> a -> b
$ RemoteSchemaCtx -> IntrospectionResult
_rscIntroOriginal RemoteSchemaCtx
remoteSchemaCtx
                      [(Name, InsOrdHashMap RelName (Maybe (RemoteFieldInfo Name)))]
resolvedRelationships <-
                        (|
                          forall a.
arr
  (a, ((Name, RemoteSchemaTypeRelationships), ()))
  (Name, InsOrdHashMap RelName (Maybe (RemoteFieldInfo Name)))
-> arr
     (a, ([(Name, RemoteSchemaTypeRelationships)], ()))
     [(Name, InsOrdHashMap RelName (Maybe (RemoteFieldInfo Name)))]
forall (arr :: * -> * -> *) (t :: * -> *) e a s b.
(ArrowChoice arr, Traversable t) =>
arr (e, (a, s)) b -> arr (e, (t a, s)) (t b)
traverseA
                            ( \(Name
typeName, RemoteSchemaTypeRelationships
typeRelationships) -> do
                                InsOrdHashMap RelName (Maybe (RemoteFieldInfo Name))
resolvedRelationships <-
                                  (|
                                    forall a.
arr (a, (RemoteRelationship, ())) (Maybe (RemoteFieldInfo Name))
-> arr
     (a, (InsOrdHashMap RelName RemoteRelationship, ()))
     (InsOrdHashMap RelName (Maybe (RemoteFieldInfo Name)))
forall (arr :: * -> * -> *) (t :: * -> *) e a s b.
(ArrowChoice arr, Traversable t) =>
arr (e, (a, s)) b -> arr (e, (t a, s)) (t b)
traverseA
                                      ( \RemoteRelationship
fromSchemaDef ->
                                          arr
  ((HashMap SourceName (AnyBackend PartiallyResolvedSource),
    RemoteSchemaMap),
   (RemoteSchemaName, RemoteSchemaIntrospection, Name,
    RemoteRelationship))
  (Maybe (RemoteFieldInfo Name))
forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowWriter (Seq CollectedInfo) arr,
 ArrowKleisli m arr, MonadError QErr m) =>
arr
  ((HashMap SourceName (AnyBackend PartiallyResolvedSource),
    RemoteSchemaMap),
   (RemoteSchemaName, RemoteSchemaIntrospection, Name,
    RemoteRelationship))
  (Maybe (RemoteFieldInfo Name))
buildRemoteSchemaRemoteRelationship
                                            -<
                                              ( (HashMap SourceName (AnyBackend PartiallyResolvedSource)
partiallyResolvedSources, RemoteSchemaMap
remoteSchemaCtxMap),
                                                (RemoteSchemaCtx -> RemoteSchemaName
_rscName RemoteSchemaCtx
remoteSchemaCtx, RemoteSchemaIntrospection
remoteSchemaIntrospection, Name
typeName, RemoteRelationship
fromSchemaDef)
                                              )
                                      )
                                    |) (RemoteSchemaTypeRelationships
-> InsOrdHashMap RelName RemoteRelationship
_rstrsRelationships RemoteSchemaTypeRelationships
typeRelationships)
                                arr
  (Name, InsOrdHashMap RelName (Maybe (RemoteFieldInfo Name)))
  (Name, InsOrdHashMap RelName (Maybe (RemoteFieldInfo Name)))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (Name
typeName, InsOrdHashMap RelName (Maybe (RemoteFieldInfo Name))
resolvedRelationships)
                            )
                          |) (SchemaRemoteRelationships
-> [(Name, RemoteSchemaTypeRelationships)]
forall k v. InsOrdHashMap k v -> [(k, v)]
OMap.toList SchemaRemoteRelationships
relationships)
                      arr
  (RemoteSchemaCtx, MetadataObject) (RemoteSchemaCtx, MetadataObject)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA
                        -<
                          ( RemoteSchemaCtx
remoteSchemaCtx
                              { _rscPermissions :: HashMap RoleName IntrospectionResult
_rscPermissions = HashMap RoleName (Maybe IntrospectionResult)
-> HashMap RoleName IntrospectionResult
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes (HashMap RoleName (Maybe IntrospectionResult)
 -> HashMap RoleName IntrospectionResult)
-> HashMap RoleName (Maybe IntrospectionResult)
-> HashMap RoleName IntrospectionResult
forall a b. (a -> b) -> a -> b
$ [(RoleName, Maybe IntrospectionResult)]
-> HashMap RoleName (Maybe IntrospectionResult)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(RoleName, Maybe IntrospectionResult)]
resolvedPermissions,
                                _rscRemoteRelationships :: RemoteSchemaRelationships
_rscRemoteRelationships = InsOrdHashMap RelName (Maybe (RemoteFieldInfo Name))
-> InsOrdHashMap RelName (RemoteFieldInfo Name)
forall k v. InsOrdHashMap k (Maybe v) -> InsOrdHashMap k v
OMap.catMaybes (InsOrdHashMap RelName (Maybe (RemoteFieldInfo Name))
 -> InsOrdHashMap RelName (RemoteFieldInfo Name))
-> InsOrdHashMap
     Name (InsOrdHashMap RelName (Maybe (RemoteFieldInfo Name)))
-> RemoteSchemaRelationships
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Name, InsOrdHashMap RelName (Maybe (RemoteFieldInfo Name)))]
-> InsOrdHashMap
     Name (InsOrdHashMap RelName (Maybe (RemoteFieldInfo Name)))
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
OMap.fromList [(Name, InsOrdHashMap RelName (Maybe (RemoteFieldInfo Name)))]
resolvedRelationships
                              },
                            MetadataObject
metadataObj
                          )
                  )
              |)

      -- allowlist
      let inlinedAllowlist :: InlinedAllowlist
inlinedAllowlist = QueryCollections -> MetadataAllowlist -> InlinedAllowlist
inlineAllowlist QueryCollections
collections MetadataAllowlist
metadataAllowlist

      HashMap EndpointName (EndpointMetadata GQLQueryWithText)
resolvedEndpoints <- ((EndpointName, CreateEndpoint) -> EndpointName)
-> ((EndpointName, CreateEndpoint) -> MetadataObject)
-> arr
     (QueryCollections, (EndpointName, CreateEndpoint))
     (Maybe (EndpointMetadata GQLQueryWithText))
-> arr
     (QueryCollections, [(EndpointName, CreateEndpoint)])
     (HashMap EndpointName (EndpointMetadata GQLQueryWithText))
forall (arr :: * -> * -> *) k a e b.
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, Eq k, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe b)
-> arr (e, [a]) (HashMap k b)
buildInfoMap (EndpointName, CreateEndpoint) -> EndpointName
forall a b. (a, b) -> a
fst (EndpointName, CreateEndpoint) -> MetadataObject
forall a. ToJSON a => (EndpointName, a) -> MetadataObject
mkEndpointMetadataObject arr
  (QueryCollections, (EndpointName, CreateEndpoint))
  (Maybe (EndpointMetadata GQLQueryWithText))
forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowKleisli m arr, MonadError QErr m,
 ArrowWriter (Seq CollectedInfo) arr) =>
arr
  (QueryCollections, (EndpointName, CreateEndpoint))
  (Maybe (EndpointMetadata GQLQueryWithText))
buildEndpoint -< (QueryCollections
collections, InsOrdHashMap EndpointName CreateEndpoint
-> [(EndpointName, CreateEndpoint)]
forall k v. InsOrdHashMap k v -> [(k, v)]
OMap.toList InsOrdHashMap EndpointName CreateEndpoint
endpoints)

      -- custom types
      let scalarsMap :: BackendMap ScalarMap
scalarsMap = [BackendMap ScalarMap] -> BackendMap ScalarMap
forall a. Monoid a => [a] -> a
mconcat ([BackendMap ScalarMap] -> BackendMap ScalarMap)
-> [BackendMap ScalarMap] -> BackendMap ScalarMap
forall a b. (a -> b) -> a -> b
$ ((BackendSourceInfo, BackendMap ScalarMap) -> BackendMap ScalarMap)
-> [(BackendSourceInfo, BackendMap ScalarMap)]
-> [BackendMap ScalarMap]
forall a b. (a -> b) -> [a] -> [b]
map (BackendSourceInfo, BackendMap ScalarMap) -> BackendMap ScalarMap
forall a b. (a, b) -> b
snd ([(BackendSourceInfo, BackendMap ScalarMap)]
 -> [BackendMap ScalarMap])
-> [(BackendSourceInfo, BackendMap ScalarMap)]
-> [BackendMap ScalarMap]
forall a b. (a -> b) -> a -> b
$ HashMap SourceName (BackendSourceInfo, BackendMap ScalarMap)
-> [(BackendSourceInfo, BackendMap ScalarMap)]
forall k v. HashMap k v -> [v]
M.elems HashMap SourceName (BackendSourceInfo, BackendMap ScalarMap)
sourcesOutput
          sourcesCache :: SourceCache
sourcesCache = ((BackendSourceInfo, BackendMap ScalarMap) -> BackendSourceInfo)
-> HashMap SourceName (BackendSourceInfo, BackendMap ScalarMap)
-> SourceCache
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
M.map (BackendSourceInfo, BackendMap ScalarMap) -> BackendSourceInfo
forall a b. (a, b) -> a
fst HashMap SourceName (BackendSourceInfo, BackendMap ScalarMap)
sourcesOutput
      Maybe AnnotatedCustomTypes
maybeResolvedCustomTypes <-
        (|
          forall a.
ErrorA QErr arr (a, ()) AnnotatedCustomTypes
-> arr (a, (MetadataObject, ())) (Maybe AnnotatedCustomTypes)
forall (arr :: * -> * -> *) w e s a.
(ArrowChoice arr, ArrowWriter (Seq w) arr,
 AsInconsistentMetadata w) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
            ( ErrorA QErr arr (m AnnotatedCustomTypes) AnnotatedCustomTypes
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr,
 MonadError e m) =>
arr (m a) a
bindErrorA -< SourceCache
-> CustomTypes -> BackendMap ScalarMap -> m AnnotatedCustomTypes
forall (m :: * -> *).
MonadError QErr m =>
SourceCache
-> CustomTypes -> BackendMap ScalarMap -> m AnnotatedCustomTypes
resolveCustomTypes SourceCache
sourcesCache CustomTypes
customTypes BackendMap ScalarMap
scalarsMap
            )
          |) (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)

      -- actions
      let actionList :: [ActionMetadata]
actionList = Actions -> [ActionMetadata]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems Actions
actions
      (ActionCache
actionCache, AnnotatedCustomTypes
annotatedCustomTypes) <- case Maybe AnnotatedCustomTypes
maybeResolvedCustomTypes of
        Just AnnotatedCustomTypes
resolvedCustomTypes -> do
          ActionCache
actionCache' <- arr
  ((AnnotatedCustomTypes, BackendMap ScalarMap, OrderedRoles),
   [ActionMetadata])
  ActionCache
forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowDistribute arr, ArrowCache m arr,
 ArrowWriter (Seq CollectedInfo) arr) =>
arr
  ((AnnotatedCustomTypes, BackendMap ScalarMap, OrderedRoles),
   [ActionMetadata])
  ActionCache
buildActions -< ((AnnotatedCustomTypes
resolvedCustomTypes, BackendMap ScalarMap
scalarsMap, OrderedRoles
orderedRoles), [ActionMetadata]
actionList)
          arr
  (ActionCache, AnnotatedCustomTypes)
  (ActionCache, AnnotatedCustomTypes)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (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
          arr ([MetadataObject], Text) ()
forall w (arr :: * -> * -> *).
(ArrowWriter (Seq w) arr, AsInconsistentMetadata w) =>
arr ([MetadataObject], Text) ()
recordInconsistencies
            -<
              ( (ActionMetadata -> MetadataObject)
-> [ActionMetadata] -> [MetadataObject]
forall a b. (a -> b) -> [a] -> [b]
map ActionMetadata -> MetadataObject
mkActionMetadataObject [ActionMetadata]
actionList,
                Text
"custom types are inconsistent"
              )
          arr
  (ActionCache, AnnotatedCustomTypes)
  (ActionCache, AnnotatedCustomTypes)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (ActionCache
forall a. Monoid a => a
mempty, AnnotatedCustomTypes
forall a. Monoid a => a
mempty)

      HashMap TriggerName CronTriggerInfo
cronTriggersMap <- arr
  ((), [CronTriggerMetadata]) (HashMap TriggerName CronTriggerInfo)
forall (arr :: * -> * -> *) (m :: * -> *).
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, ArrowCache m arr,
 MonadError QErr m) =>
arr
  ((), [CronTriggerMetadata]) (HashMap TriggerName CronTriggerInfo)
buildCronTriggers -< ((), CronTriggers -> [CronTriggerMetadata]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems CronTriggers
cronTriggers)

      arr BuildOutputs BuildOutputs
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA
        -<
          BuildOutputs :: SourceCache
-> ActionCache
-> HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
-> InlinedAllowlist
-> AnnotatedCustomTypes
-> HashMap TriggerName CronTriggerInfo
-> HashMap EndpointName (EndpointMetadata GQLQueryWithText)
-> ApiLimit
-> MetricsConfig
-> HashMap RoleName Role
-> [TlsAllow]
-> QueryCollections
-> BuildOutputs
BuildOutputs
            { _boSources :: SourceCache
_boSources = ((BackendSourceInfo, BackendMap ScalarMap) -> BackendSourceInfo)
-> HashMap SourceName (BackendSourceInfo, BackendMap ScalarMap)
-> SourceCache
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
M.map (BackendSourceInfo, BackendMap ScalarMap) -> BackendSourceInfo
forall a b. (a, b) -> a
fst HashMap SourceName (BackendSourceInfo, BackendMap ScalarMap)
sourcesOutput,
              _boActions :: ActionCache
_boActions = ActionCache
actionCache,
              _boRemoteSchemas :: HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
_boRemoteSchemas = HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
remoteSchemaCache,
              _boAllowlist :: InlinedAllowlist
_boAllowlist = InlinedAllowlist
inlinedAllowlist,
              _boCustomTypes :: AnnotatedCustomTypes
_boCustomTypes = AnnotatedCustomTypes
annotatedCustomTypes,
              _boCronTriggers :: HashMap TriggerName CronTriggerInfo
_boCronTriggers = HashMap TriggerName CronTriggerInfo
cronTriggersMap,
              _boEndpoints :: HashMap EndpointName (EndpointMetadata GQLQueryWithText)
_boEndpoints = HashMap EndpointName (EndpointMetadata GQLQueryWithText)
resolvedEndpoints,
              _boApiLimits :: ApiLimit
_boApiLimits = ApiLimit
apiLimits,
              _boMetricsConfig :: MetricsConfig
_boMetricsConfig = MetricsConfig
metricsConfig,
              _boRoles :: HashMap RoleName Role
_boRoles = (Role -> RoleName) -> [Role] -> HashMap RoleName Role
forall k a. (Eq k, 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,
              _boTlsAllowlist :: [TlsAllow]
_boTlsAllowlist = (Network -> [TlsAllow]
networkTlsAllowlist Network
networkConfig),
              _boQueryCollections :: QueryCollections
_boQueryCollections = QueryCollections
collections
            }

    mkEndpointMetadataObject :: (EndpointName, a) -> MetadataObject
mkEndpointMetadataObject (EndpointName
name, a
createEndpoint) =
      let objectId :: MetadataObjId
objectId = EndpointName -> MetadataObjId
MOEndpoint EndpointName
name
       in MetadataObjId -> Value -> MetadataObject
MetadataObject MetadataObjId
objectId (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
createEndpoint)

    buildEndpoint ::
      (ArrowChoice arr, ArrowKleisli m arr, MonadError QErr m, ArrowWriter (Seq CollectedInfo) arr) =>
      (InsOrdHashMap CollectionName CreateCollection, (EndpointName, CreateEndpoint)) `arr` Maybe (EndpointMetadata GQLQueryWithText)
    buildEndpoint :: arr
  (QueryCollections, (EndpointName, CreateEndpoint))
  (Maybe (EndpointMetadata GQLQueryWithText))
buildEndpoint = proc (QueryCollections
collections, e :: (EndpointName, CreateEndpoint)
e@(EndpointName
name, CreateEndpoint
createEndpoint)) -> do
      let endpoint :: CreateEndpoint
endpoint = CreateEndpoint
createEndpoint
          -- QueryReference collName queryName = _edQuery endpoint
          addContext :: Text -> Text
addContext Text
err = Text
"in endpoint " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NonEmptyText -> Text
forall a. ToTxt a => a -> Text
toTxt (EndpointName -> NonEmptyText
unEndpointName EndpointName
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
      (|
        forall a.
ErrorA QErr arr (a, ()) (EndpointMetadata GQLQueryWithText)
-> arr
     (a, (MetadataObject, ()))
     (Maybe (EndpointMetadata GQLQueryWithText))
forall (arr :: * -> * -> *) w e s a.
(ArrowChoice arr, ArrowWriter (Seq w) arr,
 AsInconsistentMetadata w) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
          ( (|
              forall a.
ErrorA QErr arr (a, ()) (EndpointMetadata GQLQueryWithText)
-> ErrorA
     QErr
     arr
     (a, (Text -> Text, ()))
     (EndpointMetadata GQLQueryWithText)
forall (arr :: * -> * -> *) e s a.
ArrowError QErr arr =>
arr (e, s) a -> arr (e, (Text -> Text, s)) a
modifyErrA
                (ErrorA
  QErr
  arr
  (m (EndpointMetadata GQLQueryWithText))
  (EndpointMetadata GQLQueryWithText)
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr,
 MonadError e m) =>
arr (m a) a
bindErrorA -< QueryCollections
-> CreateEndpoint -> m (EndpointMetadata GQLQueryWithText)
forall (m :: * -> *).
QErrM m =>
QueryCollections
-> CreateEndpoint -> m (EndpointMetadata GQLQueryWithText)
resolveEndpoint QueryCollections
collections CreateEndpoint
endpoint)
            |) Text -> Text
addContext
          )
        |) ((EndpointName, CreateEndpoint) -> MetadataObject
forall a. ToJSON a => (EndpointName, a) -> MetadataObject
mkEndpointMetadataObject (EndpointName, CreateEndpoint)
e)

    resolveEndpoint ::
      QErrM m =>
      InsOrdHashMap CollectionName CreateCollection ->
      EndpointMetadata QueryReference ->
      m (EndpointMetadata GQLQueryWithText)
    resolveEndpoint :: 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)
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
OMap.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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure GQLQueryWithText
lq

    mkEventTriggerMetadataObject ::
      forall b a c.
      Backend b =>
      (a, SourceName, c, TableName b, RecreateEventTriggers, EventTriggerConf b) ->
      MetadataObject
    mkEventTriggerMetadataObject :: (a, SourceName, c, TableName b, RecreateEventTriggers,
 EventTriggerConf b)
-> MetadataObject
mkEventTriggerMetadataObject (a
_, SourceName
source, c
_, TableName b
table, RecreateEventTriggers
_, 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
$
                TableName b -> TableMetadataObjId -> SourceMetadataObjId 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
.= TableName b
table, Key
"configuration" Key -> EventTriggerConf b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= 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)

    mkRemoteSchemaMetadataObject :: RemoteSchemaMetadata -> MetadataObject
mkRemoteSchemaMetadataObject RemoteSchemaMetadata
remoteSchema =
      MetadataObjId -> Value -> MetadataObject
MetadataObject (RemoteSchemaName -> MetadataObjId
MORemoteSchema (RemoteSchemaMetadata -> RemoteSchemaName
_rsmName RemoteSchemaMetadata
remoteSchema)) (RemoteSchemaMetadata -> Value
forall a. ToJSON a => a -> Value
toJSON RemoteSchemaMetadata
remoteSchema)

    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)

    alignExtraRemoteSchemaInfo ::
      forall a b arr.
      (ArrowChoice arr, Inc.ArrowDistribute arr, ArrowWriter (Seq CollectedInfo) arr) =>
      (b -> MetadataObject) ->
      ( M.HashMap RemoteSchemaName a,
        M.HashMap RemoteSchemaName [b]
      )
        `arr` M.HashMap RemoteSchemaName (a, [b])
    alignExtraRemoteSchemaInfo :: (b -> MetadataObject)
-> arr
     (HashMap RemoteSchemaName a, HashMap RemoteSchemaName [b])
     (HashMap RemoteSchemaName (a, [b]))
alignExtraRemoteSchemaInfo b -> MetadataObject
mkMetadataObject = proc (HashMap RemoteSchemaName a
baseInfo, HashMap RemoteSchemaName [b]
extraInfo) -> do
      HashMap RemoteSchemaName (Maybe (a, [b]))
combinedInfo <-
        (|
          forall a.
arr (a, (RemoteSchemaName, (These a [b], ()))) (Maybe (a, [b]))
-> arr
     (a, (HashMap RemoteSchemaName (These a [b]), ()))
     (HashMap RemoteSchemaName (Maybe (a, [b])))
forall (arr :: * -> * -> *) k e a s b.
(ArrowDistribute arr, Eq k, Hashable k) =>
arr (e, (k, (a, s))) b -> arr (e, (HashMap k a, s)) (HashMap k b)
Inc.keyed
            (\RemoteSchemaName
remoteSchemaName These a [b]
infos -> arr (RemoteSchemaName, These a [b]) (Maybe (a, [b]))
combine -< (RemoteSchemaName
remoteSchemaName, These a [b]
infos))
          |) (HashMap RemoteSchemaName a
-> HashMap RemoteSchemaName [b]
-> HashMap RemoteSchemaName (These a [b])
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align HashMap RemoteSchemaName a
baseInfo HashMap RemoteSchemaName [b]
extraInfo)
      arr
  (HashMap RemoteSchemaName (a, [b]))
  (HashMap RemoteSchemaName (a, [b]))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< HashMap RemoteSchemaName (Maybe (a, [b]))
-> HashMap RemoteSchemaName (a, [b])
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes HashMap RemoteSchemaName (Maybe (a, [b]))
combinedInfo
      where
        combine :: (RemoteSchemaName, These a [b]) `arr` Maybe (a, [b])
        combine :: arr (RemoteSchemaName, These a [b]) (Maybe (a, [b]))
combine = proc (RemoteSchemaName
remoteSchemaName, These a [b]
infos) -> case These a [b]
infos of
          This a
base -> arr (Maybe (a, [b])) (Maybe (a, [b]))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a, [b]) -> Maybe (a, [b])
forall a. a -> Maybe a
Just (a
base, [])
          These a
base [b]
extras -> arr (Maybe (a, [b])) (Maybe (a, [b]))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< (a, [b]) -> Maybe (a, [b])
forall a. a -> Maybe a
Just (a
base, [b]
extras)
          That [b]
extras -> do
            let errorMessage :: Text
errorMessage = Text
"remote schema  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoteSchemaName -> NonEmptyText
unRemoteSchemaName RemoteSchemaName
remoteSchemaName NonEmptyText -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"
            arr ([MetadataObject], Text) ()
forall w (arr :: * -> * -> *).
(ArrowWriter (Seq w) arr, AsInconsistentMetadata w) =>
arr ([MetadataObject], Text) ()
recordInconsistencies -< ((b -> MetadataObject) -> [b] -> [MetadataObject]
forall a b. (a -> b) -> [a] -> [b]
map b -> MetadataObject
mkMetadataObject [b]
extras, Text
errorMessage)
            arr (Maybe (a, [b])) (Maybe (a, [b]))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Maybe (a, [b])
forall a. Maybe a
Nothing

    buildRemoteSchemaPermissions ::
      ( ArrowChoice arr,
        Inc.ArrowDistribute arr,
        ArrowWriter (Seq CollectedInfo) arr,
        Inc.ArrowCache m arr,
        MonadError QErr m
      ) =>
      (RemoteSchemaCtx, [AddRemoteSchemaPermission]) `arr` M.HashMap RoleName IntrospectionResult
    buildRemoteSchemaPermissions :: arr
  (RemoteSchemaCtx, [AddRemoteSchemaPermission])
  (HashMap RoleName IntrospectionResult)
buildRemoteSchemaPermissions = (AddRemoteSchemaPermission -> RoleName)
-> (AddRemoteSchemaPermission -> MetadataObject)
-> arr
     (RemoteSchemaCtx, AddRemoteSchemaPermission)
     (Maybe IntrospectionResult)
-> arr
     (RemoteSchemaCtx, [AddRemoteSchemaPermission])
     (HashMap RoleName IntrospectionResult)
forall (arr :: * -> * -> *) k a e b.
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, Eq k, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe b)
-> arr (e, [a]) (HashMap k b)
buildInfoMap AddRemoteSchemaPermission -> RoleName
_arspRole AddRemoteSchemaPermission -> MetadataObject
mkRemoteSchemaPermissionMetadataObject arr
  (RemoteSchemaCtx, AddRemoteSchemaPermission)
  (Maybe IntrospectionResult)
buildRemoteSchemaPermission
      where
        buildRemoteSchemaPermission :: arr
  (RemoteSchemaCtx, AddRemoteSchemaPermission)
  (Maybe IntrospectionResult)
buildRemoteSchemaPermission = proc (RemoteSchemaCtx
remoteSchemaCtx, AddRemoteSchemaPermission
remoteSchemaPerm) -> do
          let AddRemoteSchemaPermission RemoteSchemaName
rsName RoleName
roleName RemoteSchemaPermissionDefinition
defn Maybe Text
_ = AddRemoteSchemaPermission
remoteSchemaPerm
              metadataObject :: MetadataObject
metadataObject = AddRemoteSchemaPermission -> MetadataObject
mkRemoteSchemaPermissionMetadataObject AddRemoteSchemaPermission
remoteSchemaPerm
              schemaObject :: SchemaObjId
schemaObject = RemoteSchemaName -> RoleName -> SchemaObjId
SORemoteSchemaPermission RemoteSchemaName
rsName RoleName
roleName
              providedSchemaDoc :: SchemaDocument
providedSchemaDoc = RemoteSchemaPermissionDefinition -> SchemaDocument
_rspdSchema RemoteSchemaPermissionDefinition
defn
              addPermContext :: Text -> Text
addPermContext Text
err = Text
"in remote schema permission for role " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName
roleName RoleName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
          (|
            forall a.
ErrorA QErr arr (a, ()) IntrospectionResult
-> arr (a, (MetadataObject, ())) (Maybe IntrospectionResult)
forall (arr :: * -> * -> *) w e s a.
(ArrowChoice arr, ArrowWriter (Seq w) arr,
 AsInconsistentMetadata w) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
              ( (|
                  forall a.
ErrorA QErr arr (a, ()) IntrospectionResult
-> ErrorA QErr arr (a, (Text -> Text, ())) IntrospectionResult
forall (arr :: * -> * -> *) e s a.
ArrowError QErr arr =>
arr (e, s) a -> arr (e, (Text -> Text, s)) a
modifyErrA
                    ( do
                        ErrorA QErr arr (m ()) ()
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr,
 MonadError e m) =>
arr (m a) a
bindErrorA
                          -<
                            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RoleName
roleName RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
adminRoleName) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                              Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ConstraintViolation (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"cannot define permission for admin role"
                        (IntrospectionResult
resolvedSchemaIntrospection, [SchemaDependency]
dependencies) <-
                          ErrorA
  QErr
  arr
  (m (IntrospectionResult, [SchemaDependency]))
  (IntrospectionResult, [SchemaDependency])
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr,
 MonadError e m) =>
arr (m a) a
bindErrorA -< SchemaDocument
-> RemoteSchemaCtx -> m (IntrospectionResult, [SchemaDependency])
forall (m :: * -> *).
MonadError QErr m =>
SchemaDocument
-> RemoteSchemaCtx -> m (IntrospectionResult, [SchemaDependency])
resolveRoleBasedRemoteSchema SchemaDocument
providedSchemaDoc RemoteSchemaCtx
remoteSchemaCtx
                        ErrorA
  QErr arr (MetadataObject, SchemaObjId, [SchemaDependency]) ()
forall (arr :: * -> * -> *).
ArrowWriter (Seq CollectedInfo) arr =>
arr (MetadataObject, SchemaObjId, [SchemaDependency]) ()
recordDependencies -< (MetadataObject
metadataObject, SchemaObjId
schemaObject, [SchemaDependency]
dependencies)
                        ErrorA QErr arr IntrospectionResult IntrospectionResult
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< IntrospectionResult
resolvedSchemaIntrospection
                    )
                |) Text -> Text
addPermContext
              )
            |) MetadataObject
metadataObject

    buildTableEventTriggers ::
      forall arr m b.
      ( ArrowChoice arr,
        Inc.ArrowDistribute arr,
        ArrowWriter (Seq CollectedInfo) arr,
        Inc.ArrowCache m arr,
        MonadIO m,
        MonadError QErr m,
        MonadBaseControl IO m,
        MonadReader BuildReason m,
        HasServerConfigCtx m,
        BackendMetadata b,
        BackendEventTrigger b
      ) =>
      ( SourceName,
        SourceConfig b,
        TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
        [EventTriggerConf b],
        Inc.Dependency Inc.InvalidationKey,
        RecreateEventTriggers
      )
        `arr` (EventTriggerInfoMap b)
    buildTableEventTriggers :: arr
  (SourceName, SourceConfig b,
   TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
   [EventTriggerConf b], Dependency InvalidationKey,
   RecreateEventTriggers)
  (EventTriggerInfoMap b)
buildTableEventTriggers = proc (SourceName
sourceName, SourceConfig b
sourceConfig, TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
tableInfo, [EventTriggerConf b]
eventTriggerConfs, Dependency InvalidationKey
metadataInvalidationKey, RecreateEventTriggers
migrationRecreateEventTriggers) ->
      ((Dependency InvalidationKey, SourceName, SourceConfig b,
  TableName b, RecreateEventTriggers, EventTriggerConf b)
 -> TriggerName)
-> ((Dependency InvalidationKey, SourceName, SourceConfig b,
     TableName b, RecreateEventTriggers, EventTriggerConf b)
    -> MetadataObject)
-> arr
     (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
      (Dependency InvalidationKey, SourceName, SourceConfig b,
       TableName b, RecreateEventTriggers, EventTriggerConf b))
     (Maybe (EventTriggerInfo b))
-> arr
     (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
      [(Dependency InvalidationKey, SourceName, SourceConfig b,
        TableName b, RecreateEventTriggers, EventTriggerConf b)])
     (EventTriggerInfoMap b)
forall (arr :: * -> * -> *) k a e b.
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, Eq k, 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)
-> ((Dependency InvalidationKey, SourceName, SourceConfig b,
     TableName b, RecreateEventTriggers, EventTriggerConf b)
    -> EventTriggerConf b)
-> (Dependency InvalidationKey, SourceName, SourceConfig b,
    TableName b, RecreateEventTriggers, EventTriggerConf b)
-> TriggerName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Dependency InvalidationKey, SourceName, SourceConfig b,
 TableName b, RecreateEventTriggers, EventTriggerConf b)
-> Getting
     (EventTriggerConf b)
     (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)
  (Dependency InvalidationKey, SourceName, SourceConfig b,
   TableName b, RecreateEventTriggers, EventTriggerConf b)
  (EventTriggerConf b)
forall s t a b. Field6 s t a b => Lens s t a b
_6)) (forall a c.
Backend b =>
(a, SourceName, c, TableName b, RecreateEventTriggers,
 EventTriggerConf b)
-> MetadataObject
forall (b :: BackendType) a c.
Backend b =>
(a, SourceName, c, TableName b, RecreateEventTriggers,
 EventTriggerConf b)
-> MetadataObject
mkEventTriggerMetadataObject @b) arr
  (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
   (Dependency InvalidationKey, SourceName, SourceConfig b,
    TableName b, RecreateEventTriggers, EventTriggerConf b))
  (Maybe (EventTriggerInfo b))
buildEventTrigger
        -<
          (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
tableInfo, (EventTriggerConf b
 -> (Dependency InvalidationKey, SourceName, SourceConfig b,
     TableName b, RecreateEventTriggers, EventTriggerConf b))
-> [EventTriggerConf b]
-> [(Dependency InvalidationKey, SourceName, SourceConfig b,
     TableName b, RecreateEventTriggers, EventTriggerConf b)]
forall a b. (a -> b) -> [a] -> [b]
map (Dependency InvalidationKey
metadataInvalidationKey,SourceName
sourceName,SourceConfig b
sourceConfig,TableCoreInfoG b (ColumnInfo b) (ColumnInfo b) -> TableName b
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableName b
_tciName TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
tableInfo,RecreateEventTriggers
migrationRecreateEventTriggers,) [EventTriggerConf b]
eventTriggerConfs)
      where
        buildEventTrigger :: arr
  (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b),
   (Dependency InvalidationKey, SourceName, SourceConfig b,
    TableName b, RecreateEventTriggers, EventTriggerConf b))
  (Maybe (EventTriggerInfo b))
buildEventTrigger = proc (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
tableInfo, (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
              metadataObject :: MetadataObject
metadataObject = (Dependency InvalidationKey, SourceName, SourceConfig b,
 TableName b, RecreateEventTriggers, EventTriggerConf b)
-> MetadataObject
forall (b :: BackendType) a c.
Backend b =>
(a, SourceName, c, TableName b, RecreateEventTriggers,
 EventTriggerConf b)
-> MetadataObject
mkEventTriggerMetadataObject @b (Dependency InvalidationKey
metadataInvalidationKey, SourceName
source, SourceConfig b
sourceConfig, TableName b
table, RecreateEventTriggers
migrationRecreateEventTriggers, 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
$
                    TableName b -> TableObjId b -> SourceObjId 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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` HashSet SourceName
sources then RecreateEventTriggers
RETRecreate else RecreateEventTriggers
RETDoNothing
          (|
            forall a.
ErrorA QErr arr (a, ()) (EventTriggerInfo b)
-> arr (a, (MetadataObject, ())) (Maybe (EventTriggerInfo b))
forall (arr :: * -> * -> *) w e s a.
(ArrowChoice arr, ArrowWriter (Seq w) arr,
 AsInconsistentMetadata w) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
              ( (|
                  forall a.
ErrorA QErr arr (a, ()) (EventTriggerInfo b)
-> ErrorA QErr arr (a, (Text -> Text, ())) (EventTriggerInfo b)
forall (arr :: * -> * -> *) e s a.
ArrowError QErr arr =>
arr (e, s) a -> arr (e, (Text -> Text, s)) a
modifyErrA
                    ( do
                        (EventTriggerInfo b
info, [SchemaDependency]
dependencies) <- ErrorA
  QErr
  arr
  (m (EventTriggerInfo b, [SchemaDependency]))
  (EventTriggerInfo b, [SchemaDependency])
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr,
 MonadError e m) =>
arr (m a) a
bindErrorA -< Environment
-> SourceName
-> TableName b
-> EventTriggerConf b
-> m (EventTriggerInfo b, [SchemaDependency])
forall (b :: BackendType) (m :: * -> *).
(Backend b, QErrM m) =>
Environment
-> SourceName
-> TableName b
-> EventTriggerConf b
-> m (EventTriggerInfo b, [SchemaDependency])
buildEventTriggerInfo @b Environment
env SourceName
source TableName b
table EventTriggerConf b
eventTriggerConf
                        ServerConfigCtx
serverConfigCtx <- ErrorA QErr arr (m ServerConfigCtx) ServerConfigCtx
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< m ServerConfigCtx
forall (m :: * -> *). HasServerConfigCtx m => m ServerConfigCtx
askServerConfigCtx
                        let isCatalogUpdate :: Bool
isCatalogUpdate =
                              case BuildReason
buildReason of
                                CatalogUpdate Maybe (HashSet SourceName)
_ -> Bool
True
                                BuildReason
CatalogSync -> Bool
False
                            tableColumns :: [ColumnInfo b]
tableColumns = HashMap FieldName (ColumnInfo b) -> [ColumnInfo b]
forall k v. HashMap k v -> [v]
M.elems (HashMap FieldName (ColumnInfo b) -> [ColumnInfo b])
-> HashMap FieldName (ColumnInfo b) -> [ColumnInfo b]
forall a b. (a -> b) -> a -> b
$ TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
-> HashMap FieldName (ColumnInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
tableInfo
                        if ( ServerConfigCtx -> MaintenanceMode ()
_sccMaintenanceMode ServerConfigCtx
serverConfigCtx MaintenanceMode () -> MaintenanceMode () -> Bool
forall a. Eq a => a -> a -> Bool
== MaintenanceMode ()
forall a. MaintenanceMode a
MaintenanceModeDisabled
                               Bool -> Bool -> Bool
&& ServerConfigCtx -> ReadOnlyMode
_sccReadOnlyMode ServerConfigCtx
serverConfigCtx ReadOnlyMode -> ReadOnlyMode -> Bool
forall a. Eq a => a -> a -> Bool
== ReadOnlyMode
ReadOnlyModeDisabled
                           )
                          then do
                            ErrorA QErr arr (m ()) ()
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA
                              -<
                                Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RecreateEventTriggers
reloadMetadataRecreateEventTrigger RecreateEventTriggers -> RecreateEventTriggers -> Bool
forall a. Eq a => a -> a -> Bool
== RecreateEventTriggers
RETRecreate) (m () -> m ()) -> m () -> 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
                                  m (Either QErr ()) -> m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr ()) -> m ()) -> m (Either QErr ()) -> m ()
forall a b. (a -> b) -> a -> b
$
                                    ServerConfigCtx
-> SourceConfig b
-> TableName b
-> [ColumnInfo b]
-> TriggerName
-> TriggerOpsDef b
-> Maybe (PrimaryKey b (ColumnInfo b))
-> m (Either QErr ())
forall (b :: BackendType) (m :: * -> *).
(BackendEventTrigger b, MonadBaseControl IO m, MonadIO m,
 MonadError QErr m) =>
ServerConfigCtx
-> SourceConfig b
-> TableName b
-> [ColumnInfo b]
-> TriggerName
-> TriggerOpsDef b
-> Maybe (PrimaryKey b (ColumnInfo b))
-> m (Either QErr ())
createTableEventTrigger
                                      @b
                                      ServerConfigCtx
serverConfigCtx
                                      SourceConfig b
sourceConfig
                                      TableName b
table
                                      [ColumnInfo b]
tableColumns
                                      TriggerName
triggerName
                                      (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
  (TableName b, [ColumnInfo b], TriggerName, TriggerOpsDef b,
   SourceConfig b, Maybe (PrimaryKey b (ColumnInfo b)))
  ()
recreateTriggerIfNeeded
                                  -<
                                    ( TableName b
table,
                                      [ColumnInfo b]
tableColumns,
                                      TriggerName
triggerName,
                                      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 (m ()) ()
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA
                                  -<
                                    SourceConfig b
-> TableName b
-> ([ColumnInfo b], Maybe (PrimaryKey b (ColumnInfo b)))
-> TriggerName
-> TriggerOpsDef b
-> m ()
forall (b :: BackendType) (m :: * -> *).
(BackendEventTrigger b, MonadIO m, MonadError QErr m,
 MonadBaseControl IO m, Backend b, HasServerConfigCtx m) =>
SourceConfig b
-> TableName b
-> ([ColumnInfo b], Maybe (PrimaryKey b (ColumnInfo b)))
-> TriggerName
-> TriggerOpsDef b
-> m ()
createMissingSQLTriggers
                                      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
                                      (EventTriggerConf b -> TriggerOpsDef b
forall (b :: BackendType). EventTriggerConf b -> TriggerOpsDef b
etcDefinition EventTriggerConf b
eventTriggerConf)
                              else ErrorA QErr arr (m ()) ()
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                          else ErrorA QErr arr (m ()) ()
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                        ErrorA
  QErr arr (MetadataObject, SchemaObjId, [SchemaDependency]) ()
forall (arr :: * -> * -> *).
ArrowWriter (Seq CollectedInfo) arr =>
arr (MetadataObject, SchemaObjId, [SchemaDependency]) ()
recordDependencies -< (MetadataObject
metadataObject, SchemaObjId
schemaObjectId, [SchemaDependency]
dependencies)
                        ErrorA QErr arr (EventTriggerInfo b) (EventTriggerInfo b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< EventTriggerInfo b
info
                    )
                |) (TableName b -> Text -> Text
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)
              )
            |) MetadataObject
metadataObject

        recreateTriggerIfNeeded :: ErrorA
  QErr
  arr
  (TableName b, [ColumnInfo b], TriggerName, 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
  (TableName b, [ColumnInfo b], TriggerName, TriggerOpsDef b,
   SourceConfig b, Maybe (PrimaryKey b (ColumnInfo b)))
  ()
-> ErrorA
     QErr
     arr
     (TableName b, [ColumnInfo b], TriggerName, TriggerOpsDef b,
      SourceConfig b, Maybe (PrimaryKey b (ColumnInfo b)))
     ()
forall (m :: * -> *) (arr :: * -> * -> *) a b.
(ArrowCache m arr, Cacheable a) =>
arr a b -> arr a b
Inc.cache
            proc
              ( TableName b
tableName,
                [ColumnInfo b]
tableColumns,
                TriggerName
triggerName,
                TriggerOpsDef b
triggerDefinition,
                SourceConfig b
sourceConfig,
                Maybe (PrimaryKey b (ColumnInfo b))
primaryKey
                )
            -> do
              ErrorA QErr arr (m ()) ()
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA
                -< do
                  ServerConfigCtx
serverConfigCtx <- m ServerConfigCtx
forall (m :: * -> *). HasServerConfigCtx m => m ServerConfigCtx
askServerConfigCtx
                  m (Either QErr ()) -> m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr ()) -> m ()) -> m (Either QErr ()) -> m ()
forall a b. (a -> b) -> a -> b
$
                    ServerConfigCtx
-> SourceConfig b
-> TableName b
-> [ColumnInfo b]
-> TriggerName
-> TriggerOpsDef b
-> Maybe (PrimaryKey b (ColumnInfo b))
-> m (Either QErr ())
forall (b :: BackendType) (m :: * -> *).
(BackendEventTrigger b, MonadBaseControl IO m, MonadIO m,
 MonadError QErr m) =>
ServerConfigCtx
-> SourceConfig b
-> TableName b
-> [ColumnInfo b]
-> TriggerName
-> TriggerOpsDef b
-> Maybe (PrimaryKey b (ColumnInfo b))
-> m (Either QErr ())
createTableEventTrigger @b
                      ServerConfigCtx
serverConfigCtx
                      SourceConfig b
sourceConfig
                      TableName b
tableName
                      [ColumnInfo b]
tableColumns
                      TriggerName
triggerName
                      TriggerOpsDef b
triggerDefinition
                      Maybe (PrimaryKey b (ColumnInfo b))
primaryKey

    buildCronTriggers ::
      ( ArrowChoice arr,
        Inc.ArrowDistribute arr,
        ArrowWriter (Seq CollectedInfo) arr,
        Inc.ArrowCache m arr,
        MonadError QErr m
      ) =>
      ((), [CronTriggerMetadata])
        `arr` HashMap TriggerName CronTriggerInfo
    buildCronTriggers :: arr
  ((), [CronTriggerMetadata]) (HashMap TriggerName CronTriggerInfo)
buildCronTriggers = (CronTriggerMetadata -> TriggerName)
-> (CronTriggerMetadata -> MetadataObject)
-> arr ((), CronTriggerMetadata) (Maybe CronTriggerInfo)
-> arr
     ((), [CronTriggerMetadata]) (HashMap TriggerName CronTriggerInfo)
forall (arr :: * -> * -> *) k a e b.
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, Eq k, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe b)
-> arr (e, [a]) (HashMap k b)
buildInfoMap CronTriggerMetadata -> TriggerName
ctName CronTriggerMetadata -> MetadataObject
mkCronTriggerMetadataObject arr ((), CronTriggerMetadata) (Maybe CronTriggerInfo)
buildCronTrigger
      where
        buildCronTrigger :: arr ((), CronTriggerMetadata) (Maybe CronTriggerInfo)
buildCronTrigger = proc (()
_, 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
          (|
            forall a.
ErrorA QErr arr (a, ()) CronTriggerInfo
-> arr (a, (MetadataObject, ())) (Maybe CronTriggerInfo)
forall (arr :: * -> * -> *) w e s a.
(ArrowChoice arr, ArrowWriter (Seq w) arr,
 AsInconsistentMetadata w) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
              ( (|
                  forall a.
ErrorA QErr arr (a, ()) CronTriggerInfo
-> ErrorA QErr arr (a, (Text -> Text, ())) CronTriggerInfo
forall (arr :: * -> * -> *) e s a.
ArrowError QErr arr =>
arr (e, s) a -> arr (e, (Text -> Text, s)) a
modifyErrA
                    (ErrorA QErr arr (m CronTriggerInfo) CronTriggerInfo
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr,
 MonadError e m) =>
arr (m a) a
bindErrorA -< Environment -> CronTriggerMetadata -> m CronTriggerInfo
forall (m :: * -> *).
QErrM m =>
Environment -> CronTriggerMetadata -> m CronTriggerInfo
resolveCronTrigger Environment
env CronTriggerMetadata
cronTrigger)
                |) Text -> Text
addCronTriggerContext
              )
            |) (CronTriggerMetadata -> MetadataObject
mkCronTriggerMetadataObject CronTriggerMetadata
cronTrigger)

    buildInheritedRoles ::
      ( ArrowChoice arr,
        Inc.ArrowDistribute arr,
        ArrowWriter (Seq CollectedInfo) arr,
        Inc.ArrowCache m arr,
        MonadError QErr m
      ) =>
      (HashSet RoleName, [InheritedRole])
        `arr` HashMap RoleName Role
    buildInheritedRoles :: arr (HashSet RoleName, [Role]) (HashMap RoleName Role)
buildInheritedRoles = (Role -> RoleName)
-> (Role -> MetadataObject)
-> arr (HashSet RoleName, Role) (Maybe Role)
-> arr (HashSet RoleName, [Role]) (HashMap RoleName Role)
forall (arr :: * -> * -> *) k a e b.
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, Eq k, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe b)
-> arr (e, [a]) (HashMap k b)
buildInfoMap Role -> RoleName
_rRoleName Role -> MetadataObject
mkInheritedRoleMetadataObject arr (HashSet RoleName, Role) (Maybe Role)
buildInheritedRole
      where
        buildInheritedRole :: arr (HashSet RoleName, Role) (Maybe Role)
buildInheritedRole = proc (HashSet RoleName
allRoles, 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
          (|
            forall a.
ErrorA QErr arr (a, ()) Role
-> arr (a, (MetadataObject, ())) (Maybe Role)
forall (arr :: * -> * -> *) w e s a.
(ArrowChoice arr, ArrowWriter (Seq w) arr,
 AsInconsistentMetadata w) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
              ( (|
                  forall a.
ErrorA QErr arr (a, ()) Role
-> ErrorA QErr arr (a, (Text -> Text, ())) Role
forall (arr :: * -> * -> *) e s a.
ArrowError QErr arr =>
arr (e, s) a -> arr (e, (Text -> Text, s)) a
modifyErrA
                    ( do
                        (Role
resolvedInheritedRole, [SchemaDependency]
dependencies) <- ErrorA
  QErr arr (m (Role, [SchemaDependency])) (Role, [SchemaDependency])
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA -< HashSet RoleName -> Role -> m (Role, [SchemaDependency])
forall (m :: * -> *).
MonadError QErr m =>
HashSet RoleName -> Role -> m (Role, [SchemaDependency])
resolveInheritedRole HashSet RoleName
allRoles Role
inheritedRole
                        ErrorA
  QErr arr (MetadataObject, SchemaObjId, [SchemaDependency]) ()
forall (arr :: * -> * -> *).
ArrowWriter (Seq CollectedInfo) arr =>
arr (MetadataObject, SchemaObjId, [SchemaDependency]) ()
recordDependencies -< (MetadataObject
metadataObject, SchemaObjId
schemaObject, [SchemaDependency]
dependencies)
                        ErrorA QErr arr Role Role
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Role
resolvedInheritedRole
                    )
                |) Text -> Text
addInheritedRoleContext
              )
            |) MetadataObject
metadataObject

    buildActions ::
      ( ArrowChoice arr,
        Inc.ArrowDistribute arr,
        Inc.ArrowCache m arr,
        ArrowWriter (Seq CollectedInfo) arr
      ) =>
      ( (AnnotatedCustomTypes, BackendMap ScalarMap, OrderedRoles),
        [ActionMetadata]
      )
        `arr` HashMap ActionName ActionInfo
    buildActions :: arr
  ((AnnotatedCustomTypes, BackendMap ScalarMap, OrderedRoles),
   [ActionMetadata])
  ActionCache
buildActions = (ActionMetadata -> ActionName)
-> (ActionMetadata -> MetadataObject)
-> arr
     ((AnnotatedCustomTypes, BackendMap ScalarMap, OrderedRoles),
      ActionMetadata)
     (Maybe ActionInfo)
-> arr
     ((AnnotatedCustomTypes, BackendMap ScalarMap, OrderedRoles),
      [ActionMetadata])
     ActionCache
forall (arr :: * -> * -> *) k a e b.
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, Eq k, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe b)
-> arr (e, [a]) (HashMap k b)
buildInfoMap ActionMetadata -> ActionName
_amName ActionMetadata -> MetadataObject
mkActionMetadataObject arr
  ((AnnotatedCustomTypes, BackendMap ScalarMap, OrderedRoles),
   ActionMetadata)
  (Maybe ActionInfo)
buildAction
      where
        buildAction :: arr
  ((AnnotatedCustomTypes, BackendMap ScalarMap, OrderedRoles),
   ActionMetadata)
  (Maybe ActionInfo)
buildAction = proc ((AnnotatedCustomTypes
resolvedCustomTypes, BackendMap ScalarMap
scalarsMap, OrderedRoles
orderedRoles), ActionMetadata
action) -> do
          let ActionMetadata ActionName
name Maybe Text
comment ActionDefinitionInput
def [ActionPermissionMetadata]
actionPermissions = ActionMetadata
action
              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
          (|
            forall a.
ErrorA QErr arr (a, ()) ActionInfo
-> arr (a, (MetadataObject, ())) (Maybe ActionInfo)
forall (arr :: * -> * -> *) w e s a.
(ArrowChoice arr, ArrowWriter (Seq w) arr,
 AsInconsistentMetadata w) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
              ( (|
                  forall a.
ErrorA QErr arr (a, ()) ActionInfo
-> ErrorA QErr arr (a, (Text -> Text, ())) ActionInfo
forall (arr :: * -> * -> *) e s a.
ArrowError QErr arr =>
arr (e, s) a -> arr (e, (Text -> Text, s)) a
modifyErrA
                    ( do
                        (ResolvedActionDefinition
resolvedDef, AnnotatedOutputType
outObject) <-
                          ErrorA
  QErr
  arr
  (Either QErr (ResolvedActionDefinition, AnnotatedOutputType))
  (ResolvedActionDefinition, AnnotatedOutputType)
forall (arr :: * -> * -> *) e a.
(ArrowChoice arr, ArrowError e arr) =>
arr (Either e a) a
liftEitherA ErrorA
  QErr
  arr
  (Either QErr (ResolvedActionDefinition, AnnotatedOutputType))
  (ResolvedActionDefinition, AnnotatedOutputType)
-> ErrorA
     QErr
     arr
     (m (Either QErr (ResolvedActionDefinition, AnnotatedOutputType)))
     (Either QErr (ResolvedActionDefinition, AnnotatedOutputType))
-> ErrorA
     QErr
     arr
     (m (Either QErr (ResolvedActionDefinition, AnnotatedOutputType)))
     (ResolvedActionDefinition, AnnotatedOutputType)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< ErrorA
  QErr
  arr
  (m (Either QErr (ResolvedActionDefinition, AnnotatedOutputType)))
  (Either QErr (ResolvedActionDefinition, AnnotatedOutputType))
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA
                            -<
                              ExceptT QErr m (ResolvedActionDefinition, AnnotatedOutputType)
-> m (Either QErr (ResolvedActionDefinition, AnnotatedOutputType))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr m (ResolvedActionDefinition, AnnotatedOutputType)
 -> m (Either QErr (ResolvedActionDefinition, AnnotatedOutputType)))
-> ExceptT QErr m (ResolvedActionDefinition, AnnotatedOutputType)
-> m (Either QErr (ResolvedActionDefinition, AnnotatedOutputType))
forall a b. (a -> b) -> a -> b
$ Environment
-> AnnotatedCustomTypes
-> ActionDefinitionInput
-> BackendMap ScalarMap
-> ExceptT QErr m (ResolvedActionDefinition, AnnotatedOutputType)
forall (m :: * -> *).
QErrM m =>
Environment
-> AnnotatedCustomTypes
-> ActionDefinitionInput
-> BackendMap ScalarMap
-> m (ResolvedActionDefinition, AnnotatedOutputType)
resolveAction Environment
env AnnotatedCustomTypes
resolvedCustomTypes ActionDefinitionInput
def BackendMap ScalarMap
scalarsMap
                        let 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. (Eq k, 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
                            forwardClientHeaders :: Bool
forwardClientHeaders = ResolvedActionDefinition -> Bool
forall arg webhook. ActionDefinition arg webhook -> Bool
_adForwardClientHeaders ResolvedActionDefinition
resolvedDef
                            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
                        ErrorA QErr arr ActionInfo ActionInfo
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< 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
                    )
                |) Text -> Text
addActionContext
              )
            |) (ActionMetadata -> MetadataObject
mkActionMetadataObject ActionMetadata
action)

    buildRemoteSchemas ::
      ( ArrowChoice arr,
        Inc.ArrowDistribute arr,
        ArrowWriter (Seq CollectedInfo) arr,
        Inc.ArrowCache m arr,
        MonadIO m,
        HasHttpManagerM m
      ) =>
      ( Inc.Dependency (HashMap RemoteSchemaName Inc.InvalidationKey),
        [RemoteSchemaMetadata]
      )
        `arr` HashMap RemoteSchemaName ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject)
    buildRemoteSchemas :: arr
  (Dependency (HashMap RemoteSchemaName InvalidationKey),
   [RemoteSchemaMetadata])
  (HashMap
     RemoteSchemaName
     ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject))
buildRemoteSchemas =
      (RemoteSchemaMetadata -> RemoteSchemaName)
-> (RemoteSchemaMetadata -> MetadataObject)
-> arr
     (Dependency (HashMap RemoteSchemaName InvalidationKey),
      RemoteSchemaMetadata)
     (Maybe (RemoteSchemaCtx, SchemaRemoteRelationships))
-> arr
     (Dependency (HashMap RemoteSchemaName InvalidationKey),
      [RemoteSchemaMetadata])
     (HashMap
        RemoteSchemaName
        ((RemoteSchemaCtx, SchemaRemoteRelationships), MetadataObject))
forall (arr :: * -> * -> *) k a e b.
(ArrowChoice arr, ArrowDistribute arr,
 ArrowWriter (Seq CollectedInfo) arr, Eq k, Hashable k) =>
(a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe b)
-> arr (e, [a]) (HashMap k (b, MetadataObject))
buildInfoMapPreservingMetadata RemoteSchemaMetadata -> RemoteSchemaName
_rsmName RemoteSchemaMetadata -> MetadataObject
mkRemoteSchemaMetadataObject arr
  (Dependency (HashMap RemoteSchemaName InvalidationKey),
   RemoteSchemaMetadata)
  (Maybe (RemoteSchemaCtx, SchemaRemoteRelationships))
buildRemoteSchema
      where
        -- We want to cache this call because it fetches the remote schema over HTTP, and we don’t
        -- want to re-run that if the remote schema definition hasn’t changed.
        buildRemoteSchema :: arr
  (Dependency (HashMap RemoteSchemaName InvalidationKey),
   RemoteSchemaMetadata)
  (Maybe (RemoteSchemaCtx, SchemaRemoteRelationships))
buildRemoteSchema = arr
  (Dependency (HashMap RemoteSchemaName InvalidationKey),
   RemoteSchemaMetadata)
  (Maybe (RemoteSchemaCtx, SchemaRemoteRelationships))
-> arr
     (Dependency (HashMap RemoteSchemaName InvalidationKey),
      RemoteSchemaMetadata)
     (Maybe (RemoteSchemaCtx, SchemaRemoteRelationships))
forall (m :: * -> *) (arr :: * -> * -> *) a b.
(ArrowCache m arr, Cacheable a) =>
arr a b -> arr a b
Inc.cache proc (Dependency (HashMap RemoteSchemaName InvalidationKey)
invalidationKeys, remoteSchema :: RemoteSchemaMetadata
remoteSchema@(RemoteSchemaMetadata RemoteSchemaName
name RemoteSchemaDef
defn Maybe Text
comment [RemoteSchemaPermissionMetadata]
_ SchemaRemoteRelationships
relationships)) -> do
          -- TODO is it strange how we convert from RemoteSchemaMetadata back
          --      to AddRemoteSchemaQuery here? Document types please.
          let addRemoteSchemaQuery :: AddRemoteSchemaQuery
addRemoteSchemaQuery = RemoteSchemaName
-> RemoteSchemaDef -> Maybe Text -> AddRemoteSchemaQuery
AddRemoteSchemaQuery RemoteSchemaName
name RemoteSchemaDef
defn Maybe Text
comment
          arr (Dependency (Maybe InvalidationKey)) (Maybe InvalidationKey)
forall (m :: * -> *) (arr :: * -> * -> *) a.
(ArrowCache m arr, Cacheable a) =>
arr (Dependency a) a
Inc.dependOn -< RemoteSchemaName
-> Dependency (HashMap RemoteSchemaName InvalidationKey)
-> Dependency (Maybe InvalidationKey)
forall a k v.
(Select a, Selector a ~ ConstS k v) =>
k -> Dependency a -> Dependency v
Inc.selectKeyD RemoteSchemaName
name Dependency (HashMap RemoteSchemaName InvalidationKey)
invalidationKeys
          (|
            forall a.
ErrorA
  QErr arr (a, ()) (RemoteSchemaCtx, SchemaRemoteRelationships)
-> arr
     (a, (MetadataObject, ()))
     (Maybe (RemoteSchemaCtx, SchemaRemoteRelationships))
forall (arr :: * -> * -> *) w e s a.
(ArrowChoice arr, ArrowWriter (Seq w) arr,
 AsInconsistentMetadata w) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
              ( ErrorA
  QErr
  arr
  (Either QErr (RemoteSchemaCtx, SchemaRemoteRelationships))
  (RemoteSchemaCtx, SchemaRemoteRelationships)
forall (arr :: * -> * -> *) e a.
(ArrowChoice arr, ArrowError e arr) =>
arr (Either e a) a
liftEitherA ErrorA
  QErr
  arr
  (Either QErr (RemoteSchemaCtx, SchemaRemoteRelationships))
  (RemoteSchemaCtx, SchemaRemoteRelationships)
-> ErrorA
     QErr
     arr
     (m (Either QErr (RemoteSchemaCtx, SchemaRemoteRelationships)))
     (Either QErr (RemoteSchemaCtx, SchemaRemoteRelationships))
-> ErrorA
     QErr
     arr
     (m (Either QErr (RemoteSchemaCtx, SchemaRemoteRelationships)))
     (RemoteSchemaCtx, SchemaRemoteRelationships)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< ErrorA
  QErr
  arr
  (m (Either QErr (RemoteSchemaCtx, SchemaRemoteRelationships)))
  (Either QErr (RemoteSchemaCtx, SchemaRemoteRelationships))
forall (m :: * -> *) (arr :: * -> * -> *) a.
ArrowKleisli m arr =>
arr (m a) a
bindA
                  -<
                    ((Either QErr RemoteSchemaCtx
 -> Either QErr (RemoteSchemaCtx, SchemaRemoteRelationships))
-> m (Either QErr RemoteSchemaCtx)
-> m (Either QErr (RemoteSchemaCtx, SchemaRemoteRelationships))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either QErr RemoteSchemaCtx
  -> Either QErr (RemoteSchemaCtx, SchemaRemoteRelationships))
 -> m (Either QErr RemoteSchemaCtx)
 -> m (Either QErr (RemoteSchemaCtx, SchemaRemoteRelationships)))
-> ((RemoteSchemaCtx
     -> (RemoteSchemaCtx, SchemaRemoteRelationships))
    -> Either QErr RemoteSchemaCtx
    -> Either QErr (RemoteSchemaCtx, SchemaRemoteRelationships))
-> (RemoteSchemaCtx
    -> (RemoteSchemaCtx, SchemaRemoteRelationships))
-> m (Either QErr RemoteSchemaCtx)
-> m (Either QErr (RemoteSchemaCtx, SchemaRemoteRelationships))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteSchemaCtx -> (RemoteSchemaCtx, SchemaRemoteRelationships))
-> Either QErr RemoteSchemaCtx
-> Either QErr (RemoteSchemaCtx, SchemaRemoteRelationships)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (,SchemaRemoteRelationships
relationships) (m (Either QErr RemoteSchemaCtx)
 -> m (Either QErr (RemoteSchemaCtx, SchemaRemoteRelationships)))
-> m (Either QErr RemoteSchemaCtx)
-> m (Either QErr (RemoteSchemaCtx, SchemaRemoteRelationships))
forall a b. (a -> b) -> a -> b
$
                      ExceptT QErr m RemoteSchemaCtx -> m (Either QErr RemoteSchemaCtx)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr m RemoteSchemaCtx -> m (Either QErr RemoteSchemaCtx))
-> ExceptT QErr m RemoteSchemaCtx
-> m (Either QErr RemoteSchemaCtx)
forall a b. (a -> b) -> a -> b
$ TraceT (ExceptT QErr m) RemoteSchemaCtx
-> ExceptT QErr m RemoteSchemaCtx
forall a. TraceT (ExceptT QErr m) a -> ExceptT QErr m a
noopTrace (TraceT (ExceptT QErr m) RemoteSchemaCtx
 -> ExceptT QErr m RemoteSchemaCtx)
-> TraceT (ExceptT QErr m) RemoteSchemaCtx
-> ExceptT QErr m RemoteSchemaCtx
forall a b. (a -> b) -> a -> b
$ Environment
-> AddRemoteSchemaQuery -> TraceT (ExceptT QErr m) RemoteSchemaCtx
forall (m :: * -> *).
(QErrM m, MonadIO m, HasHttpManagerM m, MonadTrace m) =>
Environment -> AddRemoteSchemaQuery -> m RemoteSchemaCtx
addRemoteSchemaP2Setup Environment
env AddRemoteSchemaQuery
addRemoteSchemaQuery
              )
            |) (RemoteSchemaMetadata -> MetadataObject
mkRemoteSchemaMetadataObject RemoteSchemaMetadata
remoteSchema)
        -- TODO continue propagating MonadTrace up calls so that we can get tracing for remote schema introspection.
        -- This will require modifying CacheBuild.
        noopTrace :: TraceT (ExceptT QErr m) a -> ExceptT QErr m a
noopTrace = Reporter -> Text -> TraceT (ExceptT QErr m) a -> ExceptT QErr m a
forall (m :: * -> *) a.
MonadIO m =>
Reporter -> Text -> TraceT m a -> m a
Tracing.runTraceTWithReporter Reporter
Tracing.noReporter Text
"buildSchemaCacheRule"

buildRemoteSchemaRemoteRelationship ::
  forall arr m.
  ( ArrowChoice arr,
    ArrowWriter (Seq CollectedInfo) arr,
    ArrowKleisli m arr,
    MonadError QErr m
  ) =>
  ( (HashMap SourceName (AB.AnyBackend PartiallyResolvedSource), RemoteSchemaMap),
    (RemoteSchemaName, RemoteSchemaIntrospection, G.Name, RemoteRelationship)
  )
    `arr` Maybe (RemoteFieldInfo G.Name)
buildRemoteSchemaRemoteRelationship :: arr
  ((HashMap SourceName (AnyBackend PartiallyResolvedSource),
    RemoteSchemaMap),
   (RemoteSchemaName, RemoteSchemaIntrospection, Name,
    RemoteRelationship))
  (Maybe (RemoteFieldInfo Name))
buildRemoteSchemaRemoteRelationship =
  proc
    ( (HashMap SourceName (AnyBackend PartiallyResolvedSource)
allSources, RemoteSchemaMap
remoteSchemaMap),
      (RemoteSchemaName
remoteSchema, RemoteSchemaIntrospection
remoteSchemaIntrospection, Name
typeName, rr :: RemoteRelationship
rr@RemoteRelationship {RelName
RemoteRelationshipDefinition
_rrDefinition :: RemoteRelationship -> RemoteRelationshipDefinition
_rrName :: RemoteRelationship -> RelName
_rrDefinition :: RemoteRelationshipDefinition
_rrName :: RelName
..})
      )
  -> do
    let metadataObject :: MetadataObject
metadataObject = (RemoteSchemaName, Name, RemoteRelationship) -> MetadataObject
mkRemoteSchemaRemoteRelationshipMetadataObject (RemoteSchemaName
remoteSchema, Name
typeName, RemoteRelationship
rr)
        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
    (|
      forall a.
ErrorA QErr arr (a, ()) (RemoteFieldInfo Name)
-> arr (a, (MetadataObject, ())) (Maybe (RemoteFieldInfo Name))
forall (arr :: * -> * -> *) w e s a.
(ArrowChoice arr, ArrowWriter (Seq w) arr,
 AsInconsistentMetadata w) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency
        ( (|
            forall a.
ErrorA QErr arr (a, ()) (RemoteFieldInfo Name)
-> ErrorA QErr arr (a, (Text -> Text, ())) (RemoteFieldInfo Name)
forall (arr :: * -> * -> *) e s a.
ArrowError QErr arr =>
arr (e, s) a -> arr (e, (Text -> Text, s)) a
modifyErrA
              ( do
                  HashMap FieldName Name
allowedLHSJoinFields <-
                    ErrorA
  QErr arr (m (HashMap FieldName Name)) (HashMap FieldName Name)
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr,
 MonadError e m) =>
arr (m a) a
bindErrorA
                      -<
                        RemoteSchemaName
-> RemoteSchemaIntrospection -> Name -> 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, [SchemaDependency]
rhsDependencies) <-
                    ErrorA
  QErr
  arr
  (m (RemoteFieldInfo Name, [SchemaDependency]))
  (RemoteFieldInfo Name, [SchemaDependency])
forall (arr :: * -> * -> *) (m :: * -> *) e a.
(ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr,
 MonadError e m) =>
arr (m a) a
bindErrorA
                      -<
                        LHSIdentifier
-> HashMap FieldName Name
-> RemoteRelationship
-> HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> RemoteSchemaMap
-> m (RemoteFieldInfo Name, [SchemaDependency])
forall (m :: * -> *) lhsJoinField.
QErrM m =>
LHSIdentifier
-> HashMap FieldName lhsJoinField
-> RemoteRelationship
-> HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> RemoteSchemaMap
-> m (RemoteFieldInfo lhsJoinField, [SchemaDependency])
buildRemoteFieldInfo (RemoteSchemaName -> LHSIdentifier
remoteSchemaToLHSIdentifier RemoteSchemaName
remoteSchema) HashMap FieldName Name
allowedLHSJoinFields RemoteRelationship
rr HashMap SourceName (AnyBackend PartiallyResolvedSource)
allSources RemoteSchemaMap
remoteSchemaMap
                  -- 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
                  let lhsDependencies :: [SchemaDependency]
lhsDependencies =
                        -- a direct dependency on the remote schema on which this is defined
                        [SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency (RemoteSchemaName -> SchemaObjId
SORemoteSchema RemoteSchemaName
remoteSchema) DependencyReason
DRRemoteRelationship]
                  ErrorA
  QErr arr (MetadataObject, SchemaObjId, [SchemaDependency]) ()
forall (arr :: * -> * -> *).
ArrowWriter (Seq CollectedInfo) arr =>
arr (MetadataObject, SchemaObjId, [SchemaDependency]) ()
recordDependencies -< (MetadataObject
metadataObject, SchemaObjId
schemaObj, [SchemaDependency]
lhsDependencies [SchemaDependency] -> [SchemaDependency] -> [SchemaDependency]
forall a. Semigroup a => a -> a -> a
<> [SchemaDependency]
rhsDependencies)
                  ErrorA QErr arr (RemoteFieldInfo Name) (RemoteFieldInfo Name)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< RemoteFieldInfo Name
remoteField
              )
          |) Text -> Text
addRemoteRelationshipContext
        )
      |) MetadataObject
metadataObject

mkRemoteSchemaRemoteRelationshipMetadataObject ::
  (RemoteSchemaName, G.Name, RemoteRelationship) ->
  MetadataObject
mkRemoteSchemaRemoteRelationshipMetadataObject :: (RemoteSchemaName, Name, RemoteRelationship) -> MetadataObject
mkRemoteSchemaRemoteRelationshipMetadataObject (RemoteSchemaName
remoteSchemaName, Name
typeName, RemoteRelationship {RelName
RemoteRelationshipDefinition
_rrDefinition :: RemoteRelationshipDefinition
_rrName :: RelName
_rrDefinition :: RemoteRelationship -> RemoteRelationshipDefinition
_rrName :: RemoteRelationship -> RelName
..}) =
  let objectId :: MetadataObjId
objectId =
        RemoteSchemaName -> Name -> RelName -> MetadataObjId
MORemoteSchemaRemoteRelationship RemoteSchemaName
remoteSchemaName Name
typeName RelName
_rrName
   in MetadataObjId -> Value -> MetadataObject
MetadataObject MetadataObjId
objectId (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
remoteSchemaName Name
typeName RelName
_rrName RemoteRelationshipDefinition
_rrDefinition

data BackendConfigAndSourceMetadata b = BackendConfigAndSourceMetadata
  { BackendConfigAndSourceMetadata b -> BackendConfig b
_bcasmBackendConfig :: BackendConfig b,
    BackendConfigAndSourceMetadata b -> SourceMetadata b
_bcasmSourceMetadata :: SourceMetadata b
  }
  deriving stock ((forall x.
 BackendConfigAndSourceMetadata b
 -> Rep (BackendConfigAndSourceMetadata b) x)
-> (forall x.
    Rep (BackendConfigAndSourceMetadata b) x
    -> BackendConfigAndSourceMetadata b)
-> Generic (BackendConfigAndSourceMetadata b)
forall x.
Rep (BackendConfigAndSourceMetadata b) x
-> BackendConfigAndSourceMetadata b
forall x.
BackendConfigAndSourceMetadata b
-> Rep (BackendConfigAndSourceMetadata b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (BackendConfigAndSourceMetadata b) x
-> BackendConfigAndSourceMetadata b
forall (b :: BackendType) x.
BackendConfigAndSourceMetadata b
-> Rep (BackendConfigAndSourceMetadata b) x
$cto :: forall (b :: BackendType) x.
Rep (BackendConfigAndSourceMetadata b) x
-> BackendConfigAndSourceMetadata b
$cfrom :: forall (b :: BackendType) x.
BackendConfigAndSourceMetadata b
-> Rep (BackendConfigAndSourceMetadata b) x
Generic)

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

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

instance (Backend b) => Inc.Cacheable (BackendConfigAndSourceMetadata b)

joinBackendConfigsToSources ::
  BackendMap BackendConfigWrapper ->
  InsOrdHashMap SourceName BackendSourceMetadata ->
  InsOrdHashMap SourceName (AB.AnyBackend BackendConfigAndSourceMetadata)
joinBackendConfigsToSources :: BackendMap BackendConfigWrapper
-> Sources
-> InsOrdHashMap
     SourceName (AnyBackend BackendConfigAndSourceMetadata)
joinBackendConfigsToSources BackendMap BackendConfigWrapper
backendConfigs Sources
sources =
  ((BackendSourceMetadata
  -> AnyBackend BackendConfigAndSourceMetadata)
 -> Sources
 -> InsOrdHashMap
      SourceName (AnyBackend BackendConfigAndSourceMetadata))
-> Sources
-> (BackendSourceMetadata
    -> AnyBackend BackendConfigAndSourceMetadata)
-> InsOrdHashMap
     SourceName (AnyBackend BackendConfigAndSourceMetadata)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (BackendSourceMetadata
 -> AnyBackend BackendConfigAndSourceMetadata)
-> Sources
-> InsOrdHashMap
     SourceName (AnyBackend BackendConfigAndSourceMetadata)
forall v1 v2 k.
(v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
OMap.map Sources
sources ((BackendSourceMetadata
  -> AnyBackend BackendConfigAndSourceMetadata)
 -> InsOrdHashMap
      SourceName (AnyBackend BackendConfigAndSourceMetadata))
-> (BackendSourceMetadata
    -> AnyBackend BackendConfigAndSourceMetadata)
-> InsOrdHashMap
     SourceName (AnyBackend BackendConfigAndSourceMetadata)
forall a b. (a -> b) -> a -> b
$ \BackendSourceMetadata
abSourceMetadata ->
    AnyBackend SourceMetadata
-> (forall (b :: BackendType).
    Backend b =>
    SourceMetadata b -> AnyBackend BackendConfigAndSourceMetadata)
-> AnyBackend BackendConfigAndSourceMetadata
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 BackendConfigAndSourceMetadata)
 -> AnyBackend BackendConfigAndSourceMetadata)
-> (forall (b :: BackendType).
    Backend b =>
    SourceMetadata b -> AnyBackend BackendConfigAndSourceMetadata)
-> AnyBackend BackendConfigAndSourceMetadata
forall a b. (a -> b) -> a -> b
$ \(SourceMetadata b
sourceMetadata :: SourceMetadata b) ->
      let _bcasmBackendConfig :: BackendConfig b
_bcasmBackendConfig = BackendConfig b
-> (BackendConfigWrapper b -> BackendConfig b)
-> Maybe (BackendConfigWrapper b)
-> BackendConfig b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BackendConfig b
forall a. Monoid a => a
mempty BackendConfigWrapper b -> BackendConfig b
forall (b :: BackendType).
BackendConfigWrapper b -> BackendConfig b
unBackendConfigWrapper (BackendMap BackendConfigWrapper -> Maybe (BackendConfigWrapper b)
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
BackendMap i -> Maybe (i b)
BackendMap.lookup @b BackendMap BackendConfigWrapper
backendConfigs)
          _bcasmSourceMetadata :: SourceMetadata b
_bcasmSourceMetadata = SourceMetadata b
sourceMetadata
       in BackendConfigAndSourceMetadata b
-> AnyBackend BackendConfigAndSourceMetadata
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend @b BackendConfigAndSourceMetadata :: forall (b :: BackendType).
BackendConfig b
-> SourceMetadata b -> BackendConfigAndSourceMetadata b
BackendConfigAndSourceMetadata {BackendConfig b
SourceMetadata b
_bcasmSourceMetadata :: SourceMetadata b
_bcasmBackendConfig :: BackendConfig b
_bcasmSourceMetadata :: SourceMetadata b
_bcasmBackendConfig :: BackendConfig 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). -}