{-# LANGUAGE Arrows #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Types/functions shared between modules that implement "Hasura.RQL.DDL.Schema.Cache". Other
-- modules should not import this module directly.
module Hasura.RQL.DDL.Schema.Cache.Common
  ( ApolloFederationConfig (..),
    ApolloFederationVersion (..),
    BuildOutputs (..),
    CacheBuild,
    CacheBuildParams (CacheBuildParams),
    InvalidationKeys (..),
    ikMetadata,
    ikRemoteSchemas,
    ikSources,
    NonColumnTableInputs (..),
    RebuildableSchemaCache (RebuildableSchemaCache, lastBuiltSchemaCache),
    TableBuildInput (TableBuildInput, _tbiName),
    TablePermissionInputs (..),
    addTableContext,
    bindErrorA,
    boAllowlist,
    boApiLimits,
    boMetricsConfig,
    boTlsAllowlist,
    boActions,
    boCronTriggers,
    boCustomTypes,
    boEndpoints,
    boQueryCollections,
    boRemoteSchemas,
    boRoles,
    boSources,
    buildInfoMap,
    buildInfoMapPreservingMetadata,
    initialInvalidationKeys,
    invalidateKeys,
    mkTableInputs,
    runCacheBuild,
    runCacheBuildM,
    withRecordDependencies,
  )
where

import Control.Arrow.Extended
import Control.Arrow.Interpret
import Control.Lens
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Unique
import Data.HashMap.Strict.Extended qualified as M
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.Sequence qualified as Seq
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.Incremental qualified as Inc
import Hasura.Prelude
import Hasura.RQL.Types.Allowlist
import Hasura.RQL.Types.ApiLimit
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.CustomTypes
import Hasura.RQL.Types.Endpoint
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Instances ()
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.Network
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.Relationships.Remote
import Hasura.RQL.Types.RemoteSchema
import Hasura.RQL.Types.Roles
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.Source
import Hasura.SQL.Backend
import Hasura.Server.Types
import Hasura.Session
import Network.HTTP.Client.Manager (HasHttpManagerM (..))
import Network.HTTP.Client.Transformable qualified as HTTP

-- | 'InvalidationKeys' used to apply requested 'CacheInvalidations'.
data InvalidationKeys = InvalidationKeys
  { InvalidationKeys -> InvalidationKey
_ikMetadata :: Inc.InvalidationKey,
    InvalidationKeys -> HashMap RemoteSchemaName InvalidationKey
_ikRemoteSchemas :: HashMap RemoteSchemaName Inc.InvalidationKey,
    InvalidationKeys -> HashMap SourceName InvalidationKey
_ikSources :: HashMap SourceName Inc.InvalidationKey
  }
  deriving (Int -> InvalidationKeys -> ShowS
[InvalidationKeys] -> ShowS
InvalidationKeys -> String
(Int -> InvalidationKeys -> ShowS)
-> (InvalidationKeys -> String)
-> ([InvalidationKeys] -> ShowS)
-> Show InvalidationKeys
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidationKeys] -> ShowS
$cshowList :: [InvalidationKeys] -> ShowS
show :: InvalidationKeys -> String
$cshow :: InvalidationKeys -> String
showsPrec :: Int -> InvalidationKeys -> ShowS
$cshowsPrec :: Int -> InvalidationKeys -> ShowS
Show, InvalidationKeys -> InvalidationKeys -> Bool
(InvalidationKeys -> InvalidationKeys -> Bool)
-> (InvalidationKeys -> InvalidationKeys -> Bool)
-> Eq InvalidationKeys
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidationKeys -> InvalidationKeys -> Bool
$c/= :: InvalidationKeys -> InvalidationKeys -> Bool
== :: InvalidationKeys -> InvalidationKeys -> Bool
$c== :: InvalidationKeys -> InvalidationKeys -> Bool
Eq, (forall x. InvalidationKeys -> Rep InvalidationKeys x)
-> (forall x. Rep InvalidationKeys x -> InvalidationKeys)
-> Generic InvalidationKeys
forall x. Rep InvalidationKeys x -> InvalidationKeys
forall x. InvalidationKeys -> Rep InvalidationKeys x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InvalidationKeys x -> InvalidationKeys
$cfrom :: forall x. InvalidationKeys -> Rep InvalidationKeys x
Generic)

instance Inc.Cacheable InvalidationKeys

instance Inc.Select InvalidationKeys

$(makeLenses ''InvalidationKeys)

initialInvalidationKeys :: InvalidationKeys
initialInvalidationKeys :: InvalidationKeys
initialInvalidationKeys = InvalidationKey
-> HashMap RemoteSchemaName InvalidationKey
-> HashMap SourceName InvalidationKey
-> InvalidationKeys
InvalidationKeys InvalidationKey
Inc.initialInvalidationKey HashMap RemoteSchemaName InvalidationKey
forall a. Monoid a => a
mempty HashMap SourceName InvalidationKey
forall a. Monoid a => a
mempty

invalidateKeys :: CacheInvalidations -> InvalidationKeys -> InvalidationKeys
invalidateKeys :: CacheInvalidations -> InvalidationKeys -> InvalidationKeys
invalidateKeys CacheInvalidations {Bool
HashSet SourceName
HashSet RemoteSchemaName
ciSources :: CacheInvalidations -> HashSet SourceName
ciRemoteSchemas :: CacheInvalidations -> HashSet RemoteSchemaName
ciMetadata :: CacheInvalidations -> Bool
ciSources :: HashSet SourceName
ciRemoteSchemas :: HashSet RemoteSchemaName
ciMetadata :: Bool
..} InvalidationKeys {HashMap SourceName InvalidationKey
HashMap RemoteSchemaName InvalidationKey
InvalidationKey
_ikSources :: HashMap SourceName InvalidationKey
_ikRemoteSchemas :: HashMap RemoteSchemaName InvalidationKey
_ikMetadata :: InvalidationKey
_ikSources :: InvalidationKeys -> HashMap SourceName InvalidationKey
_ikRemoteSchemas :: InvalidationKeys -> HashMap RemoteSchemaName InvalidationKey
_ikMetadata :: InvalidationKeys -> InvalidationKey
..} =
  InvalidationKeys :: InvalidationKey
-> HashMap RemoteSchemaName InvalidationKey
-> HashMap SourceName InvalidationKey
-> InvalidationKeys
InvalidationKeys
    { _ikMetadata :: InvalidationKey
_ikMetadata = if Bool
ciMetadata then InvalidationKey -> InvalidationKey
Inc.invalidate InvalidationKey
_ikMetadata else InvalidationKey
_ikMetadata,
      _ikRemoteSchemas :: HashMap RemoteSchemaName InvalidationKey
_ikRemoteSchemas = (HashMap RemoteSchemaName InvalidationKey
 -> RemoteSchemaName -> HashMap RemoteSchemaName InvalidationKey)
-> HashMap RemoteSchemaName InvalidationKey
-> HashSet RemoteSchemaName
-> HashMap RemoteSchemaName InvalidationKey
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((RemoteSchemaName
 -> HashMap RemoteSchemaName InvalidationKey
 -> HashMap RemoteSchemaName InvalidationKey)
-> HashMap RemoteSchemaName InvalidationKey
-> RemoteSchemaName
-> HashMap RemoteSchemaName InvalidationKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip RemoteSchemaName
-> HashMap RemoteSchemaName InvalidationKey
-> HashMap RemoteSchemaName InvalidationKey
forall a.
(Eq a, Hashable a) =>
a -> HashMap a InvalidationKey -> HashMap a InvalidationKey
invalidate) HashMap RemoteSchemaName InvalidationKey
_ikRemoteSchemas HashSet RemoteSchemaName
ciRemoteSchemas,
      _ikSources :: HashMap SourceName InvalidationKey
_ikSources = (HashMap SourceName InvalidationKey
 -> SourceName -> HashMap SourceName InvalidationKey)
-> HashMap SourceName InvalidationKey
-> HashSet SourceName
-> HashMap SourceName InvalidationKey
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((SourceName
 -> HashMap SourceName InvalidationKey
 -> HashMap SourceName InvalidationKey)
-> HashMap SourceName InvalidationKey
-> SourceName
-> HashMap SourceName InvalidationKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip SourceName
-> HashMap SourceName InvalidationKey
-> HashMap SourceName InvalidationKey
forall a.
(Eq a, Hashable a) =>
a -> HashMap a InvalidationKey -> HashMap a InvalidationKey
invalidate) HashMap SourceName InvalidationKey
_ikSources HashSet SourceName
ciSources
    }
  where
    invalidate ::
      (Eq a, Hashable a) =>
      a ->
      HashMap a Inc.InvalidationKey ->
      HashMap a Inc.InvalidationKey
    invalidate :: a -> HashMap a InvalidationKey -> HashMap a InvalidationKey
invalidate = (Maybe InvalidationKey -> Maybe InvalidationKey)
-> a -> HashMap a InvalidationKey -> HashMap a InvalidationKey
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
M.alter ((Maybe InvalidationKey -> Maybe InvalidationKey)
 -> a -> HashMap a InvalidationKey -> HashMap a InvalidationKey)
-> (Maybe InvalidationKey -> Maybe InvalidationKey)
-> a
-> HashMap a InvalidationKey
-> HashMap a InvalidationKey
forall a b. (a -> b) -> a -> b
$ InvalidationKey -> Maybe InvalidationKey
forall a. a -> Maybe a
Just (InvalidationKey -> Maybe InvalidationKey)
-> (Maybe InvalidationKey -> InvalidationKey)
-> Maybe InvalidationKey
-> Maybe InvalidationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvalidationKey
-> (InvalidationKey -> InvalidationKey)
-> Maybe InvalidationKey
-> InvalidationKey
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InvalidationKey
Inc.initialInvalidationKey InvalidationKey -> InvalidationKey
Inc.invalidate

data TableBuildInput b = TableBuildInput
  { TableBuildInput b -> TableName b
_tbiName :: TableName b,
    TableBuildInput b -> Bool
_tbiIsEnum :: Bool,
    TableBuildInput b -> TableConfig b
_tbiConfiguration :: TableConfig b,
    TableBuildInput b -> Maybe ApolloFederationConfig
_tbiApolloFederationConfig :: Maybe ApolloFederationConfig
  }
  deriving (Int -> TableBuildInput b -> ShowS
[TableBuildInput b] -> ShowS
TableBuildInput b -> String
(Int -> TableBuildInput b -> ShowS)
-> (TableBuildInput b -> String)
-> ([TableBuildInput b] -> ShowS)
-> Show (TableBuildInput b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (b :: BackendType).
Backend b =>
Int -> TableBuildInput b -> ShowS
forall (b :: BackendType).
Backend b =>
[TableBuildInput b] -> ShowS
forall (b :: BackendType). Backend b => TableBuildInput b -> String
showList :: [TableBuildInput b] -> ShowS
$cshowList :: forall (b :: BackendType).
Backend b =>
[TableBuildInput b] -> ShowS
show :: TableBuildInput b -> String
$cshow :: forall (b :: BackendType). Backend b => TableBuildInput b -> String
showsPrec :: Int -> TableBuildInput b -> ShowS
$cshowsPrec :: forall (b :: BackendType).
Backend b =>
Int -> TableBuildInput b -> ShowS
Show, TableBuildInput b -> TableBuildInput b -> Bool
(TableBuildInput b -> TableBuildInput b -> Bool)
-> (TableBuildInput b -> TableBuildInput b -> Bool)
-> Eq (TableBuildInput b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType).
Backend b =>
TableBuildInput b -> TableBuildInput b -> Bool
/= :: TableBuildInput b -> TableBuildInput b -> Bool
$c/= :: forall (b :: BackendType).
Backend b =>
TableBuildInput b -> TableBuildInput b -> Bool
== :: TableBuildInput b -> TableBuildInput b -> Bool
$c== :: forall (b :: BackendType).
Backend b =>
TableBuildInput b -> TableBuildInput b -> Bool
Eq, (forall x. TableBuildInput b -> Rep (TableBuildInput b) x)
-> (forall x. Rep (TableBuildInput b) x -> TableBuildInput b)
-> Generic (TableBuildInput b)
forall x. Rep (TableBuildInput b) x -> TableBuildInput b
forall x. TableBuildInput b -> Rep (TableBuildInput b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (TableBuildInput b) x -> TableBuildInput b
forall (b :: BackendType) x.
TableBuildInput b -> Rep (TableBuildInput b) x
$cto :: forall (b :: BackendType) x.
Rep (TableBuildInput b) x -> TableBuildInput b
$cfrom :: forall (b :: BackendType) x.
TableBuildInput b -> Rep (TableBuildInput b) x
Generic)

instance (Backend b) => NFData (TableBuildInput b)

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

data NonColumnTableInputs b = NonColumnTableInputs
  { NonColumnTableInputs b -> TableName b
_nctiTable :: TableName b,
    NonColumnTableInputs b -> [ObjRelDef b]
_nctiObjectRelationships :: [ObjRelDef b],
    NonColumnTableInputs b -> [ArrRelDef b]
_nctiArrayRelationships :: [ArrRelDef b],
    NonColumnTableInputs b -> [ComputedFieldMetadata b]
_nctiComputedFields :: [ComputedFieldMetadata b],
    NonColumnTableInputs b -> [RemoteRelationship]
_nctiRemoteRelationships :: [RemoteRelationship]
  }
  deriving (Int -> NonColumnTableInputs b -> ShowS
[NonColumnTableInputs b] -> ShowS
NonColumnTableInputs b -> String
(Int -> NonColumnTableInputs b -> ShowS)
-> (NonColumnTableInputs b -> String)
-> ([NonColumnTableInputs b] -> ShowS)
-> Show (NonColumnTableInputs b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (b :: BackendType).
Backend b =>
Int -> NonColumnTableInputs b -> ShowS
forall (b :: BackendType).
Backend b =>
[NonColumnTableInputs b] -> ShowS
forall (b :: BackendType).
Backend b =>
NonColumnTableInputs b -> String
showList :: [NonColumnTableInputs b] -> ShowS
$cshowList :: forall (b :: BackendType).
Backend b =>
[NonColumnTableInputs b] -> ShowS
show :: NonColumnTableInputs b -> String
$cshow :: forall (b :: BackendType).
Backend b =>
NonColumnTableInputs b -> String
showsPrec :: Int -> NonColumnTableInputs b -> ShowS
$cshowsPrec :: forall (b :: BackendType).
Backend b =>
Int -> NonColumnTableInputs b -> ShowS
Show, NonColumnTableInputs b -> NonColumnTableInputs b -> Bool
(NonColumnTableInputs b -> NonColumnTableInputs b -> Bool)
-> (NonColumnTableInputs b -> NonColumnTableInputs b -> Bool)
-> Eq (NonColumnTableInputs b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType).
Backend b =>
NonColumnTableInputs b -> NonColumnTableInputs b -> Bool
/= :: NonColumnTableInputs b -> NonColumnTableInputs b -> Bool
$c/= :: forall (b :: BackendType).
Backend b =>
NonColumnTableInputs b -> NonColumnTableInputs b -> Bool
== :: NonColumnTableInputs b -> NonColumnTableInputs b -> Bool
$c== :: forall (b :: BackendType).
Backend b =>
NonColumnTableInputs b -> NonColumnTableInputs b -> Bool
Eq, (forall x.
 NonColumnTableInputs b -> Rep (NonColumnTableInputs b) x)
-> (forall x.
    Rep (NonColumnTableInputs b) x -> NonColumnTableInputs b)
-> Generic (NonColumnTableInputs b)
forall x. Rep (NonColumnTableInputs b) x -> NonColumnTableInputs b
forall x. NonColumnTableInputs b -> Rep (NonColumnTableInputs b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (NonColumnTableInputs b) x -> NonColumnTableInputs b
forall (b :: BackendType) x.
NonColumnTableInputs b -> Rep (NonColumnTableInputs b) x
$cto :: forall (b :: BackendType) x.
Rep (NonColumnTableInputs b) x -> NonColumnTableInputs b
$cfrom :: forall (b :: BackendType) x.
NonColumnTableInputs b -> Rep (NonColumnTableInputs b) x
Generic)

data TablePermissionInputs b = TablePermissionInputs
  { TablePermissionInputs b -> TableName b
_tpiTable :: TableName b,
    TablePermissionInputs b -> [InsPermDef b]
_tpiInsert :: [InsPermDef b],
    TablePermissionInputs b -> [SelPermDef b]
_tpiSelect :: [SelPermDef b],
    TablePermissionInputs b -> [UpdPermDef b]
_tpiUpdate :: [UpdPermDef b],
    TablePermissionInputs b -> [DelPermDef b]
_tpiDelete :: [DelPermDef b]
  }
  deriving ((forall x.
 TablePermissionInputs b -> Rep (TablePermissionInputs b) x)
-> (forall x.
    Rep (TablePermissionInputs b) x -> TablePermissionInputs b)
-> Generic (TablePermissionInputs b)
forall x.
Rep (TablePermissionInputs b) x -> TablePermissionInputs b
forall x.
TablePermissionInputs b -> Rep (TablePermissionInputs b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (TablePermissionInputs b) x -> TablePermissionInputs b
forall (b :: BackendType) x.
TablePermissionInputs b -> Rep (TablePermissionInputs b) x
$cto :: forall (b :: BackendType) x.
Rep (TablePermissionInputs b) x -> TablePermissionInputs b
$cfrom :: forall (b :: BackendType) x.
TablePermissionInputs b -> Rep (TablePermissionInputs b) x
Generic)

deriving instance (Backend b, Show (TableName b)) => Show (TablePermissionInputs b)

deriving instance (Backend b, Eq (TableName b)) => Eq (TablePermissionInputs b)

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

mkTableInputs ::
  TableMetadata b -> (TableBuildInput b, NonColumnTableInputs b, TablePermissionInputs b)
mkTableInputs :: TableMetadata b
-> (TableBuildInput b, NonColumnTableInputs b,
    TablePermissionInputs b)
mkTableInputs TableMetadata {Bool
Maybe ApolloFederationConfig
Permissions (UpdPermDef b)
Permissions (DelPermDef b)
Permissions (SelPermDef b)
Permissions (InsPermDef b)
Relationships (ObjRelDef b)
Relationships (ArrRelDef b)
RemoteRelationships
EventTriggers b
ComputedFields b
TableName b
TableConfig b
_tmApolloFederationConfig :: forall (b :: BackendType).
TableMetadata b -> Maybe ApolloFederationConfig
_tmEventTriggers :: forall (b :: BackendType). TableMetadata b -> EventTriggers b
_tmDeletePermissions :: forall (b :: BackendType).
TableMetadata b -> Permissions (DelPermDef b)
_tmUpdatePermissions :: forall (b :: BackendType).
TableMetadata b -> Permissions (UpdPermDef b)
_tmSelectPermissions :: forall (b :: BackendType).
TableMetadata b -> Permissions (SelPermDef b)
_tmInsertPermissions :: forall (b :: BackendType).
TableMetadata b -> Permissions (InsPermDef b)
_tmRemoteRelationships :: forall (b :: BackendType). TableMetadata b -> RemoteRelationships
_tmComputedFields :: forall (b :: BackendType). TableMetadata b -> ComputedFields b
_tmArrayRelationships :: forall (b :: BackendType).
TableMetadata b -> Relationships (ArrRelDef b)
_tmObjectRelationships :: forall (b :: BackendType).
TableMetadata b -> Relationships (ObjRelDef b)
_tmConfiguration :: forall (b :: BackendType). TableMetadata b -> TableConfig b
_tmIsEnum :: forall (b :: BackendType). TableMetadata b -> Bool
_tmTable :: forall (b :: BackendType). TableMetadata b -> TableName b
_tmApolloFederationConfig :: Maybe ApolloFederationConfig
_tmEventTriggers :: EventTriggers b
_tmDeletePermissions :: Permissions (DelPermDef b)
_tmUpdatePermissions :: Permissions (UpdPermDef b)
_tmSelectPermissions :: Permissions (SelPermDef b)
_tmInsertPermissions :: Permissions (InsPermDef b)
_tmRemoteRelationships :: RemoteRelationships
_tmComputedFields :: ComputedFields b
_tmArrayRelationships :: Relationships (ArrRelDef b)
_tmObjectRelationships :: Relationships (ObjRelDef b)
_tmConfiguration :: TableConfig b
_tmIsEnum :: Bool
_tmTable :: TableName b
..} =
  (TableBuildInput b
buildInput, NonColumnTableInputs b
nonColumns, TablePermissionInputs b
permissions)
  where
    buildInput :: TableBuildInput b
buildInput = TableName b
-> Bool
-> TableConfig b
-> Maybe ApolloFederationConfig
-> TableBuildInput b
forall (b :: BackendType).
TableName b
-> Bool
-> TableConfig b
-> Maybe ApolloFederationConfig
-> TableBuildInput b
TableBuildInput TableName b
_tmTable Bool
_tmIsEnum TableConfig b
_tmConfiguration Maybe ApolloFederationConfig
_tmApolloFederationConfig
    nonColumns :: NonColumnTableInputs b
nonColumns =
      TableName b
-> [ObjRelDef b]
-> [ArrRelDef b]
-> [ComputedFieldMetadata b]
-> [RemoteRelationship]
-> NonColumnTableInputs b
forall (b :: BackendType).
TableName b
-> [ObjRelDef b]
-> [ArrRelDef b]
-> [ComputedFieldMetadata b]
-> [RemoteRelationship]
-> NonColumnTableInputs b
NonColumnTableInputs
        TableName b
_tmTable
        (Relationships (ObjRelDef b) -> [ObjRelDef b]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems Relationships (ObjRelDef b)
_tmObjectRelationships)
        (Relationships (ArrRelDef b) -> [ArrRelDef b]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems Relationships (ArrRelDef b)
_tmArrayRelationships)
        (ComputedFields b -> [ComputedFieldMetadata b]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems ComputedFields b
_tmComputedFields)
        (RemoteRelationships -> [RemoteRelationship]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems RemoteRelationships
_tmRemoteRelationships)
    permissions :: TablePermissionInputs b
permissions =
      TableName b
-> [InsPermDef b]
-> [SelPermDef b]
-> [UpdPermDef b]
-> [DelPermDef b]
-> TablePermissionInputs b
forall (b :: BackendType).
TableName b
-> [InsPermDef b]
-> [SelPermDef b]
-> [UpdPermDef b]
-> [DelPermDef b]
-> TablePermissionInputs b
TablePermissionInputs
        TableName b
_tmTable
        (Permissions (InsPermDef b) -> [InsPermDef b]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems Permissions (InsPermDef b)
_tmInsertPermissions)
        (Permissions (SelPermDef b) -> [SelPermDef b]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems Permissions (SelPermDef b)
_tmSelectPermissions)
        (Permissions (UpdPermDef b) -> [UpdPermDef b]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems Permissions (UpdPermDef b)
_tmUpdatePermissions)
        (Permissions (DelPermDef b) -> [DelPermDef b]
forall k v. InsOrdHashMap k v -> [v]
OMap.elems Permissions (DelPermDef b)
_tmDeletePermissions)

-- | The direct output of 'buildSchemaCacheRule'. Contains most of the things necessary to build a
-- schema cache, but dependencies and inconsistent metadata objects are collected via a separate
-- 'MonadWriter' side channel.
data BuildOutputs = BuildOutputs
  { BuildOutputs -> SourceCache
_boSources :: SourceCache,
    BuildOutputs -> ActionCache
_boActions :: ActionCache,
    -- | We preserve the 'MetadataObject' from the original catalog metadata in the output so we can
    -- reuse it later if we need to mark the remote schema inconsistent during GraphQL schema
    -- generation (because of field conflicts).
    BuildOutputs
-> HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject)
_boRemoteSchemas :: HashMap RemoteSchemaName (RemoteSchemaCtx, MetadataObject),
    BuildOutputs -> InlinedAllowlist
_boAllowlist :: InlinedAllowlist,
    BuildOutputs -> AnnotatedCustomTypes
_boCustomTypes :: AnnotatedCustomTypes,
    BuildOutputs -> HashMap TriggerName CronTriggerInfo
_boCronTriggers :: M.HashMap TriggerName CronTriggerInfo,
    BuildOutputs
-> HashMap EndpointName (EndpointMetadata GQLQueryWithText)
_boEndpoints :: M.HashMap EndpointName (EndpointMetadata GQLQueryWithText),
    BuildOutputs -> ApiLimit
_boApiLimits :: ApiLimit,
    BuildOutputs -> MetricsConfig
_boMetricsConfig :: MetricsConfig,
    BuildOutputs -> HashMap RoleName Role
_boRoles :: HashMap RoleName Role,
    BuildOutputs -> [TlsAllow]
_boTlsAllowlist :: [TlsAllow],
    BuildOutputs -> QueryCollections
_boQueryCollections :: QueryCollections
  }

$(makeLenses ''BuildOutputs)

-- | Parameters required for schema cache build
data CacheBuildParams = CacheBuildParams
  { CacheBuildParams -> Manager
_cbpManager :: HTTP.Manager,
    CacheBuildParams -> SourceResolver ('Postgres 'Vanilla)
_cbpPGSourceResolver :: SourceResolver ('Postgres 'Vanilla),
    CacheBuildParams -> SourceResolver 'MSSQL
_cbpMSSQLSourceResolver :: SourceResolver 'MSSQL,
    CacheBuildParams -> ServerConfigCtx
_cbpServerConfigCtx :: ServerConfigCtx
  }

-- | The monad in which @'RebuildableSchemaCache' is being run
newtype CacheBuild a = CacheBuild (ReaderT CacheBuildParams (ExceptT QErr IO) a)
  deriving
    ( a -> CacheBuild b -> CacheBuild a
(a -> b) -> CacheBuild a -> CacheBuild b
(forall a b. (a -> b) -> CacheBuild a -> CacheBuild b)
-> (forall a b. a -> CacheBuild b -> CacheBuild a)
-> Functor CacheBuild
forall a b. a -> CacheBuild b -> CacheBuild a
forall a b. (a -> b) -> CacheBuild a -> CacheBuild b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CacheBuild b -> CacheBuild a
$c<$ :: forall a b. a -> CacheBuild b -> CacheBuild a
fmap :: (a -> b) -> CacheBuild a -> CacheBuild b
$cfmap :: forall a b. (a -> b) -> CacheBuild a -> CacheBuild b
Functor,
      Functor CacheBuild
a -> CacheBuild a
Functor CacheBuild
-> (forall a. a -> CacheBuild a)
-> (forall a b.
    CacheBuild (a -> b) -> CacheBuild a -> CacheBuild b)
-> (forall a b c.
    (a -> b -> c) -> CacheBuild a -> CacheBuild b -> CacheBuild c)
-> (forall a b. CacheBuild a -> CacheBuild b -> CacheBuild b)
-> (forall a b. CacheBuild a -> CacheBuild b -> CacheBuild a)
-> Applicative CacheBuild
CacheBuild a -> CacheBuild b -> CacheBuild b
CacheBuild a -> CacheBuild b -> CacheBuild a
CacheBuild (a -> b) -> CacheBuild a -> CacheBuild b
(a -> b -> c) -> CacheBuild a -> CacheBuild b -> CacheBuild c
forall a. a -> CacheBuild a
forall a b. CacheBuild a -> CacheBuild b -> CacheBuild a
forall a b. CacheBuild a -> CacheBuild b -> CacheBuild b
forall a b. CacheBuild (a -> b) -> CacheBuild a -> CacheBuild b
forall a b c.
(a -> b -> c) -> CacheBuild a -> CacheBuild b -> CacheBuild 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
<* :: CacheBuild a -> CacheBuild b -> CacheBuild a
$c<* :: forall a b. CacheBuild a -> CacheBuild b -> CacheBuild a
*> :: CacheBuild a -> CacheBuild b -> CacheBuild b
$c*> :: forall a b. CacheBuild a -> CacheBuild b -> CacheBuild b
liftA2 :: (a -> b -> c) -> CacheBuild a -> CacheBuild b -> CacheBuild c
$cliftA2 :: forall a b c.
(a -> b -> c) -> CacheBuild a -> CacheBuild b -> CacheBuild c
<*> :: CacheBuild (a -> b) -> CacheBuild a -> CacheBuild b
$c<*> :: forall a b. CacheBuild (a -> b) -> CacheBuild a -> CacheBuild b
pure :: a -> CacheBuild a
$cpure :: forall a. a -> CacheBuild a
$cp1Applicative :: Functor CacheBuild
Applicative,
      Applicative CacheBuild
a -> CacheBuild a
Applicative CacheBuild
-> (forall a b.
    CacheBuild a -> (a -> CacheBuild b) -> CacheBuild b)
-> (forall a b. CacheBuild a -> CacheBuild b -> CacheBuild b)
-> (forall a. a -> CacheBuild a)
-> Monad CacheBuild
CacheBuild a -> (a -> CacheBuild b) -> CacheBuild b
CacheBuild a -> CacheBuild b -> CacheBuild b
forall a. a -> CacheBuild a
forall a b. CacheBuild a -> CacheBuild b -> CacheBuild b
forall a b. CacheBuild a -> (a -> CacheBuild b) -> CacheBuild 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 -> CacheBuild a
$creturn :: forall a. a -> CacheBuild a
>> :: CacheBuild a -> CacheBuild b -> CacheBuild b
$c>> :: forall a b. CacheBuild a -> CacheBuild b -> CacheBuild b
>>= :: CacheBuild a -> (a -> CacheBuild b) -> CacheBuild b
$c>>= :: forall a b. CacheBuild a -> (a -> CacheBuild b) -> CacheBuild b
$cp1Monad :: Applicative CacheBuild
Monad,
      MonadError QErr,
      MonadReader CacheBuildParams,
      Monad CacheBuild
Monad CacheBuild
-> (forall a. IO a -> CacheBuild a) -> MonadIO CacheBuild
IO a -> CacheBuild a
forall a. IO a -> CacheBuild a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> CacheBuild a
$cliftIO :: forall a. IO a -> CacheBuild a
$cp1MonadIO :: Monad CacheBuild
MonadIO,
      MonadBase IO,
      MonadBaseControl IO,
      Monad CacheBuild
CacheBuild Unique
Monad CacheBuild -> CacheBuild Unique -> MonadUnique CacheBuild
forall (m :: * -> *). Monad m -> m Unique -> MonadUnique m
newUnique :: CacheBuild Unique
$cnewUnique :: CacheBuild Unique
$cp1MonadUnique :: Monad CacheBuild
MonadUnique
    )

instance HasHttpManagerM CacheBuild where
  askHttpManager :: CacheBuild Manager
askHttpManager = (CacheBuildParams -> Manager) -> CacheBuild Manager
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheBuildParams -> Manager
_cbpManager

instance HasServerConfigCtx CacheBuild where
  askServerConfigCtx :: CacheBuild ServerConfigCtx
askServerConfigCtx = (CacheBuildParams -> ServerConfigCtx) -> CacheBuild ServerConfigCtx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheBuildParams -> ServerConfigCtx
_cbpServerConfigCtx

instance MonadResolveSource CacheBuild where
  getPGSourceResolver :: CacheBuild (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver = (CacheBuildParams
 -> SourceName
 -> PostgresConnConfiguration
 -> IO (Either QErr PGSourceConfig))
-> CacheBuild
     (SourceName
      -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheBuildParams
-> SourceName
-> PostgresConnConfiguration
-> IO (Either QErr PGSourceConfig)
CacheBuildParams -> SourceResolver ('Postgres 'Vanilla)
_cbpPGSourceResolver
  getMSSQLSourceResolver :: CacheBuild (SourceResolver 'MSSQL)
getMSSQLSourceResolver = (CacheBuildParams
 -> SourceName
 -> MSSQLConnConfiguration
 -> IO (Either QErr MSSQLSourceConfig))
-> CacheBuild
     (SourceName
      -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CacheBuildParams
-> SourceName
-> MSSQLConnConfiguration
-> IO (Either QErr MSSQLSourceConfig)
CacheBuildParams -> SourceResolver 'MSSQL
_cbpMSSQLSourceResolver

runCacheBuild ::
  ( MonadIO m,
    MonadError QErr m
  ) =>
  CacheBuildParams ->
  CacheBuild a ->
  m a
runCacheBuild :: CacheBuildParams -> CacheBuild a -> m a
runCacheBuild CacheBuildParams
params (CacheBuild ReaderT CacheBuildParams (ExceptT QErr IO) a
m) = do
  m (Either QErr a) -> m a
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr a) -> m a) -> m (Either QErr a) -> m a
forall a b. (a -> b) -> a -> b
$ IO (Either QErr a) -> m (Either QErr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either QErr a) -> m (Either QErr a))
-> IO (Either QErr a) -> m (Either QErr a)
forall a b. (a -> b) -> a -> b
$ ExceptT QErr IO a -> IO (Either QErr a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ReaderT CacheBuildParams (ExceptT QErr IO) a
-> CacheBuildParams -> ExceptT QErr IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT CacheBuildParams (ExceptT QErr IO) a
m CacheBuildParams
params)

runCacheBuildM ::
  ( MonadIO m,
    MonadError QErr m,
    HasHttpManagerM m,
    HasServerConfigCtx m,
    MonadResolveSource m
  ) =>
  CacheBuild a ->
  m a
runCacheBuildM :: CacheBuild a -> m a
runCacheBuildM CacheBuild a
m = do
  CacheBuildParams
params <-
    Manager
-> (SourceName
    -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
-> (SourceName
    -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
-> ServerConfigCtx
-> CacheBuildParams
Manager
-> SourceResolver ('Postgres 'Vanilla)
-> SourceResolver 'MSSQL
-> ServerConfigCtx
-> CacheBuildParams
CacheBuildParams
      (Manager
 -> (SourceName
     -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
 -> (SourceName
     -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
 -> ServerConfigCtx
 -> CacheBuildParams)
-> m Manager
-> m ((SourceName
       -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
      -> (SourceName
          -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
      -> ServerConfigCtx
      -> CacheBuildParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Manager
forall (m :: * -> *). HasHttpManagerM m => m Manager
askHttpManager
      m ((SourceName
    -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
   -> (SourceName
       -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
   -> ServerConfigCtx
   -> CacheBuildParams)
-> m (SourceName
      -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
-> m ((SourceName
       -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
      -> ServerConfigCtx -> CacheBuildParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (SourceName
   -> PostgresConnConfiguration -> IO (Either QErr PGSourceConfig))
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver ('Postgres 'Vanilla))
getPGSourceResolver
      m ((SourceName
    -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
   -> ServerConfigCtx -> CacheBuildParams)
-> m (SourceName
      -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
-> m (ServerConfigCtx -> CacheBuildParams)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (SourceName
   -> MSSQLConnConfiguration -> IO (Either QErr MSSQLSourceConfig))
forall (m :: * -> *).
MonadResolveSource m =>
m (SourceResolver 'MSSQL)
getMSSQLSourceResolver
      m (ServerConfigCtx -> CacheBuildParams)
-> m ServerConfigCtx -> m CacheBuildParams
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m ServerConfigCtx
forall (m :: * -> *). HasServerConfigCtx m => m ServerConfigCtx
askServerConfigCtx
  CacheBuildParams -> CacheBuild a -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadError QErr m) =>
CacheBuildParams -> CacheBuild a -> m a
runCacheBuild CacheBuildParams
params CacheBuild a
m

data RebuildableSchemaCache = RebuildableSchemaCache
  { RebuildableSchemaCache -> SchemaCache
lastBuiltSchemaCache :: SchemaCache,
    RebuildableSchemaCache -> InvalidationKeys
_rscInvalidationMap :: InvalidationKeys,
    RebuildableSchemaCache
-> Rule
     (ReaderT BuildReason CacheBuild)
     (Metadata, InvalidationKeys)
     SchemaCache
_rscRebuild :: Inc.Rule (ReaderT BuildReason CacheBuild) (Metadata, InvalidationKeys) SchemaCache
  }

bindErrorA ::
  (ArrowChoice arr, ArrowKleisli m arr, ArrowError e arr, MonadError e m) =>
  arr (m a) a
bindErrorA :: arr (m a) a
bindErrorA = arr (Either e a) a
forall (arr :: * -> * -> *) e a.
(ArrowChoice arr, ArrowError e arr) =>
arr (Either e a) a
liftEitherA arr (Either e a) a -> arr (m a) (Either e a) -> arr (m a) a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< (m a -> m (Either e a)) -> arr (m a) (Either e a)
forall (m :: * -> *) (arr :: * -> * -> *) a b.
ArrowKleisli m arr =>
(a -> m b) -> arr a b
arrM \m a
m -> (a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a) -> m a -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
m) m (Either e a) -> (e -> m (Either e a)) -> m (Either e a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (Either e a -> m (Either e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> m (Either e a))
-> (e -> Either e a) -> e -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left)
{-# INLINE bindErrorA #-}

withRecordDependencies ::
  (ArrowWriter (Seq CollectedInfo) arr) =>
  WriterA (Seq SchemaDependency) arr (e, s) a ->
  arr (e, (MetadataObject, (SchemaObjId, s))) a
withRecordDependencies :: WriterA (Seq SchemaDependency) arr (e, s) a
-> arr (e, (MetadataObject, (SchemaObjId, s))) a
withRecordDependencies WriterA (Seq SchemaDependency) arr (e, s) a
f = proc (e
e, (MetadataObject
metadataObject, (SchemaObjId
schemaObjectId, s
s))) -> do
  (a
result, Seq SchemaDependency
dependencies) <- WriterA (Seq SchemaDependency) arr (e, s) a
-> (Monoid (Seq SchemaDependency), Arrow arr) =>
   arr (e, s) (a, Seq SchemaDependency)
forall w (arr :: * -> * -> *) a b.
WriterA w arr a b -> (Monoid w, Arrow arr) => arr a (b, w)
runWriterA WriterA (Seq SchemaDependency) arr (e, s) a
f -< (e
e, s
s)
  arr (MetadataObject, SchemaObjId, [SchemaDependency]) ()
forall (arr :: * -> * -> *).
ArrowWriter (Seq CollectedInfo) arr =>
arr (MetadataObject, SchemaObjId, [SchemaDependency]) ()
recordDependencies -< (MetadataObject
metadataObject, SchemaObjId
schemaObjectId, Seq SchemaDependency -> [SchemaDependency]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq SchemaDependency
dependencies)
  arr a a
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a
result
{-# INLINEABLE withRecordDependencies #-}

noDuplicates ::
  (MonadWriter (Seq CollectedInfo) m) =>
  (a -> MetadataObject) ->
  [a] ->
  m (Maybe a)
noDuplicates :: (a -> MetadataObject) -> [a] -> m (Maybe a)
noDuplicates a -> MetadataObject
mkMetadataObject = \case
  [] -> Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  [a
value] -> Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
value
  values :: [a]
values@(a
value : [a]
_) -> do
    let objectId :: MetadataObjId
objectId = MetadataObject -> MetadataObjId
_moId (MetadataObject -> MetadataObjId)
-> MetadataObject -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ a -> MetadataObject
mkMetadataObject a
value
        definitions :: [Value]
definitions = (a -> Value) -> [a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (MetadataObject -> Value
_moDefinition (MetadataObject -> Value) -> (a -> MetadataObject) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MetadataObject
mkMetadataObject) [a]
values
    Seq CollectedInfo -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Seq CollectedInfo -> m ()) -> Seq CollectedInfo -> m ()
forall a b. (a -> b) -> a -> b
$ CollectedInfo -> Seq CollectedInfo
forall a. a -> Seq a
Seq.singleton (CollectedInfo -> Seq CollectedInfo)
-> CollectedInfo -> Seq CollectedInfo
forall a b. (a -> b) -> a -> b
$ InconsistentMetadata -> CollectedInfo
CIInconsistency (MetadataObjId -> [Value] -> InconsistentMetadata
DuplicateObjects MetadataObjId
objectId [Value]
definitions)
    Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

-- | Processes a list of catalog metadata into a map of processed information, marking any duplicate
-- entries inconsistent.
buildInfoMap ::
  ( ArrowChoice arr,
    Inc.ArrowDistribute arr,
    ArrowWriter (Seq CollectedInfo) arr,
    Eq k,
    Hashable k
  ) =>
  (a -> k) ->
  (a -> MetadataObject) ->
  (e, a) `arr` Maybe b ->
  (e, [a]) `arr` HashMap k b
buildInfoMap :: (a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe b)
-> arr (e, [a]) (HashMap k b)
buildInfoMap a -> k
extractKey a -> MetadataObject
mkMetadataObject arr (e, a) (Maybe b)
buildInfo = proc (e
e, [a]
infos) ->
  ((a -> k) -> [a] -> HashMap k [a]
forall k (t :: * -> *) v.
(Eq k, Hashable k, Foldable t) =>
(v -> k) -> t v -> HashMap k [v]
M.groupOn a -> k
extractKey [a]
infos >- arr (HashMap k [a]) (HashMap k [a])
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA)
    forall a.
arr (a, ()) (HashMap k [a])
-> arr (a, (HashMap k [a], ())) (HashMap k (Maybe b))
-> arr (a, ()) (HashMap k (Maybe 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, (k, ([a], ()))) (Maybe b)
-> arr (a, (HashMap k [a], ())) (HashMap k (Maybe 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
            ( \k
_ [a]
duplicateInfos ->
                ((a -> MetadataObject)
-> [a] -> WriterT (Seq CollectedInfo) Identity (Maybe a)
forall (m :: * -> *) a.
MonadWriter (Seq CollectedInfo) m =>
(a -> MetadataObject) -> [a] -> m (Maybe a)
noDuplicates a -> MetadataObject
mkMetadataObject [a]
duplicateInfos >- arr (WriterT (Seq CollectedInfo) Identity (Maybe a)) (Maybe a)
forall w (arr :: * -> * -> *) a.
ArrowWriter w arr =>
arr (Writer w a) a
interpretWriter)
                  forall a.
arr (a, ()) (Maybe a)
-> arr (a, (Maybe a, ())) (Maybe (Maybe b))
-> arr (a, ()) (Maybe (Maybe 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, (a, ())) (Maybe b)
-> arr (a, (Maybe a, ())) (Maybe (Maybe b))
forall (arr :: * -> * -> *) (t :: * -> *) e a s b.
(ArrowChoice arr, Traversable t) =>
arr (e, (a, s)) b -> arr (e, (t a, s)) (t b)
traverseA (\a
info -> (e
e, a
info) >- arr (e, a) (Maybe b)
buildInfo) |)
                  forall a.
arr (a, ()) (Maybe (Maybe b))
-> arr (a, (Maybe (Maybe b), ())) (Maybe b)
-> arr (a, ()) (Maybe b)
forall (arr :: * -> * -> *) e s a b.
Arrow arr =>
arr (e, s) a -> arr (e, (a, s)) b -> arr (e, s) b
>-> (\Maybe (Maybe b)
info -> Maybe (Maybe b) -> Maybe b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe b)
info >- arr (Maybe b) (Maybe b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA)
            )
        |)
    forall a.
arr (a, ()) (HashMap k (Maybe b))
-> arr (a, (HashMap k (Maybe b), ())) (HashMap k b)
-> arr (a, ()) (HashMap k b)
forall (arr :: * -> * -> *) e s a b.
Arrow arr =>
arr (e, s) a -> arr (e, (a, s)) b -> arr (e, s) b
>-> (\HashMap k (Maybe b)
infoMap -> HashMap k (Maybe b) -> HashMap k b
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes HashMap k (Maybe b)
infoMap >- arr (HashMap k b) (HashMap k b)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA)
{-# INLINEABLE buildInfoMap #-}

-- | Like 'buildInfo', but includes each processed info’s associated 'MetadataObject' in the result.
-- This is useful if the results will be further processed, and the 'MetadataObject' is still needed
-- to mark the object inconsistent.
buildInfoMapPreservingMetadata ::
  ( ArrowChoice arr,
    Inc.ArrowDistribute arr,
    ArrowWriter (Seq CollectedInfo) arr,
    Eq k,
    Hashable k
  ) =>
  (a -> k) ->
  (a -> MetadataObject) ->
  (e, a) `arr` Maybe b ->
  (e, [a]) `arr` HashMap k (b, MetadataObject)
buildInfoMapPreservingMetadata :: (a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe b)
-> arr (e, [a]) (HashMap k (b, MetadataObject))
buildInfoMapPreservingMetadata a -> k
extractKey a -> MetadataObject
mkMetadataObject arr (e, a) (Maybe b)
buildInfo =
  (a -> k)
-> (a -> MetadataObject)
-> arr (e, a) (Maybe (b, MetadataObject))
-> arr (e, [a]) (HashMap k (b, 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)
buildInfoMap a -> k
extractKey a -> MetadataObject
mkMetadataObject proc (e
e, a
info) ->
    ((e
e, a
info) >- arr (e, a) (Maybe b)
buildInfo) forall a.
arr (a, ()) (Maybe b)
-> arr (a, (Maybe b, ())) (Maybe (b, MetadataObject))
-> arr (a, ()) (Maybe (b, MetadataObject))
forall (arr :: * -> * -> *) e s a b.
Arrow arr =>
arr (e, s) a -> arr (e, (a, s)) b -> arr (e, s) b
>-> \Maybe b
result -> Maybe b
result Maybe b -> (b -> (b, MetadataObject)) -> Maybe (b, MetadataObject)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,a -> MetadataObject
mkMetadataObject a
info) >- arr (Maybe (b, MetadataObject)) (Maybe (b, MetadataObject))
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA
{-# INLINEABLE buildInfoMapPreservingMetadata #-}

addTableContext :: (Backend b) => TableName b -> Text -> Text
addTableContext :: TableName b -> Text -> Text
addTableContext TableName b
tableName Text
e = Text
"in table " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b
tableName TableName b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e