{-# LANGUAGE UndecidableInstances #-}

module Hasura.RQL.Types.SchemaCache
  ( SchemaCache (..),
    TableConfig (..),
    emptyTableConfig,
    getAllRemoteSchemas,
    unsafeFunctionCache,
    unsafeFunctionInfo,
    unsafeTableCache,
    unsafeTableInfo,
    askSourceInfo,
    askSourceInfoMaybe,
    askSourceConfig,
    askSourceConfigMaybe,
    askTableCache,
    askTableInfo,
    askTableCoreInfo,
    askTableFieldInfoMap,
    askTableMetadata,
    askFunctionInfo,
    askFieldInfoMapSource,
    TableCoreCache,
    TableCache,
    ActionCache,
    InheritedRolesCache,
    TableCoreInfoG (..),
    TableCoreInfo,
    tciName,
    tciDescription,
    tciFieldInfoMap,
    tciPrimaryKey,
    tciUniqueConstraints,
    tciForeignKeys,
    tciViewInfo,
    tciEnumValues,
    tciCustomConfig,
    tciUniqueOrPrimaryKeyConstraints,
    TableInfo (..),
    tiCoreInfo,
    tiRolePermInfoMap,
    tiEventTriggerInfoMap,
    ViewInfo (..),
    isMutable,
    IntrospectionResult (..),
    RemoteSchemaCustomizer (..),
    remoteSchemaCustomizeTypeName,
    remoteSchemaCustomizeFieldName,
    RemoteSchemaRelationships,
    RemoteSchemaCtxG (..),
    PartiallyResolvedRemoteSchemaCtx,
    RemoteSchemaCtx,
    PartiallyResolvedRemoteSchemaMap,
    RemoteSchemaMap,
    DepMap,
    WithDeps,
    TableCoreInfoRM (..),
    TableCoreCacheRT (..),
    TableInfoRM (..),
    TableCacheRT (..),
    CacheRM (..),
    FieldInfoMap,
    FieldInfo (..),
    _FIColumn,
    _FIRelationship,
    _FIComputedField,
    fieldInfoName,
    fieldInfoGraphQLNames,
    getCols,
    getRels,
    getComputedFieldInfos,
    RolePermInfoMap,
    InsPermInfo (..),
    UpdPermInfo (..),
    DelPermInfo (..),
    PreSetColsPartial,
    EventTriggerInfo (..),
    EventTriggerInfoMap,
    TableObjId (..),
    SchemaObjId (..),
    reportSchemaObj,
    reportSchemaObjs,
    DependencyReason (..),
    SchemaDependency (..),
    mkParentDep,
    mkLogicalModelParentDep,
    mkColDep,
    mkLogicalModelColDep,
    mkComputedFieldDep,
    getDependentObjs,
    getDependentObjsWith,
    getRemoteDependencies,
    FunctionVolatility (..),
    FunctionArgName (..),
    FunctionInfo (..),
    FunctionCache,
    CronTriggerInfo (..),
    MetadataResourceVersion (..),
    showMetadataResourceVersion,
    initialResourceVersion,
    MetadataWithResourceVersion (..),
    getLogicalModelBoolExpDeps,
    getBoolExpDeps,
    InlinedAllowlist,
    BoolExpM (..),
    BoolExpCtx (..),
    getOpExpDeps,
    BackendInfoWrapper (..),
    BackendCache,
    getBackendInfo,
  )
where

import Control.Lens (Traversal', at, preview, (^.))
import Data.Aeson
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet qualified as HS
import Data.Int (Int64)
import Data.Text qualified as T
import Data.Text.Extended ((<<>))
import Data.Text.Extended qualified as T
import Database.MSSQL.Transaction qualified as MSSQL
import Database.PG.Query qualified as PG
import Hasura.Backends.Postgres.Connection qualified as Postgres
import Hasura.Base.Error
import Hasura.Function.Cache
import Hasura.GraphQL.Context (GQLContext, RoleContext)
import Hasura.LogicalModel.Types (LogicalModelName)
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.Allowlist
import Hasura.RQL.Types.ApiLimit
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendTag (HasTag (backendTag), reify)
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.Endpoint
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.GraphqlSchemaIntrospection
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.OpenTelemetry (OpenTelemetryInfo)
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.Relationships.Remote
import Hasura.RQL.Types.Roles (RoleName)
import Hasura.RQL.Types.ScheduledTrigger
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.RQL.Types.Session (UserInfoM)
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.Webhook.Transform
import Hasura.RemoteSchema.Metadata
import Hasura.RemoteSchema.SchemaCache.Types
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.BackendMap (BackendMap)
import Hasura.SQL.BackendMap qualified as BackendMap
import Hasura.Table.Cache
import Hasura.Table.Metadata (TableMetadata (..))
import Hasura.Tracing (TraceT)
import Language.GraphQL.Draft.Syntax qualified as G
import Network.Types.Extended (TlsAllow)
import System.Cron.Types

newtype MetadataResourceVersion = MetadataResourceVersion
  { MetadataResourceVersion -> Int64
getMetadataResourceVersion :: Int64
  }
  deriving (MetadataResourceVersion -> MetadataResourceVersion -> Bool
(MetadataResourceVersion -> MetadataResourceVersion -> Bool)
-> (MetadataResourceVersion -> MetadataResourceVersion -> Bool)
-> Eq MetadataResourceVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetadataResourceVersion -> MetadataResourceVersion -> Bool
== :: MetadataResourceVersion -> MetadataResourceVersion -> Bool
$c/= :: MetadataResourceVersion -> MetadataResourceVersion -> Bool
/= :: MetadataResourceVersion -> MetadataResourceVersion -> Bool
Eq, Integer -> MetadataResourceVersion
MetadataResourceVersion -> MetadataResourceVersion
MetadataResourceVersion
-> MetadataResourceVersion -> MetadataResourceVersion
(MetadataResourceVersion
 -> MetadataResourceVersion -> MetadataResourceVersion)
-> (MetadataResourceVersion
    -> MetadataResourceVersion -> MetadataResourceVersion)
-> (MetadataResourceVersion
    -> MetadataResourceVersion -> MetadataResourceVersion)
-> (MetadataResourceVersion -> MetadataResourceVersion)
-> (MetadataResourceVersion -> MetadataResourceVersion)
-> (MetadataResourceVersion -> MetadataResourceVersion)
-> (Integer -> MetadataResourceVersion)
-> Num MetadataResourceVersion
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: MetadataResourceVersion
-> MetadataResourceVersion -> MetadataResourceVersion
+ :: MetadataResourceVersion
-> MetadataResourceVersion -> MetadataResourceVersion
$c- :: MetadataResourceVersion
-> MetadataResourceVersion -> MetadataResourceVersion
- :: MetadataResourceVersion
-> MetadataResourceVersion -> MetadataResourceVersion
$c* :: MetadataResourceVersion
-> MetadataResourceVersion -> MetadataResourceVersion
* :: MetadataResourceVersion
-> MetadataResourceVersion -> MetadataResourceVersion
$cnegate :: MetadataResourceVersion -> MetadataResourceVersion
negate :: MetadataResourceVersion -> MetadataResourceVersion
$cabs :: MetadataResourceVersion -> MetadataResourceVersion
abs :: MetadataResourceVersion -> MetadataResourceVersion
$csignum :: MetadataResourceVersion -> MetadataResourceVersion
signum :: MetadataResourceVersion -> MetadataResourceVersion
$cfromInteger :: Integer -> MetadataResourceVersion
fromInteger :: Integer -> MetadataResourceVersion
Num, Value -> Parser [MetadataResourceVersion]
Value -> Parser MetadataResourceVersion
(Value -> Parser MetadataResourceVersion)
-> (Value -> Parser [MetadataResourceVersion])
-> FromJSON MetadataResourceVersion
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser MetadataResourceVersion
parseJSON :: Value -> Parser MetadataResourceVersion
$cparseJSONList :: Value -> Parser [MetadataResourceVersion]
parseJSONList :: Value -> Parser [MetadataResourceVersion]
FromJSON, [MetadataResourceVersion] -> Value
[MetadataResourceVersion] -> Encoding
MetadataResourceVersion -> Value
MetadataResourceVersion -> Encoding
(MetadataResourceVersion -> Value)
-> (MetadataResourceVersion -> Encoding)
-> ([MetadataResourceVersion] -> Value)
-> ([MetadataResourceVersion] -> Encoding)
-> ToJSON MetadataResourceVersion
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: MetadataResourceVersion -> Value
toJSON :: MetadataResourceVersion -> Value
$ctoEncoding :: MetadataResourceVersion -> Encoding
toEncoding :: MetadataResourceVersion -> Encoding
$ctoJSONList :: [MetadataResourceVersion] -> Value
toJSONList :: [MetadataResourceVersion] -> Value
$ctoEncodingList :: [MetadataResourceVersion] -> Encoding
toEncodingList :: [MetadataResourceVersion] -> Encoding
ToJSON)

initialResourceVersion :: MetadataResourceVersion
initialResourceVersion :: MetadataResourceVersion
initialResourceVersion = Int64 -> MetadataResourceVersion
MetadataResourceVersion Int64
0

showMetadataResourceVersion :: MetadataResourceVersion -> Text
showMetadataResourceVersion :: MetadataResourceVersion -> Text
showMetadataResourceVersion (MetadataResourceVersion Int64
version) = Int64 -> Text
forall a. Show a => a -> Text
tshow Int64
version

instance Show MetadataResourceVersion where
  show :: MetadataResourceVersion -> String
show = Text -> String
T.unpack (Text -> String)
-> (MetadataResourceVersion -> Text)
-> MetadataResourceVersion
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataResourceVersion -> Text
showMetadataResourceVersion

data MetadataWithResourceVersion = MetadataWithResourceVersion
  { MetadataWithResourceVersion -> Metadata
_mwrvMetadata :: Metadata,
    MetadataWithResourceVersion -> MetadataResourceVersion
_mwrvResourceVersion :: MetadataResourceVersion
  }
  deriving (MetadataWithResourceVersion -> MetadataWithResourceVersion -> Bool
(MetadataWithResourceVersion
 -> MetadataWithResourceVersion -> Bool)
-> (MetadataWithResourceVersion
    -> MetadataWithResourceVersion -> Bool)
-> Eq MetadataWithResourceVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetadataWithResourceVersion -> MetadataWithResourceVersion -> Bool
== :: MetadataWithResourceVersion -> MetadataWithResourceVersion -> Bool
$c/= :: MetadataWithResourceVersion -> MetadataWithResourceVersion -> Bool
/= :: MetadataWithResourceVersion -> MetadataWithResourceVersion -> Bool
Eq)

mkParentDep ::
  forall b.
  (Backend b) =>
  SourceName ->
  TableName b ->
  SchemaDependency
mkParentDep :: forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> SchemaDependency
mkParentDep SourceName
s TableName b
tn =
  SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency (SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
s (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend @b (TableName b -> SourceObjId b
forall (b :: BackendType). TableName b -> SourceObjId b
SOITable TableName b
tn)) DependencyReason
DRTable

-- | When we depend on anything to do with logical models, we also declare that
-- we depend on the logical model as a whole. This is the "parent" dependency
-- in the dependency tree for a given logical model.
mkLogicalModelParentDep ::
  forall b.
  (Backend b) =>
  SourceName ->
  LogicalModelName ->
  SchemaDependency
mkLogicalModelParentDep :: forall (b :: BackendType).
Backend b =>
SourceName -> LogicalModelName -> SchemaDependency
mkLogicalModelParentDep SourceName
source LogicalModelName
logicalModelName = do
  let sourceObject :: SchemaObjId
      sourceObject :: SchemaObjId
sourceObject =
        SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
          (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend @b
          (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ LogicalModelName -> SourceObjId b
forall (b :: BackendType). LogicalModelName -> SourceObjId b
SOILogicalModel LogicalModelName
logicalModelName

  SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency SchemaObjId
sourceObject DependencyReason
DRTable

mkColDep ::
  forall b.
  (Backend b) =>
  DependencyReason ->
  SourceName ->
  TableName b ->
  Column b ->
  SchemaDependency
mkColDep :: forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName -> TableName b -> Column b -> SchemaDependency
mkColDep DependencyReason
reason SourceName
source TableName b
tn Column b
col =
  (SchemaObjId -> DependencyReason -> SchemaDependency)
-> DependencyReason -> SchemaObjId -> SchemaDependency
forall a b c. (a -> b -> c) -> b -> a -> c
flip SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency DependencyReason
reason
    (SchemaObjId -> SchemaDependency)
-> (TableObjId b -> SchemaObjId)
-> TableObjId b
-> SchemaDependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
    (AnyBackend SourceObjId -> SchemaObjId)
-> (TableObjId b -> AnyBackend SourceObjId)
-> TableObjId b
-> SchemaObjId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
    (SourceObjId b -> AnyBackend SourceObjId)
-> (TableObjId b -> SourceObjId b)
-> TableObjId b
-> AnyBackend SourceObjId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b TableName b
tn
    (TableObjId b -> SchemaDependency)
-> TableObjId b -> SchemaDependency
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). Column b -> TableObjId b
TOCol @b Column b
col

-- | Declare a dependency on a particular column of a logical model
mkLogicalModelColDep ::
  forall b.
  (Backend b) =>
  DependencyReason ->
  SourceName ->
  LogicalModelName ->
  Column b ->
  SchemaDependency
mkLogicalModelColDep :: forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName -> LogicalModelName -> Column b -> SchemaDependency
mkLogicalModelColDep DependencyReason
reason SourceName
source LogicalModelName
logicalModelName Column b
column = do
  let sourceObject :: SchemaObjId
      sourceObject :: SchemaObjId
sourceObject =
        SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
          (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
          (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
LogicalModelName -> LogicalModelObjId b -> SourceObjId b
SOILogicalModelObj @b LogicalModelName
logicalModelName
          (LogicalModelObjId b -> SourceObjId b)
-> LogicalModelObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). Column b -> LogicalModelObjId b
LMOCol @b Column b
column

  SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency SchemaObjId
sourceObject DependencyReason
reason

mkComputedFieldDep ::
  forall b.
  (Backend b) =>
  DependencyReason ->
  SourceName ->
  TableName b ->
  ComputedFieldName ->
  SchemaDependency
mkComputedFieldDep :: forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName
-> TableName b
-> ComputedFieldName
-> SchemaDependency
mkComputedFieldDep DependencyReason
reason SourceName
s TableName b
tn ComputedFieldName
computedField =
  (SchemaObjId -> DependencyReason -> SchemaDependency)
-> DependencyReason -> SchemaObjId -> SchemaDependency
forall a b c. (a -> b -> c) -> b -> a -> c
flip SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency DependencyReason
reason
    (SchemaObjId -> SchemaDependency)
-> (TableObjId b -> SchemaObjId)
-> TableObjId b
-> SchemaDependency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
s
    (AnyBackend SourceObjId -> SchemaObjId)
-> (TableObjId b -> AnyBackend SourceObjId)
-> TableObjId b
-> SchemaObjId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
    (SourceObjId b -> AnyBackend SourceObjId)
-> (TableObjId b -> SourceObjId b)
-> TableObjId b
-> AnyBackend SourceObjId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b TableName b
tn
    (TableObjId b -> SchemaDependency)
-> TableObjId b -> SchemaDependency
forall a b. (a -> b) -> a -> b
$ ComputedFieldName -> TableObjId b
forall (b :: BackendType). ComputedFieldName -> TableObjId b
TOComputedField ComputedFieldName
computedField

type WithDeps a = (a, Seq SchemaDependency)

type RemoteSchemaRelationships = RemoteSchemaRelationshipsG (RemoteFieldInfo G.Name)

type RemoteSchemaCtx = RemoteSchemaCtxG (RemoteFieldInfo G.Name)

type RemoteSchemaMap = HashMap.HashMap RemoteSchemaName RemoteSchemaCtx

type PartiallyResolvedRemoteSchemaCtx =
  RemoteSchemaCtxG
    (PartiallyResolvedRemoteRelationship RemoteRelationshipDefinition)

type PartiallyResolvedRemoteSchemaMap =
  HashMap.HashMap RemoteSchemaName PartiallyResolvedRemoteSchemaCtx

type DepMap = HashMap.HashMap SchemaObjId (HS.HashSet SchemaDependency)

data CronTriggerInfo = CronTriggerInfo
  { CronTriggerInfo -> TriggerName
ctiName :: TriggerName,
    CronTriggerInfo -> CronSchedule
ctiSchedule :: CronSchedule,
    CronTriggerInfo -> Maybe Value
ctiPayload :: Maybe Value,
    CronTriggerInfo -> STRetryConf
ctiRetryConf :: STRetryConf,
    CronTriggerInfo -> EnvRecord ResolvedWebhook
ctiWebhookInfo :: EnvRecord ResolvedWebhook,
    CronTriggerInfo -> [EventHeaderInfo]
ctiHeaders :: [EventHeaderInfo],
    CronTriggerInfo -> Maybe Text
ctiComment :: Maybe Text,
    CronTriggerInfo -> Maybe RequestTransform
ctiRequestTransform :: Maybe RequestTransform,
    CronTriggerInfo -> Maybe MetadataResponseTransform
ctiResponseTransform :: Maybe MetadataResponseTransform
  }
  deriving (Int -> CronTriggerInfo -> ShowS
[CronTriggerInfo] -> ShowS
CronTriggerInfo -> String
(Int -> CronTriggerInfo -> ShowS)
-> (CronTriggerInfo -> String)
-> ([CronTriggerInfo] -> ShowS)
-> Show CronTriggerInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CronTriggerInfo -> ShowS
showsPrec :: Int -> CronTriggerInfo -> ShowS
$cshow :: CronTriggerInfo -> String
show :: CronTriggerInfo -> String
$cshowList :: [CronTriggerInfo] -> ShowS
showList :: [CronTriggerInfo] -> ShowS
Show, CronTriggerInfo -> CronTriggerInfo -> Bool
(CronTriggerInfo -> CronTriggerInfo -> Bool)
-> (CronTriggerInfo -> CronTriggerInfo -> Bool)
-> Eq CronTriggerInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CronTriggerInfo -> CronTriggerInfo -> Bool
== :: CronTriggerInfo -> CronTriggerInfo -> Bool
$c/= :: CronTriggerInfo -> CronTriggerInfo -> Bool
/= :: CronTriggerInfo -> CronTriggerInfo -> Bool
Eq, (forall x. CronTriggerInfo -> Rep CronTriggerInfo x)
-> (forall x. Rep CronTriggerInfo x -> CronTriggerInfo)
-> Generic CronTriggerInfo
forall x. Rep CronTriggerInfo x -> CronTriggerInfo
forall x. CronTriggerInfo -> Rep CronTriggerInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CronTriggerInfo -> Rep CronTriggerInfo x
from :: forall x. CronTriggerInfo -> Rep CronTriggerInfo x
$cto :: forall x. Rep CronTriggerInfo x -> CronTriggerInfo
to :: forall x. Rep CronTriggerInfo x -> CronTriggerInfo
Generic)

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

type ActionCache = HashMap.HashMap ActionName ActionInfo -- info of all actions

type InheritedRolesCache = HashMap.HashMap RoleName (HashSet RoleName)

-------------------------------------------------------------------------------

-- | Retrieves the source info for a given source name.
--
-- This function retrieves the schema cache from the monadic context, and
-- attempts to look the corresponding source up in the source cache. This
-- function must be used with a _type annotation_, such as `askSourceInfo
-- @('Postgres 'Vanilla)`. It throws an error if:
-- 1. The function fails to find the named source at all
-- 2. The named source exists but does not match the expected type
-- 3. The named source exists, and is of the expected type, but is inconsistent
askSourceInfo ::
  forall b m.
  (CacheRM m, MetadataM m, MonadError QErr m, Backend b) =>
  SourceName ->
  m (SourceInfo b)
askSourceInfo :: forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MetadataM m, MonadError QErr m, Backend b) =>
SourceName -> m (SourceInfo b)
askSourceInfo SourceName
sourceName = do
  SourceCache
sources <- SchemaCache -> SourceCache
scSources (SchemaCache -> SourceCache) -> m SchemaCache -> m SourceCache
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  -- find any matching source info by name
  case SourceName -> SourceCache -> Maybe BackendSourceInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup SourceName
sourceName SourceCache
sources of
    -- 1. The function fails to find the named source at all
    Maybe BackendSourceInfo
Nothing -> Code -> Text -> m (SourceInfo b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists (Text -> m (SourceInfo b)) -> Text -> m (SourceInfo b)
forall a b. (a -> b) -> a -> b
$ Text
"source with name " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"
    Just BackendSourceInfo
matchingNameSourceInfo -> do
      -- find matching source info for backend type @b
      Maybe (SourceInfo b) -> m (SourceInfo b) -> m (SourceInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (forall (b :: BackendType).
HasTag b =>
BackendSourceInfo -> Maybe (SourceInfo b)
unsafeSourceInfo @b BackendSourceInfo
matchingNameSourceInfo) do
        Metadata
metadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
        m (SourceInfo b)
-> (BackendSourceMetadata -> m (SourceInfo b))
-> Maybe BackendSourceMetadata
-> m (SourceInfo b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          -- 2. The named source exists but does not match the expected type
          ( Code -> Text -> m (SourceInfo b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
              (Text -> m (SourceInfo b)) -> Text -> m (SourceInfo b)
forall a b. (a -> b) -> a -> b
$ Text
"source with name "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName
              SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" has backend type "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BackendType -> Text
forall a. ToTxt a => a -> Text
T.toTxt (BackendSourceInfo -> BackendType
forall (i :: BackendType -> *). AnyBackend i -> BackendType
AB.lowerTag BackendSourceInfo
matchingNameSourceInfo)
              Text -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" which does not match the expected type "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BackendType -> Text
forall a. ToTxt a => a -> Text
T.toTxt (BackendTag b -> BackendType
forall (b :: BackendType). BackendTag b -> BackendType
reify (BackendTag b -> BackendType) -> BackendTag b -> BackendType
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). HasTag b => BackendTag b
backendTag @b)
          )
          -- 3. The named source exists, and is of the expected type, but is inconsistent
          ( m (SourceInfo b) -> BackendSourceMetadata -> m (SourceInfo b)
forall a b. a -> b -> a
const
              (m (SourceInfo b) -> BackendSourceMetadata -> m (SourceInfo b))
-> m (SourceInfo b) -> BackendSourceMetadata -> m (SourceInfo b)
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m (SourceInfo b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
Unexpected
              (Text -> m (SourceInfo b)) -> Text -> m (SourceInfo b)
forall a b. (a -> b) -> a -> b
$ Text
"source with name "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName
              SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is inconsistent"
          )
          (Metadata
metadata Metadata
-> Getting
     (Maybe BackendSourceMetadata)
     Metadata
     (Maybe BackendSourceMetadata)
-> Maybe BackendSourceMetadata
forall s a. s -> Getting a s a -> a
^. (Sources -> Const (Maybe BackendSourceMetadata) Sources)
-> Metadata -> Const (Maybe BackendSourceMetadata) Metadata
Lens' Metadata Sources
metaSources ((Sources -> Const (Maybe BackendSourceMetadata) Sources)
 -> Metadata -> Const (Maybe BackendSourceMetadata) Metadata)
-> ((Maybe BackendSourceMetadata
     -> Const
          (Maybe BackendSourceMetadata) (Maybe BackendSourceMetadata))
    -> Sources -> Const (Maybe BackendSourceMetadata) Sources)
-> Getting
     (Maybe BackendSourceMetadata)
     Metadata
     (Maybe BackendSourceMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Lens' Sources (Maybe (IxValue Sources))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index Sources
SourceName
sourceName)

askSourceInfoMaybe ::
  forall b m.
  (CacheRM m, Backend b) =>
  SourceName ->
  m (Maybe (SourceInfo b))
askSourceInfoMaybe :: forall (b :: BackendType) (m :: * -> *).
(CacheRM m, Backend b) =>
SourceName -> m (Maybe (SourceInfo b))
askSourceInfoMaybe SourceName
sourceName = do
  SourceCache
sources <- SchemaCache -> SourceCache
scSources (SchemaCache -> SourceCache) -> m SchemaCache -> m SourceCache
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  Maybe (SourceInfo b) -> m (Maybe (SourceInfo b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (b :: BackendType).
HasTag b =>
BackendSourceInfo -> Maybe (SourceInfo b)
unsafeSourceInfo @b (BackendSourceInfo -> Maybe (SourceInfo b))
-> Maybe BackendSourceInfo -> Maybe (SourceInfo b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SourceName -> SourceCache -> Maybe BackendSourceInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup SourceName
sourceName SourceCache
sources)

-- | Retrieves the source config for a given source name.
--
-- This function relies on 'askSourceInfo' and similarly throws an error if the
-- source isn't found.
askSourceConfig ::
  forall b m.
  (CacheRM m, MonadError QErr m, Backend b, MetadataM m) =>
  SourceName ->
  m (SourceConfig b)
askSourceConfig :: forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MonadError QErr m, Backend b, MetadataM m) =>
SourceName -> m (SourceConfig b)
askSourceConfig = (SourceInfo b -> SourceConfig b)
-> m (SourceInfo b) -> m (SourceConfig b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SourceInfo b -> SourceConfig b
forall (b :: BackendType). SourceInfo b -> SourceConfig b
_siConfiguration (m (SourceInfo b) -> m (SourceConfig b))
-> (SourceName -> m (SourceInfo b))
-> SourceName
-> m (SourceConfig b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MetadataM m, MonadError QErr m, Backend b) =>
SourceName -> m (SourceInfo b)
askSourceInfo @b

askSourceConfigMaybe ::
  forall b m.
  (CacheRM m, Backend b) =>
  SourceName ->
  m (Maybe (SourceConfig b))
askSourceConfigMaybe :: forall (b :: BackendType) (m :: * -> *).
(CacheRM m, Backend b) =>
SourceName -> m (Maybe (SourceConfig b))
askSourceConfigMaybe =
  (Maybe (SourceInfo b) -> Maybe (SourceConfig b))
-> m (Maybe (SourceInfo b)) -> m (Maybe (SourceConfig b))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SourceInfo b -> SourceConfig b)
-> Maybe (SourceInfo b) -> Maybe (SourceConfig b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SourceInfo b -> SourceConfig b
forall (b :: BackendType). SourceInfo b -> SourceConfig b
_siConfiguration) (m (Maybe (SourceInfo b)) -> m (Maybe (SourceConfig b)))
-> (SourceName -> m (Maybe (SourceInfo b)))
-> SourceName
-> m (Maybe (SourceConfig b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (m :: * -> *).
(CacheRM m, Backend b) =>
SourceName -> m (Maybe (SourceInfo b))
askSourceInfoMaybe @b

-- | Retrieves the table cache for a given source cache and source name.
--
-- This function must be used with a _type annotation_, such as
-- `unsafeTableCache @('Postgres 'Vanilla)`. It returns @Nothing@ if it fails to
-- find that source or if the kind of the source does not match the type
-- annotation, and does not distinguish between the two cases.
unsafeTableCache ::
  forall b. (Backend b) => SourceName -> SourceCache -> Maybe (TableCache b)
unsafeTableCache :: forall (b :: BackendType).
Backend b =>
SourceName -> SourceCache -> Maybe (TableCache b)
unsafeTableCache SourceName
sourceName SourceCache
cache = do
  forall (b :: BackendType).
HasTag b =>
BackendSourceInfo -> Maybe (TableCache b)
unsafeSourceTables @b (BackendSourceInfo -> Maybe (TableCache b))
-> Maybe BackendSourceInfo -> Maybe (TableCache b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SourceName -> SourceCache -> Maybe BackendSourceInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup SourceName
sourceName SourceCache
cache

-- | Retrieves the table cache for a given source name.
--
-- This function retrieves the schema cache from the monadic context, and
-- attempts to look the corresponding source up in the source cache. It must be
-- used with a _type annotation_, such as `unsafeTableCache @('Postgres
-- 'Vanilla)`. It returns @Nothing@ if it fails to find that source or if the
-- kind of the source does not match the type annotation, and does not
-- distinguish between the two cases.
askTableCache ::
  forall b m.
  (Backend b, CacheRM m) =>
  SourceName ->
  m (Maybe (TableCache b))
askTableCache :: forall (b :: BackendType) (m :: * -> *).
(Backend b, CacheRM m) =>
SourceName -> m (Maybe (TableCache b))
askTableCache SourceName
sourceName = do
  SourceCache
sources <- SchemaCache -> SourceCache
scSources (SchemaCache -> SourceCache) -> m SchemaCache -> m SourceCache
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  Maybe (TableCache b) -> m (Maybe (TableCache b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (TableCache b) -> m (Maybe (TableCache b)))
-> Maybe (TableCache b) -> m (Maybe (TableCache b))
forall a b. (a -> b) -> a -> b
$ BackendSourceInfo -> Maybe (TableCache b)
forall (b :: BackendType).
HasTag b =>
BackendSourceInfo -> Maybe (TableCache b)
unsafeSourceTables (BackendSourceInfo -> Maybe (TableCache b))
-> Maybe BackendSourceInfo -> Maybe (TableCache b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SourceName -> SourceCache -> Maybe BackendSourceInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup SourceName
sourceName SourceCache
sources

-- | Retrieves the information about a table from the source cache, the source
-- name, and the table name.
--
-- This function returns @Nothing@ if it fails to find that source or if the
-- kind of the source does not match the type annotation, and does not
-- distinguish between the two cases.
unsafeTableInfo ::
  forall b. (Backend b) => SourceName -> TableName b -> SourceCache -> Maybe (TableInfo b)
unsafeTableInfo :: forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> SourceCache -> Maybe (TableInfo b)
unsafeTableInfo SourceName
sourceName TableName b
tableName SourceCache
cache =
  TableName b
-> HashMap (TableName b) (TableInfo b) -> Maybe (TableInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TableName b
tableName (HashMap (TableName b) (TableInfo b) -> Maybe (TableInfo b))
-> Maybe (HashMap (TableName b) (TableInfo b))
-> Maybe (TableInfo b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (b :: BackendType).
Backend b =>
SourceName -> SourceCache -> Maybe (TableCache b)
unsafeTableCache @b SourceName
sourceName SourceCache
cache

-- | Retrieves the information about a table for a given source name and table
-- name.
--
-- This function retrieves the schema cache from the monadic context, and
-- attempts to look the corresponding source up in the source cache. it throws
-- an error if it fails to find that source, in which case it looks that source
-- up in the metadata, to differentiate between the source not existing or the
-- type of the source not matching.
askTableInfo ::
  forall b m.
  (QErrM m, CacheRM m, Backend b) =>
  SourceName ->
  TableName b ->
  m (TableInfo b)
askTableInfo :: forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableInfo b)
askTableInfo SourceName
sourceName TableName b
tableName = do
  SchemaCache
rawSchemaCache <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  Maybe (TableInfo b) -> m (TableInfo b) -> m (TableInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (SourceName -> TableName b -> SourceCache -> Maybe (TableInfo b)
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> SourceCache -> Maybe (TableInfo b)
unsafeTableInfo SourceName
sourceName TableName b
tableName (SourceCache -> Maybe (TableInfo b))
-> SourceCache -> Maybe (TableInfo b)
forall a b. (a -> b) -> a -> b
$ SchemaCache -> SourceCache
scSources SchemaCache
rawSchemaCache)
    (m (TableInfo b) -> m (TableInfo b))
-> m (TableInfo b) -> m (TableInfo b)
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m (TableInfo b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
    (Text -> m (TableInfo b)) -> Text -> m (TableInfo b)
forall a b. (a -> b) -> a -> b
$ Text
"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
" does not exist in source: "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
sourceNameToText SourceName
sourceName

-- | Similar to 'askTableInfo', but drills further down to extract the
-- underlying core info.
askTableCoreInfo ::
  forall b m.
  (QErrM m, CacheRM m, Backend b) =>
  SourceName ->
  TableName b ->
  m (TableCoreInfo b)
askTableCoreInfo :: forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableCoreInfo b)
askTableCoreInfo SourceName
sourceName TableName b
tableName =
  TableInfo b -> TableCoreInfo b
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo (TableInfo b -> TableCoreInfo b)
-> m (TableInfo b) -> m (TableCoreInfo b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceName -> TableName b -> m (TableInfo b)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableInfo b)
askTableInfo SourceName
sourceName TableName b
tableName

-- | Similar to 'askTableCoreInfo', but drills further down to extract the
-- underlying field info map.
askTableFieldInfoMap ::
  forall b m.
  (QErrM m, CacheRM m, Backend b) =>
  SourceName ->
  TableName b ->
  m (FieldInfoMap (FieldInfo b))
askTableFieldInfoMap :: forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (FieldInfoMap (FieldInfo b))
askTableFieldInfoMap SourceName
sourceName TableName b
tableName =
  TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> FieldInfoMap (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
 -> FieldInfoMap (FieldInfo b))
-> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> m (FieldInfoMap (FieldInfo b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceName
-> TableName b -> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableCoreInfo b)
askTableCoreInfo SourceName
sourceName TableName b
tableName

-- | Retrieves the metadata information about a table for a given source name
-- and table name.
--
-- Unlike most other @ask@ functions in this module, this function does not
-- drill through the schema cache, and instead inspects the metadata. Like most
-- others, it throws an error if it fails to find that source, in which case it
-- looks that source up in the metadata, to differentiate between the source not
-- existing or the type of the source not matching.
askTableMetadata ::
  forall b m.
  (QErrM m, MetadataM m, Backend b) =>
  SourceName ->
  TableName b ->
  m (TableMetadata b)
askTableMetadata :: forall (b :: BackendType) (m :: * -> *).
(QErrM m, MetadataM m, Backend b) =>
SourceName -> TableName b -> m (TableMetadata b)
askTableMetadata SourceName
sourceName TableName b
tableName = do
  m (Maybe (TableMetadata b))
-> m (TableMetadata b) -> m (TableMetadata b)
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a -> m a
onNothingM (m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata m Metadata
-> (Metadata -> Maybe (TableMetadata b))
-> m (Maybe (TableMetadata b))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Getting (First (TableMetadata b)) Metadata (TableMetadata b)
-> Metadata -> Maybe (TableMetadata b)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First (TableMetadata b)) Metadata (TableMetadata b)
Traversal' Metadata (TableMetadata b)
focusTableMetadata)
    (m (TableMetadata b) -> m (TableMetadata b))
-> m (TableMetadata b) -> m (TableMetadata b)
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m (TableMetadata b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
    (Text -> m (TableMetadata b)) -> Text -> m (TableMetadata b)
forall a b. (a -> b) -> a -> b
$ Text
"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
" does not exist in source: "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
sourceNameToText SourceName
sourceName
  where
    focusTableMetadata :: Traversal' Metadata (TableMetadata b)
    focusTableMetadata :: Traversal' Metadata (TableMetadata b)
focusTableMetadata =
      (Sources -> f Sources) -> Metadata -> f Metadata
Lens' Metadata Sources
metaSources
        ((Sources -> f Sources) -> Metadata -> f Metadata)
-> ((TableMetadata b -> f (TableMetadata b))
    -> Sources -> f Sources)
-> (TableMetadata b -> f (TableMetadata b))
-> Metadata
-> f Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Sources
SourceName
sourceName
        ((BackendSourceMetadata -> f BackendSourceMetadata)
 -> Sources -> f Sources)
-> ((TableMetadata b -> f (TableMetadata b))
    -> BackendSourceMetadata -> f BackendSourceMetadata)
-> (TableMetadata b -> f (TableMetadata b))
-> Sources
-> f Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata @b
        ((SourceMetadata b -> f (SourceMetadata b))
 -> BackendSourceMetadata -> f BackendSourceMetadata)
-> ((TableMetadata b -> f (TableMetadata b))
    -> SourceMetadata b -> f (SourceMetadata b))
-> (TableMetadata b -> f (TableMetadata b))
-> BackendSourceMetadata
-> f BackendSourceMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InsOrdHashMap (TableName b) (TableMetadata b)
 -> f (InsOrdHashMap (TableName b) (TableMetadata b)))
-> SourceMetadata b -> f (SourceMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(Tables b -> f (Tables b))
-> SourceMetadata b -> f (SourceMetadata b)
smTables
        ((InsOrdHashMap (TableName b) (TableMetadata b)
  -> f (InsOrdHashMap (TableName b) (TableMetadata b)))
 -> SourceMetadata b -> f (SourceMetadata b))
-> ((TableMetadata b -> f (TableMetadata b))
    -> InsOrdHashMap (TableName b) (TableMetadata b)
    -> f (InsOrdHashMap (TableName b) (TableMetadata b)))
-> (TableMetadata b -> f (TableMetadata b))
-> SourceMetadata b
-> f (SourceMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap (TableName b) (TableMetadata b))
-> Traversal'
     (InsOrdHashMap (TableName b) (TableMetadata b))
     (IxValue (InsOrdHashMap (TableName b) (TableMetadata b)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (InsOrdHashMap (TableName b) (TableMetadata b))
TableName b
tableName

-- | Retrieves the function cache for a given source cache and source name.
--
-- This function must be used with a _type annotation_, such as
-- `unsafeFunctionCache @('Postgres 'Vanilla)`. It returns @Nothing@ if it fails
-- to find that source or if the kind of the source does not match the type
-- annotation, and does not distinguish between the two cases.
unsafeFunctionCache ::
  forall b. (Backend b) => SourceName -> SourceCache -> Maybe (FunctionCache b)
unsafeFunctionCache :: forall (b :: BackendType).
Backend b =>
SourceName -> SourceCache -> Maybe (FunctionCache b)
unsafeFunctionCache SourceName
sourceName SourceCache
cache =
  forall (b :: BackendType).
HasTag b =>
BackendSourceInfo -> Maybe (FunctionCache b)
unsafeSourceFunctions @b (BackendSourceInfo
 -> Maybe (HashMap (FunctionName b) (FunctionInfo b)))
-> Maybe BackendSourceInfo
-> Maybe (HashMap (FunctionName b) (FunctionInfo b))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SourceName -> SourceCache -> Maybe BackendSourceInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup SourceName
sourceName SourceCache
cache

-- | Retrieves the information about a function from the source cache, the
-- source name, and the function name.
--
-- This function returns @Nothing@ if it fails to find that source or if the
-- kind of the source does not match the type annotation, and does not
-- distinguish between the two cases.
unsafeFunctionInfo ::
  forall b. (Backend b) => SourceName -> FunctionName b -> SourceCache -> Maybe (FunctionInfo b)
unsafeFunctionInfo :: forall (b :: BackendType).
Backend b =>
SourceName
-> FunctionName b -> SourceCache -> Maybe (FunctionInfo b)
unsafeFunctionInfo SourceName
sourceName FunctionName b
functionName SourceCache
cache =
  FunctionName b
-> HashMap (FunctionName b) (FunctionInfo b)
-> Maybe (FunctionInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup FunctionName b
functionName (HashMap (FunctionName b) (FunctionInfo b)
 -> Maybe (FunctionInfo b))
-> Maybe (HashMap (FunctionName b) (FunctionInfo b))
-> Maybe (FunctionInfo b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (b :: BackendType).
Backend b =>
SourceName -> SourceCache -> Maybe (FunctionCache b)
unsafeFunctionCache @b SourceName
sourceName SourceCache
cache

-- | Retrieves the information about a function cache for a given source name
-- and function name.
--
-- This function retrieves the schema cache from the monadic context, and
-- attempts to look the corresponding source up in the source cache. It throws
-- an error if it fails to find that source, in which case it looks that source
-- up in the metadata, to differentiate between the source not existing or the
-- type of the source not matching.
askFunctionInfo ::
  forall b m.
  (QErrM m, CacheRM m, Backend b) =>
  SourceName ->
  FunctionName b ->
  m (FunctionInfo b)
askFunctionInfo :: forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> FunctionName b -> m (FunctionInfo b)
askFunctionInfo SourceName
sourceName FunctionName b
functionName = do
  SchemaCache
rawSchemaCache <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  Maybe (FunctionInfo b) -> m (FunctionInfo b) -> m (FunctionInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (SourceName
-> FunctionName b -> SourceCache -> Maybe (FunctionInfo b)
forall (b :: BackendType).
Backend b =>
SourceName
-> FunctionName b -> SourceCache -> Maybe (FunctionInfo b)
unsafeFunctionInfo SourceName
sourceName FunctionName b
functionName (SourceCache -> Maybe (FunctionInfo b))
-> SourceCache -> Maybe (FunctionInfo b)
forall a b. (a -> b) -> a -> b
$ SchemaCache -> SourceCache
scSources SchemaCache
rawSchemaCache)
    (m (FunctionInfo b) -> m (FunctionInfo b))
-> m (FunctionInfo b) -> m (FunctionInfo b)
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m (FunctionInfo b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
    (Text -> m (FunctionInfo b)) -> Text -> m (FunctionInfo b)
forall a b. (a -> b) -> a -> b
$ Text
"function "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FunctionName b
functionName
    FunctionName b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist in source: "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
sourceNameToText SourceName
sourceName

-------------------------------------------------------------------------------

newtype BackendInfoWrapper (b :: BackendType) = BackendInfoWrapper {forall (b :: BackendType). BackendInfoWrapper b -> BackendInfo b
unBackendInfoWrapper :: BackendInfo b}

deriving newtype instance (ToJSON (BackendInfo b)) => ToJSON (BackendInfoWrapper b)

deriving newtype instance (Semigroup (BackendInfo b)) => Semigroup (BackendInfoWrapper b)

deriving newtype instance (Monoid (BackendInfo b)) => Monoid (BackendInfoWrapper b)

type BackendCache = BackendMap BackendInfoWrapper

getBackendInfo :: forall b m. (CacheRM m, HasTag b) => m (Maybe (BackendInfo b))
getBackendInfo :: forall (b :: BackendType) (m :: * -> *).
(CacheRM m, HasTag b) =>
m (Maybe (BackendInfo b))
getBackendInfo = m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache m SchemaCache
-> (SchemaCache -> Maybe (BackendInfo b))
-> m (Maybe (BackendInfo b))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (BackendInfoWrapper b -> BackendInfo b)
-> Maybe (BackendInfoWrapper b) -> Maybe (BackendInfo b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BackendInfoWrapper b -> BackendInfo b
forall (b :: BackendType). BackendInfoWrapper b -> BackendInfo b
unBackendInfoWrapper (Maybe (BackendInfoWrapper b) -> Maybe (BackendInfo b))
-> (SchemaCache -> Maybe (BackendInfoWrapper b))
-> SchemaCache
-> Maybe (BackendInfo b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
BackendMap i -> Maybe (i b)
BackendMap.lookup @b (BackendMap BackendInfoWrapper -> Maybe (BackendInfoWrapper b))
-> (SchemaCache -> BackendMap BackendInfoWrapper)
-> SchemaCache
-> Maybe (BackendInfoWrapper b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaCache -> BackendMap BackendInfoWrapper
scBackendCache

-------------------------------------------------------------------------------

data SchemaCache = SchemaCache
  { SchemaCache -> SourceCache
scSources :: SourceCache,
    SchemaCache -> ActionCache
scActions :: ActionCache,
    SchemaCache -> RemoteSchemaMap
scRemoteSchemas :: RemoteSchemaMap,
    SchemaCache -> InlinedAllowlist
scAllowlist :: InlinedAllowlist,
    SchemaCache -> SchemaIntrospection
scAdminIntrospection :: G.SchemaIntrospection,
    SchemaCache -> HashMap RoleName (RoleContext GQLContext)
scGQLContext :: HashMap RoleName (RoleContext GQLContext),
    SchemaCache -> GQLContext
scUnauthenticatedGQLContext :: GQLContext,
    SchemaCache -> HashMap RoleName (RoleContext GQLContext)
scRelayContext :: HashMap RoleName (RoleContext GQLContext),
    SchemaCache -> GQLContext
scUnauthenticatedRelayContext :: GQLContext,
    SchemaCache -> DepMap
scDepMap :: DepMap,
    SchemaCache -> [InconsistentMetadata]
scInconsistentObjs :: [InconsistentMetadata],
    SchemaCache -> HashMap TriggerName CronTriggerInfo
scCronTriggers :: HashMap.HashMap TriggerName CronTriggerInfo,
    SchemaCache -> EndpointTrie GQLQueryWithText
scEndpoints :: EndpointTrie GQLQueryWithText,
    SchemaCache -> ApiLimit
scApiLimits :: ApiLimit,
    SchemaCache -> MetricsConfig
scMetricsConfig :: MetricsConfig,
    SchemaCache -> MetadataResourceVersion
scMetadataResourceVersion :: MetadataResourceVersion,
    SchemaCache -> SetGraphqlIntrospectionOptions
scSetGraphqlIntrospectionOptions :: SetGraphqlIntrospectionOptions,
    SchemaCache -> [TlsAllow]
scTlsAllowlist :: [TlsAllow],
    SchemaCache -> QueryCollections
scQueryCollections :: QueryCollections,
    SchemaCache -> BackendMap BackendInfoWrapper
scBackendCache :: BackendCache,
    SchemaCache -> SourceHealthCheckCache
scSourceHealthChecks :: SourceHealthCheckCache,
    SchemaCache -> SourcePingCache
scSourcePingConfig :: SourcePingCache,
    SchemaCache -> OpenTelemetryInfo
scOpenTelemetryConfig :: OpenTelemetryInfo
  }

-- WARNING: this can only be used for debug purposes, as it loses all
-- backend-specific information in the process!
instance ToJSON SchemaCache where
  toJSON :: SchemaCache -> Value
toJSON SchemaCache {[TlsAllow]
[InconsistentMetadata]
HashMap RoleName (RoleContext GQLContext)
SourcePingCache
SourceHealthCheckCache
SourceCache
RemoteSchemaMap
HashMap TriggerName CronTriggerInfo
ActionCache
DepMap
SchemaIntrospection
EndpointTrie GQLQueryWithText
QueryCollections
OpenTelemetryInfo
SetGraphqlIntrospectionOptions
InlinedAllowlist
MetricsConfig
ApiLimit
BackendMap BackendInfoWrapper
GQLContext
MetadataResourceVersion
scSources :: SchemaCache -> SourceCache
scBackendCache :: SchemaCache -> BackendMap BackendInfoWrapper
scActions :: SchemaCache -> ActionCache
scRemoteSchemas :: SchemaCache -> RemoteSchemaMap
scAllowlist :: SchemaCache -> InlinedAllowlist
scAdminIntrospection :: SchemaCache -> SchemaIntrospection
scGQLContext :: SchemaCache -> HashMap RoleName (RoleContext GQLContext)
scUnauthenticatedGQLContext :: SchemaCache -> GQLContext
scRelayContext :: SchemaCache -> HashMap RoleName (RoleContext GQLContext)
scUnauthenticatedRelayContext :: SchemaCache -> GQLContext
scDepMap :: SchemaCache -> DepMap
scInconsistentObjs :: SchemaCache -> [InconsistentMetadata]
scCronTriggers :: SchemaCache -> HashMap TriggerName CronTriggerInfo
scEndpoints :: SchemaCache -> EndpointTrie GQLQueryWithText
scApiLimits :: SchemaCache -> ApiLimit
scMetricsConfig :: SchemaCache -> MetricsConfig
scMetadataResourceVersion :: SchemaCache -> MetadataResourceVersion
scSetGraphqlIntrospectionOptions :: SchemaCache -> SetGraphqlIntrospectionOptions
scTlsAllowlist :: SchemaCache -> [TlsAllow]
scQueryCollections :: SchemaCache -> QueryCollections
scSourceHealthChecks :: SchemaCache -> SourceHealthCheckCache
scSourcePingConfig :: SchemaCache -> SourcePingCache
scOpenTelemetryConfig :: SchemaCache -> OpenTelemetryInfo
scSources :: SourceCache
scActions :: ActionCache
scRemoteSchemas :: RemoteSchemaMap
scAllowlist :: InlinedAllowlist
scAdminIntrospection :: SchemaIntrospection
scGQLContext :: HashMap RoleName (RoleContext GQLContext)
scUnauthenticatedGQLContext :: GQLContext
scRelayContext :: HashMap RoleName (RoleContext GQLContext)
scUnauthenticatedRelayContext :: GQLContext
scDepMap :: DepMap
scInconsistentObjs :: [InconsistentMetadata]
scCronTriggers :: HashMap TriggerName CronTriggerInfo
scEndpoints :: EndpointTrie GQLQueryWithText
scApiLimits :: ApiLimit
scMetricsConfig :: MetricsConfig
scMetadataResourceVersion :: MetadataResourceVersion
scSetGraphqlIntrospectionOptions :: SetGraphqlIntrospectionOptions
scTlsAllowlist :: [TlsAllow]
scQueryCollections :: QueryCollections
scBackendCache :: BackendMap BackendInfoWrapper
scSourceHealthChecks :: SourceHealthCheckCache
scSourcePingConfig :: SourcePingCache
scOpenTelemetryConfig :: OpenTelemetryInfo
..} =
    [Pair] -> Value
object
      [ Key
"sources" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= HashMap SourceName Value -> Value
forall a. ToJSON a => a -> Value
toJSON (BackendSourceInfo -> Value
forall (i :: BackendType -> *).
SatisfiesForAllBackends i ToJSON =>
AnyBackend i -> Value
AB.debugAnyBackendToJSON (BackendSourceInfo -> Value)
-> SourceCache -> HashMap SourceName Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceCache
scSources),
        Key
"actions" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ActionCache -> Value
forall a. ToJSON a => a -> Value
toJSON ActionCache
scActions,
        Key
"remote_schemas" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= RemoteSchemaMap -> Value
forall a. ToJSON a => a -> Value
toJSON RemoteSchemaMap
scRemoteSchemas,
        Key
"allowlist" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= InlinedAllowlist -> Value
forall a. ToJSON a => a -> Value
toJSON InlinedAllowlist
scAllowlist,
        Key
"g_q_l_context" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= HashMap RoleName (RoleContext GQLContext) -> Value
forall a. ToJSON a => a -> Value
toJSON HashMap RoleName (RoleContext GQLContext)
scGQLContext,
        Key
"unauthenticated_g_q_l_context" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= GQLContext -> Value
forall a. ToJSON a => a -> Value
toJSON GQLContext
scUnauthenticatedGQLContext,
        Key
"relay_context" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= HashMap RoleName (RoleContext GQLContext) -> Value
forall a. ToJSON a => a -> Value
toJSON HashMap RoleName (RoleContext GQLContext)
scRelayContext,
        Key
"unauthenticated_relay_context" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= GQLContext -> Value
forall a. ToJSON a => a -> Value
toJSON GQLContext
scUnauthenticatedRelayContext,
        Key
"dep_map" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= DepMap -> Value
forall a. ToJSON a => a -> Value
toJSON DepMap
scDepMap,
        Key
"inconsistent_objs" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [InconsistentMetadata] -> Value
forall a. ToJSON a => a -> Value
toJSON [InconsistentMetadata]
scInconsistentObjs,
        Key
"cron_triggers" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= HashMap TriggerName CronTriggerInfo -> Value
forall a. ToJSON a => a -> Value
toJSON HashMap TriggerName CronTriggerInfo
scCronTriggers,
        Key
"endpoints" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= EndpointTrie GQLQueryWithText -> Value
forall a. ToJSON a => a -> Value
toJSON EndpointTrie GQLQueryWithText
scEndpoints,
        Key
"api_limits" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ApiLimit -> Value
forall a. ToJSON a => a -> Value
toJSON ApiLimit
scApiLimits,
        Key
"metrics_config" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= MetricsConfig -> Value
forall a. ToJSON a => a -> Value
toJSON MetricsConfig
scMetricsConfig,
        Key
"metadata_resource_version" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= MetadataResourceVersion -> Value
forall a. ToJSON a => a -> Value
toJSON MetadataResourceVersion
scMetadataResourceVersion,
        Key
"set_graphql_introspection_options" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= SetGraphqlIntrospectionOptions -> Value
forall a. ToJSON a => a -> Value
toJSON SetGraphqlIntrospectionOptions
scSetGraphqlIntrospectionOptions,
        Key
"tls_allowlist" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [TlsAllow] -> Value
forall a. ToJSON a => a -> Value
toJSON [TlsAllow]
scTlsAllowlist,
        Key
"query_collection" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= QueryCollections -> Value
forall a. ToJSON a => a -> Value
toJSON QueryCollections
scQueryCollections,
        Key
"backend_cache" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= BackendMap BackendInfoWrapper -> Value
forall a. ToJSON a => a -> Value
toJSON BackendMap BackendInfoWrapper
scBackendCache
      ]

getAllRemoteSchemas :: SchemaCache -> [RemoteSchemaName]
getAllRemoteSchemas :: SchemaCache -> [RemoteSchemaName]
getAllRemoteSchemas SchemaCache
sc =
  let consistentRemoteSchemas :: [RemoteSchemaName]
consistentRemoteSchemas = RemoteSchemaMap -> [RemoteSchemaName]
forall k v. HashMap k v -> [k]
HashMap.keys (RemoteSchemaMap -> [RemoteSchemaName])
-> RemoteSchemaMap -> [RemoteSchemaName]
forall a b. (a -> b) -> a -> b
$ SchemaCache -> RemoteSchemaMap
scRemoteSchemas SchemaCache
sc
      inconsistentRemoteSchemas :: [RemoteSchemaName]
inconsistentRemoteSchemas =
        [InconsistentMetadata] -> [RemoteSchemaName]
getInconsistentRemoteSchemas ([InconsistentMetadata] -> [RemoteSchemaName])
-> [InconsistentMetadata] -> [RemoteSchemaName]
forall a b. (a -> b) -> a -> b
$ SchemaCache -> [InconsistentMetadata]
scInconsistentObjs SchemaCache
sc
   in [RemoteSchemaName]
consistentRemoteSchemas [RemoteSchemaName] -> [RemoteSchemaName] -> [RemoteSchemaName]
forall a. Semigroup a => a -> a -> a
<> [RemoteSchemaName]
inconsistentRemoteSchemas

-- | A more limited version of 'CacheRM' that is used when building the schema cache, since the
-- entire schema cache has not been built yet.
class (Monad m) => TableCoreInfoRM b m where
  lookupTableCoreInfo :: TableName b -> m (Maybe (TableCoreInfo b))

instance (TableCoreInfoRM b m) => TableCoreInfoRM b (ReaderT r m) where
  lookupTableCoreInfo :: TableName b -> ReaderT r m (Maybe (TableCoreInfo b))
lookupTableCoreInfo = m (Maybe (TableCoreInfo b))
-> ReaderT r m (Maybe (TableCoreInfo b))
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (TableCoreInfo b))
 -> ReaderT r m (Maybe (TableCoreInfo b)))
-> (TableName b -> m (Maybe (TableCoreInfo b)))
-> TableName b
-> ReaderT r m (Maybe (TableCoreInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName b -> m (Maybe (TableCoreInfo b))
forall (b :: BackendType) (m :: * -> *).
TableCoreInfoRM b m =>
TableName b -> m (Maybe (TableCoreInfo b))
lookupTableCoreInfo

instance (TableCoreInfoRM b m) => TableCoreInfoRM b (StateT s m) where
  lookupTableCoreInfo :: TableName b -> StateT s m (Maybe (TableCoreInfo b))
lookupTableCoreInfo = m (Maybe (TableCoreInfo b)) -> StateT s m (Maybe (TableCoreInfo b))
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (TableCoreInfo b))
 -> StateT s m (Maybe (TableCoreInfo b)))
-> (TableName b -> m (Maybe (TableCoreInfo b)))
-> TableName b
-> StateT s m (Maybe (TableCoreInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName b -> m (Maybe (TableCoreInfo b))
forall (b :: BackendType) (m :: * -> *).
TableCoreInfoRM b m =>
TableName b -> m (Maybe (TableCoreInfo b))
lookupTableCoreInfo

instance (Monoid w, TableCoreInfoRM b m) => TableCoreInfoRM b (WriterT w m) where
  lookupTableCoreInfo :: TableName b -> WriterT w m (Maybe (TableCoreInfo b))
lookupTableCoreInfo = m (Maybe (TableCoreInfo b))
-> WriterT w m (Maybe (TableCoreInfo b))
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (TableCoreInfo b))
 -> WriterT w m (Maybe (TableCoreInfo b)))
-> (TableName b -> m (Maybe (TableCoreInfo b)))
-> TableName b
-> WriterT w m (Maybe (TableCoreInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName b -> m (Maybe (TableCoreInfo b))
forall (b :: BackendType) (m :: * -> *).
TableCoreInfoRM b m =>
TableName b -> m (Maybe (TableCoreInfo b))
lookupTableCoreInfo

instance (TableCoreInfoRM b m) => TableCoreInfoRM b (TraceT m) where
  lookupTableCoreInfo :: TableName b -> TraceT m (Maybe (TableCoreInfo b))
lookupTableCoreInfo = m (Maybe (TableCoreInfo b)) -> TraceT m (Maybe (TableCoreInfo b))
forall (m :: * -> *) a. Monad m => m a -> TraceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (TableCoreInfo b)) -> TraceT m (Maybe (TableCoreInfo b)))
-> (TableName b -> m (Maybe (TableCoreInfo b)))
-> TableName b
-> TraceT m (Maybe (TableCoreInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName b -> m (Maybe (TableCoreInfo b))
forall (b :: BackendType) (m :: * -> *).
TableCoreInfoRM b m =>
TableName b -> m (Maybe (TableCoreInfo b))
lookupTableCoreInfo

newtype TableCoreCacheRT b m a = TableCoreCacheRT {forall (b :: BackendType) (m :: * -> *) a.
TableCoreCacheRT b m a -> TableCoreCache b -> m a
runTableCoreCacheRT :: TableCoreCache b -> m a}
  deriving
    ((forall a b.
 (a -> b) -> TableCoreCacheRT b m a -> TableCoreCacheRT b m b)
-> (forall a b.
    a -> TableCoreCacheRT b m b -> TableCoreCacheRT b m a)
-> Functor (TableCoreCacheRT b m)
forall a b. a -> TableCoreCacheRT b m b -> TableCoreCacheRT b m a
forall a b.
(a -> b) -> TableCoreCacheRT b m a -> TableCoreCacheRT b m b
forall (b :: BackendType) (m :: * -> *) a b.
Functor m =>
a -> TableCoreCacheRT b m b -> TableCoreCacheRT b m a
forall (b :: BackendType) (m :: * -> *) a b.
Functor m =>
(a -> b) -> TableCoreCacheRT b m a -> TableCoreCacheRT b m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (b :: BackendType) (m :: * -> *) a b.
Functor m =>
(a -> b) -> TableCoreCacheRT b m a -> TableCoreCacheRT b m b
fmap :: forall a b.
(a -> b) -> TableCoreCacheRT b m a -> TableCoreCacheRT b m b
$c<$ :: forall (b :: BackendType) (m :: * -> *) a b.
Functor m =>
a -> TableCoreCacheRT b m b -> TableCoreCacheRT b m a
<$ :: forall a b. a -> TableCoreCacheRT b m b -> TableCoreCacheRT b m a
Functor, Functor (TableCoreCacheRT b m)
Functor (TableCoreCacheRT b m)
-> (forall a. a -> TableCoreCacheRT b m a)
-> (forall a b.
    TableCoreCacheRT b m (a -> b)
    -> TableCoreCacheRT b m a -> TableCoreCacheRT b m b)
-> (forall a b c.
    (a -> b -> c)
    -> TableCoreCacheRT b m a
    -> TableCoreCacheRT b m b
    -> TableCoreCacheRT b m c)
-> (forall a b.
    TableCoreCacheRT b m a
    -> TableCoreCacheRT b m b -> TableCoreCacheRT b m b)
-> (forall a b.
    TableCoreCacheRT b m a
    -> TableCoreCacheRT b m b -> TableCoreCacheRT b m a)
-> Applicative (TableCoreCacheRT b m)
forall a. a -> TableCoreCacheRT b m a
forall a b.
TableCoreCacheRT b m a
-> TableCoreCacheRT b m b -> TableCoreCacheRT b m a
forall a b.
TableCoreCacheRT b m a
-> TableCoreCacheRT b m b -> TableCoreCacheRT b m b
forall a b.
TableCoreCacheRT b m (a -> b)
-> TableCoreCacheRT b m a -> TableCoreCacheRT b m b
forall a b c.
(a -> b -> c)
-> TableCoreCacheRT b m a
-> TableCoreCacheRT b m b
-> TableCoreCacheRT b m c
forall {b :: BackendType} {m :: * -> *}.
Applicative m =>
Functor (TableCoreCacheRT b m)
forall (b :: BackendType) (m :: * -> *) a.
Applicative m =>
a -> TableCoreCacheRT b m a
forall (b :: BackendType) (m :: * -> *) a b.
Applicative m =>
TableCoreCacheRT b m a
-> TableCoreCacheRT b m b -> TableCoreCacheRT b m a
forall (b :: BackendType) (m :: * -> *) a b.
Applicative m =>
TableCoreCacheRT b m a
-> TableCoreCacheRT b m b -> TableCoreCacheRT b m b
forall (b :: BackendType) (m :: * -> *) a b.
Applicative m =>
TableCoreCacheRT b m (a -> b)
-> TableCoreCacheRT b m a -> TableCoreCacheRT b m b
forall (b :: BackendType) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> TableCoreCacheRT b m a
-> TableCoreCacheRT b m b
-> TableCoreCacheRT b m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (b :: BackendType) (m :: * -> *) a.
Applicative m =>
a -> TableCoreCacheRT b m a
pure :: forall a. a -> TableCoreCacheRT b m a
$c<*> :: forall (b :: BackendType) (m :: * -> *) a b.
Applicative m =>
TableCoreCacheRT b m (a -> b)
-> TableCoreCacheRT b m a -> TableCoreCacheRT b m b
<*> :: forall a b.
TableCoreCacheRT b m (a -> b)
-> TableCoreCacheRT b m a -> TableCoreCacheRT b m b
$cliftA2 :: forall (b :: BackendType) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> TableCoreCacheRT b m a
-> TableCoreCacheRT b m b
-> TableCoreCacheRT b m c
liftA2 :: forall a b c.
(a -> b -> c)
-> TableCoreCacheRT b m a
-> TableCoreCacheRT b m b
-> TableCoreCacheRT b m c
$c*> :: forall (b :: BackendType) (m :: * -> *) a b.
Applicative m =>
TableCoreCacheRT b m a
-> TableCoreCacheRT b m b -> TableCoreCacheRT b m b
*> :: forall a b.
TableCoreCacheRT b m a
-> TableCoreCacheRT b m b -> TableCoreCacheRT b m b
$c<* :: forall (b :: BackendType) (m :: * -> *) a b.
Applicative m =>
TableCoreCacheRT b m a
-> TableCoreCacheRT b m b -> TableCoreCacheRT b m a
<* :: forall a b.
TableCoreCacheRT b m a
-> TableCoreCacheRT b m b -> TableCoreCacheRT b m a
Applicative, Applicative (TableCoreCacheRT b m)
Applicative (TableCoreCacheRT b m)
-> (forall a b.
    TableCoreCacheRT b m a
    -> (a -> TableCoreCacheRT b m b) -> TableCoreCacheRT b m b)
-> (forall a b.
    TableCoreCacheRT b m a
    -> TableCoreCacheRT b m b -> TableCoreCacheRT b m b)
-> (forall a. a -> TableCoreCacheRT b m a)
-> Monad (TableCoreCacheRT b m)
forall a. a -> TableCoreCacheRT b m a
forall a b.
TableCoreCacheRT b m a
-> TableCoreCacheRT b m b -> TableCoreCacheRT b m b
forall a b.
TableCoreCacheRT b m a
-> (a -> TableCoreCacheRT b m b) -> TableCoreCacheRT b m b
forall {b :: BackendType} {m :: * -> *}.
Monad m =>
Applicative (TableCoreCacheRT b m)
forall (b :: BackendType) (m :: * -> *) a.
Monad m =>
a -> TableCoreCacheRT b m a
forall (b :: BackendType) (m :: * -> *) a b.
Monad m =>
TableCoreCacheRT b m a
-> TableCoreCacheRT b m b -> TableCoreCacheRT b m b
forall (b :: BackendType) (m :: * -> *) a b.
Monad m =>
TableCoreCacheRT b m a
-> (a -> TableCoreCacheRT b m b) -> TableCoreCacheRT b m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (b :: BackendType) (m :: * -> *) a b.
Monad m =>
TableCoreCacheRT b m a
-> (a -> TableCoreCacheRT b m b) -> TableCoreCacheRT b m b
>>= :: forall a b.
TableCoreCacheRT b m a
-> (a -> TableCoreCacheRT b m b) -> TableCoreCacheRT b m b
$c>> :: forall (b :: BackendType) (m :: * -> *) a b.
Monad m =>
TableCoreCacheRT b m a
-> TableCoreCacheRT b m b -> TableCoreCacheRT b m b
>> :: forall a b.
TableCoreCacheRT b m a
-> TableCoreCacheRT b m b -> TableCoreCacheRT b m b
$creturn :: forall (b :: BackendType) (m :: * -> *) a.
Monad m =>
a -> TableCoreCacheRT b m a
return :: forall a. a -> TableCoreCacheRT b m a
Monad, Monad (TableCoreCacheRT b m)
Monad (TableCoreCacheRT b m)
-> (forall a. IO a -> TableCoreCacheRT b m a)
-> MonadIO (TableCoreCacheRT b m)
forall a. IO a -> TableCoreCacheRT b m a
forall {b :: BackendType} {m :: * -> *}.
MonadIO m =>
Monad (TableCoreCacheRT b m)
forall (b :: BackendType) (m :: * -> *) a.
MonadIO m =>
IO a -> TableCoreCacheRT b m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall (b :: BackendType) (m :: * -> *) a.
MonadIO m =>
IO a -> TableCoreCacheRT b m a
liftIO :: forall a. IO a -> TableCoreCacheRT b m a
MonadIO, MonadError e, MonadState s, MonadWriter w, MonadError QErr (TableCoreCacheRT b m)
MonadError QErr (TableCoreCacheRT b m)
-> (forall a. TxE QErr a -> TableCoreCacheRT b m a)
-> MonadTx (TableCoreCacheRT b m)
forall a. TxE QErr a -> TableCoreCacheRT b m a
forall {b :: BackendType} {m :: * -> *}.
MonadTx m =>
MonadError QErr (TableCoreCacheRT b m)
forall (b :: BackendType) (m :: * -> *) a.
MonadTx m =>
TxE QErr a -> TableCoreCacheRT b m a
forall (m :: * -> *).
MonadError QErr m -> (forall a. TxE QErr a -> m a) -> MonadTx m
$cliftTx :: forall (b :: BackendType) (m :: * -> *) a.
MonadTx m =>
TxE QErr a -> TableCoreCacheRT b m a
liftTx :: forall a. TxE QErr a -> TableCoreCacheRT b m a
Postgres.MonadTx)
    via (ReaderT (TableCoreCache b) m)
  deriving ((forall (m :: * -> *) a. Monad m => m a -> TableCoreCacheRT b m a)
-> MonadTrans (TableCoreCacheRT b)
forall (b :: BackendType) (m :: * -> *) a.
Monad m =>
m a -> TableCoreCacheRT b m a
forall (m :: * -> *) a. Monad m => m a -> TableCoreCacheRT b m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (b :: BackendType) (m :: * -> *) a.
Monad m =>
m a -> TableCoreCacheRT b m a
lift :: forall (m :: * -> *) a. Monad m => m a -> TableCoreCacheRT b m a
MonadTrans) via (ReaderT (TableCoreCache b))

instance (MonadReader r m) => MonadReader r (TableCoreCacheRT b m) where
  ask :: TableCoreCacheRT b m r
ask = m r -> TableCoreCacheRT b m r
forall (m :: * -> *) a. Monad m => m a -> TableCoreCacheRT b m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a.
(r -> r) -> TableCoreCacheRT b m a -> TableCoreCacheRT b m a
local r -> r
f TableCoreCacheRT b m a
m = (TableCoreCache b -> m a) -> TableCoreCacheRT b m a
forall (b :: BackendType) (m :: * -> *) a.
(TableCoreCache b -> m a) -> TableCoreCacheRT b m a
TableCoreCacheRT ((r -> r) -> m a -> m a
forall a. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (m a -> m a)
-> (TableCoreCache b -> m a) -> TableCoreCache b -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableCoreCacheRT b m a -> TableCoreCache b -> m a
forall (b :: BackendType) (m :: * -> *) a.
TableCoreCacheRT b m a -> TableCoreCache b -> m a
runTableCoreCacheRT TableCoreCacheRT b m a
m)

instance (Monad m, Backend b) => TableCoreInfoRM b (TableCoreCacheRT b m) where
  lookupTableCoreInfo :: TableName b -> TableCoreCacheRT b m (Maybe (TableCoreInfo b))
lookupTableCoreInfo TableName b
tableName =
    (TableCoreCache b -> m (Maybe (TableCoreInfo b)))
-> TableCoreCacheRT b m (Maybe (TableCoreInfo b))
forall (b :: BackendType) (m :: * -> *) a.
(TableCoreCache b -> m a) -> TableCoreCacheRT b m a
TableCoreCacheRT (Maybe (TableCoreInfo b) -> m (Maybe (TableCoreInfo b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (TableCoreInfo b) -> m (Maybe (TableCoreInfo b)))
-> (TableCoreCache b -> Maybe (TableCoreInfo b))
-> TableCoreCache b
-> m (Maybe (TableCoreInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName b -> TableCoreCache b -> Maybe (TableCoreInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TableName b
tableName)

-- | All our RQL DML queries operate over a single source. This typeclass facilitates that.
class (TableCoreInfoRM b m) => TableInfoRM b m where
  lookupTableInfo :: TableName b -> m (Maybe (TableInfo b))

instance (TableInfoRM b m) => TableInfoRM b (ReaderT r m) where
  lookupTableInfo :: TableName b -> ReaderT r m (Maybe (TableInfo b))
lookupTableInfo TableName b
tableName = m (Maybe (TableInfo b)) -> ReaderT r m (Maybe (TableInfo b))
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (TableInfo b)) -> ReaderT r m (Maybe (TableInfo b)))
-> m (Maybe (TableInfo b)) -> ReaderT r m (Maybe (TableInfo b))
forall a b. (a -> b) -> a -> b
$ TableName b -> m (Maybe (TableInfo b))
forall (b :: BackendType) (m :: * -> *).
TableInfoRM b m =>
TableName b -> m (Maybe (TableInfo b))
lookupTableInfo TableName b
tableName

instance (TableInfoRM b m) => TableInfoRM b (StateT s m) where
  lookupTableInfo :: TableName b -> StateT s m (Maybe (TableInfo b))
lookupTableInfo TableName b
tableName = m (Maybe (TableInfo b)) -> StateT s m (Maybe (TableInfo b))
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (TableInfo b)) -> StateT s m (Maybe (TableInfo b)))
-> m (Maybe (TableInfo b)) -> StateT s m (Maybe (TableInfo b))
forall a b. (a -> b) -> a -> b
$ TableName b -> m (Maybe (TableInfo b))
forall (b :: BackendType) (m :: * -> *).
TableInfoRM b m =>
TableName b -> m (Maybe (TableInfo b))
lookupTableInfo TableName b
tableName

instance (Monoid w, TableInfoRM b m) => TableInfoRM b (WriterT w m) where
  lookupTableInfo :: TableName b -> WriterT w m (Maybe (TableInfo b))
lookupTableInfo TableName b
tableName = m (Maybe (TableInfo b)) -> WriterT w m (Maybe (TableInfo b))
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (TableInfo b)) -> WriterT w m (Maybe (TableInfo b)))
-> m (Maybe (TableInfo b)) -> WriterT w m (Maybe (TableInfo b))
forall a b. (a -> b) -> a -> b
$ TableName b -> m (Maybe (TableInfo b))
forall (b :: BackendType) (m :: * -> *).
TableInfoRM b m =>
TableName b -> m (Maybe (TableInfo b))
lookupTableInfo TableName b
tableName

instance (TableInfoRM b m) => TableInfoRM b (TraceT m) where
  lookupTableInfo :: TableName b -> TraceT m (Maybe (TableInfo b))
lookupTableInfo TableName b
tableName = m (Maybe (TableInfo b)) -> TraceT m (Maybe (TableInfo b))
forall (m :: * -> *) a. Monad m => m a -> TraceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (TableInfo b)) -> TraceT m (Maybe (TableInfo b)))
-> m (Maybe (TableInfo b)) -> TraceT m (Maybe (TableInfo b))
forall a b. (a -> b) -> a -> b
$ TableName b -> m (Maybe (TableInfo b))
forall (b :: BackendType) (m :: * -> *).
TableInfoRM b m =>
TableName b -> m (Maybe (TableInfo b))
lookupTableInfo TableName b
tableName

newtype TableCacheRT b m a = TableCacheRT {forall (b :: BackendType) (m :: * -> *) a.
TableCacheRT b m a -> TableCache b -> m a
runTableCacheRT :: TableCache b -> m a}
  deriving
    ((forall a b. (a -> b) -> TableCacheRT b m a -> TableCacheRT b m b)
-> (forall a b. a -> TableCacheRT b m b -> TableCacheRT b m a)
-> Functor (TableCacheRT b m)
forall a b. a -> TableCacheRT b m b -> TableCacheRT b m a
forall a b. (a -> b) -> TableCacheRT b m a -> TableCacheRT b m b
forall (b :: BackendType) (m :: * -> *) a b.
Functor m =>
a -> TableCacheRT b m b -> TableCacheRT b m a
forall (b :: BackendType) (m :: * -> *) a b.
Functor m =>
(a -> b) -> TableCacheRT b m a -> TableCacheRT b m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (b :: BackendType) (m :: * -> *) a b.
Functor m =>
(a -> b) -> TableCacheRT b m a -> TableCacheRT b m b
fmap :: forall a b. (a -> b) -> TableCacheRT b m a -> TableCacheRT b m b
$c<$ :: forall (b :: BackendType) (m :: * -> *) a b.
Functor m =>
a -> TableCacheRT b m b -> TableCacheRT b m a
<$ :: forall a b. a -> TableCacheRT b m b -> TableCacheRT b m a
Functor, Functor (TableCacheRT b m)
Functor (TableCacheRT b m)
-> (forall a. a -> TableCacheRT b m a)
-> (forall a b.
    TableCacheRT b m (a -> b)
    -> TableCacheRT b m a -> TableCacheRT b m b)
-> (forall a b c.
    (a -> b -> c)
    -> TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m c)
-> (forall a b.
    TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m b)
-> (forall a b.
    TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m a)
-> Applicative (TableCacheRT b m)
forall a. a -> TableCacheRT b m a
forall a b.
TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m a
forall a b.
TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m b
forall a b.
TableCacheRT b m (a -> b)
-> TableCacheRT b m a -> TableCacheRT b m b
forall a b c.
(a -> b -> c)
-> TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m c
forall {b :: BackendType} {m :: * -> *}.
Applicative m =>
Functor (TableCacheRT b m)
forall (b :: BackendType) (m :: * -> *) a.
Applicative m =>
a -> TableCacheRT b m a
forall (b :: BackendType) (m :: * -> *) a b.
Applicative m =>
TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m a
forall (b :: BackendType) (m :: * -> *) a b.
Applicative m =>
TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m b
forall (b :: BackendType) (m :: * -> *) a b.
Applicative m =>
TableCacheRT b m (a -> b)
-> TableCacheRT b m a -> TableCacheRT b m b
forall (b :: BackendType) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (b :: BackendType) (m :: * -> *) a.
Applicative m =>
a -> TableCacheRT b m a
pure :: forall a. a -> TableCacheRT b m a
$c<*> :: forall (b :: BackendType) (m :: * -> *) a b.
Applicative m =>
TableCacheRT b m (a -> b)
-> TableCacheRT b m a -> TableCacheRT b m b
<*> :: forall a b.
TableCacheRT b m (a -> b)
-> TableCacheRT b m a -> TableCacheRT b m b
$cliftA2 :: forall (b :: BackendType) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m c
liftA2 :: forall a b c.
(a -> b -> c)
-> TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m c
$c*> :: forall (b :: BackendType) (m :: * -> *) a b.
Applicative m =>
TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m b
*> :: forall a b.
TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m b
$c<* :: forall (b :: BackendType) (m :: * -> *) a b.
Applicative m =>
TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m a
<* :: forall a b.
TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m a
Applicative, Applicative (TableCacheRT b m)
Applicative (TableCacheRT b m)
-> (forall a b.
    TableCacheRT b m a
    -> (a -> TableCacheRT b m b) -> TableCacheRT b m b)
-> (forall a b.
    TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m b)
-> (forall a. a -> TableCacheRT b m a)
-> Monad (TableCacheRT b m)
forall a. a -> TableCacheRT b m a
forall a b.
TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m b
forall a b.
TableCacheRT b m a
-> (a -> TableCacheRT b m b) -> TableCacheRT b m b
forall {b :: BackendType} {m :: * -> *}.
Monad m =>
Applicative (TableCacheRT b m)
forall (b :: BackendType) (m :: * -> *) a.
Monad m =>
a -> TableCacheRT b m a
forall (b :: BackendType) (m :: * -> *) a b.
Monad m =>
TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m b
forall (b :: BackendType) (m :: * -> *) a b.
Monad m =>
TableCacheRT b m a
-> (a -> TableCacheRT b m b) -> TableCacheRT b m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (b :: BackendType) (m :: * -> *) a b.
Monad m =>
TableCacheRT b m a
-> (a -> TableCacheRT b m b) -> TableCacheRT b m b
>>= :: forall a b.
TableCacheRT b m a
-> (a -> TableCacheRT b m b) -> TableCacheRT b m b
$c>> :: forall (b :: BackendType) (m :: * -> *) a b.
Monad m =>
TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m b
>> :: forall a b.
TableCacheRT b m a -> TableCacheRT b m b -> TableCacheRT b m b
$creturn :: forall (b :: BackendType) (m :: * -> *) a.
Monad m =>
a -> TableCacheRT b m a
return :: forall a. a -> TableCacheRT b m a
Monad, Monad (TableCacheRT b m)
Monad (TableCacheRT b m)
-> (forall a. IO a -> TableCacheRT b m a)
-> MonadIO (TableCacheRT b m)
forall a. IO a -> TableCacheRT b m a
forall {b :: BackendType} {m :: * -> *}.
MonadIO m =>
Monad (TableCacheRT b m)
forall (b :: BackendType) (m :: * -> *) a.
MonadIO m =>
IO a -> TableCacheRT b m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall (b :: BackendType) (m :: * -> *) a.
MonadIO m =>
IO a -> TableCacheRT b m a
liftIO :: forall a. IO a -> TableCacheRT b m a
MonadIO, MonadError e, MonadState s, MonadWriter w, MonadError QErr (TableCacheRT b m)
MonadError QErr (TableCacheRT b m)
-> (forall a. TxE QErr a -> TableCacheRT b m a)
-> MonadTx (TableCacheRT b m)
forall a. TxE QErr a -> TableCacheRT b m a
forall {b :: BackendType} {m :: * -> *}.
MonadTx m =>
MonadError QErr (TableCacheRT b m)
forall (b :: BackendType) (m :: * -> *) a.
MonadTx m =>
TxE QErr a -> TableCacheRT b m a
forall (m :: * -> *).
MonadError QErr m -> (forall a. TxE QErr a -> m a) -> MonadTx m
$cliftTx :: forall (b :: BackendType) (m :: * -> *) a.
MonadTx m =>
TxE QErr a -> TableCacheRT b m a
liftTx :: forall a. TxE QErr a -> TableCacheRT b m a
Postgres.MonadTx, Monad (TableCacheRT b m)
TableCacheRT b m UserInfo
Monad (TableCacheRT b m)
-> TableCacheRT b m UserInfo -> UserInfoM (TableCacheRT b m)
forall {b :: BackendType} {m :: * -> *}.
UserInfoM m =>
Monad (TableCacheRT b m)
forall (b :: BackendType) (m :: * -> *).
UserInfoM m =>
TableCacheRT b m UserInfo
forall (m :: * -> *). Monad m -> m UserInfo -> UserInfoM m
$caskUserInfo :: forall (b :: BackendType) (m :: * -> *).
UserInfoM m =>
TableCacheRT b m UserInfo
askUserInfo :: TableCacheRT b m UserInfo
UserInfoM)
    via (ReaderT (TableCache b) m)
  deriving ((forall (m :: * -> *) a. Monad m => m a -> TableCacheRT b m a)
-> MonadTrans (TableCacheRT b)
forall (b :: BackendType) (m :: * -> *) a.
Monad m =>
m a -> TableCacheRT b m a
forall (m :: * -> *) a. Monad m => m a -> TableCacheRT b m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (b :: BackendType) (m :: * -> *) a.
Monad m =>
m a -> TableCacheRT b m a
lift :: forall (m :: * -> *) a. Monad m => m a -> TableCacheRT b m a
MonadTrans) via (ReaderT (TableCache b))

instance (Monad m, Backend b) => TableCoreInfoRM b (TableCacheRT b m) where
  lookupTableCoreInfo :: TableName b -> TableCacheRT b m (Maybe (TableCoreInfo b))
lookupTableCoreInfo TableName b
tableName =
    (TableCache b -> m (Maybe (TableCoreInfo b)))
-> TableCacheRT b m (Maybe (TableCoreInfo b))
forall (b :: BackendType) (m :: * -> *) a.
(TableCache b -> m a) -> TableCacheRT b m a
TableCacheRT (Maybe (TableCoreInfo b) -> m (Maybe (TableCoreInfo b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (TableCoreInfo b) -> m (Maybe (TableCoreInfo b)))
-> (TableCache b -> Maybe (TableCoreInfo b))
-> TableCache b
-> m (Maybe (TableCoreInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TableInfo b -> TableCoreInfo b)
-> Maybe (TableInfo b) -> Maybe (TableCoreInfo b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableInfo b -> TableCoreInfo b
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo (Maybe (TableInfo b) -> Maybe (TableCoreInfo b))
-> (TableCache b -> Maybe (TableInfo b))
-> TableCache b
-> Maybe (TableCoreInfo b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName b -> TableCache b -> Maybe (TableInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TableName b
tableName)

instance (Monad m, Backend b) => TableInfoRM b (TableCacheRT b m) where
  lookupTableInfo :: TableName b -> TableCacheRT b m (Maybe (TableInfo b))
lookupTableInfo TableName b
tableName =
    (TableCache b -> m (Maybe (TableInfo b)))
-> TableCacheRT b m (Maybe (TableInfo b))
forall (b :: BackendType) (m :: * -> *) a.
(TableCache b -> m a) -> TableCacheRT b m a
TableCacheRT (Maybe (TableInfo b) -> m (Maybe (TableInfo b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (TableInfo b) -> m (Maybe (TableInfo b)))
-> (TableCache b -> Maybe (TableInfo b))
-> TableCache b
-> m (Maybe (TableInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableName b -> TableCache b -> Maybe (TableInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TableName b
tableName)

class (Monad m) => CacheRM m where
  askSchemaCache :: m SchemaCache

instance (CacheRM m) => CacheRM (ReaderT r m) where
  askSchemaCache :: ReaderT r m SchemaCache
askSchemaCache = m SchemaCache -> ReaderT r m SchemaCache
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache

instance (CacheRM m) => CacheRM (StateT s m) where
  askSchemaCache :: StateT s m SchemaCache
askSchemaCache = m SchemaCache -> StateT s m SchemaCache
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache

instance (Monoid w, CacheRM m) => CacheRM (WriterT w m) where
  askSchemaCache :: WriterT w m SchemaCache
askSchemaCache = m SchemaCache -> WriterT w m SchemaCache
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache

instance (CacheRM m) => CacheRM (TraceT m) where
  askSchemaCache :: TraceT m SchemaCache
askSchemaCache = m SchemaCache -> TraceT m SchemaCache
forall (m :: * -> *) a. Monad m => m a -> TraceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache

instance (CacheRM m) => CacheRM (PG.TxET QErr m) where
  askSchemaCache :: TxET QErr m SchemaCache
askSchemaCache = m SchemaCache -> TxET QErr m SchemaCache
forall (m :: * -> *) a. Monad m => m a -> TxET QErr m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache

instance (CacheRM m) => CacheRM (MSSQL.TxET e m) where
  askSchemaCache :: TxET e m SchemaCache
askSchemaCache = m SchemaCache -> TxET e m SchemaCache
forall (m :: * -> *) a. Monad m => m a -> TxET e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache

getDependentObjs :: SchemaCache -> SchemaObjId -> [SchemaObjId]
getDependentObjs :: SchemaCache -> SchemaObjId -> [SchemaObjId]
getDependentObjs = (DependencyReason -> Bool)
-> SchemaCache -> SchemaObjId -> [SchemaObjId]
getDependentObjsWith (Bool -> DependencyReason -> Bool
forall a b. a -> b -> a
const Bool
True)

getDependentObjsWith ::
  (DependencyReason -> Bool) -> SchemaCache -> SchemaObjId -> [SchemaObjId]
getDependentObjsWith :: (DependencyReason -> Bool)
-> SchemaCache -> SchemaObjId -> [SchemaObjId]
getDependentObjsWith DependencyReason -> Bool
f SchemaCache
sc SchemaObjId
objId =
  ((SchemaObjId, HashSet SchemaDependency) -> SchemaObjId)
-> [(SchemaObjId, HashSet SchemaDependency)] -> [SchemaObjId]
forall a b. (a -> b) -> [a] -> [b]
map (SchemaObjId, HashSet SchemaDependency) -> SchemaObjId
forall a b. (a, b) -> a
fst ([(SchemaObjId, HashSet SchemaDependency)] -> [SchemaObjId])
-> [(SchemaObjId, HashSet SchemaDependency)] -> [SchemaObjId]
forall a b. (a -> b) -> a -> b
$ ((SchemaObjId, HashSet SchemaDependency) -> Bool)
-> [(SchemaObjId, HashSet SchemaDependency)]
-> [(SchemaObjId, HashSet SchemaDependency)]
forall a. (a -> Bool) -> [a] -> [a]
filter (HashSet SchemaDependency -> Bool
isDependency (HashSet SchemaDependency -> Bool)
-> ((SchemaObjId, HashSet SchemaDependency)
    -> HashSet SchemaDependency)
-> (SchemaObjId, HashSet SchemaDependency)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SchemaObjId, HashSet SchemaDependency) -> HashSet SchemaDependency
forall a b. (a, b) -> b
snd) ([(SchemaObjId, HashSet SchemaDependency)]
 -> [(SchemaObjId, HashSet SchemaDependency)])
-> [(SchemaObjId, HashSet SchemaDependency)]
-> [(SchemaObjId, HashSet SchemaDependency)]
forall a b. (a -> b) -> a -> b
$ DepMap -> [(SchemaObjId, HashSet SchemaDependency)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList (DepMap -> [(SchemaObjId, HashSet SchemaDependency)])
-> DepMap -> [(SchemaObjId, HashSet SchemaDependency)]
forall a b. (a -> b) -> a -> b
$ SchemaCache -> DepMap
scDepMap SchemaCache
sc
  where
    isDependency :: HashSet SchemaDependency -> Bool
isDependency HashSet SchemaDependency
deps = Bool -> Bool
not
      (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ HashSet SchemaDependency -> Bool
forall a. HashSet a -> Bool
HS.null
      (HashSet SchemaDependency -> Bool)
-> HashSet SchemaDependency -> Bool
forall a b. (a -> b) -> a -> b
$ ((SchemaDependency -> Bool)
 -> HashSet SchemaDependency -> HashSet SchemaDependency)
-> HashSet SchemaDependency
-> (SchemaDependency -> Bool)
-> HashSet SchemaDependency
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SchemaDependency -> Bool)
-> HashSet SchemaDependency -> HashSet SchemaDependency
forall a. (a -> Bool) -> HashSet a -> HashSet a
HS.filter HashSet SchemaDependency
deps
      ((SchemaDependency -> Bool) -> HashSet SchemaDependency)
-> (SchemaDependency -> Bool) -> HashSet SchemaDependency
forall a b. (a -> b) -> a -> b
$ \(SchemaDependency SchemaObjId
depId DependencyReason
reason) -> SchemaObjId
objId SchemaObjId -> SchemaObjId -> Bool
`induces` SchemaObjId
depId Bool -> Bool -> Bool
&& DependencyReason -> Bool
f DependencyReason
reason
    -- induces a b : is b dependent on a
    induces :: SchemaObjId -> SchemaObjId -> Bool
induces (SOSource SourceName
s1) (SOSource SourceName
s2) = SourceName
s1 SourceName -> SourceName -> Bool
forall a. Eq a => a -> a -> Bool
== SourceName
s2
    induces (SOSource SourceName
s1) (SOSourceObj SourceName
s2 AnyBackend SourceObjId
_) = SourceName
s1 SourceName -> SourceName -> Bool
forall a. Eq a => a -> a -> Bool
== SourceName
s2
    induces o1 :: SchemaObjId
o1@(SOSourceObj SourceName
s1 AnyBackend SourceObjId
e1) o2 :: SchemaObjId
o2@(SOSourceObj SourceName
s2 AnyBackend SourceObjId
e2) =
      SourceName
s1 SourceName -> SourceName -> Bool
forall a. Eq a => a -> a -> Bool
== SourceName
s2 Bool -> Bool -> Bool
&& Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (SchemaObjId
o1 SchemaObjId -> SchemaObjId -> Bool
forall a. Eq a => a -> a -> Bool
== SchemaObjId
o2) (forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
(forall (b :: BackendType). c b => i b -> i b -> r)
-> AnyBackend i -> AnyBackend i -> r -> r
AB.composeAnyBackend @Backend SourceObjId b -> SourceObjId b -> Maybe Bool
forall (b :: BackendType).
Backend b =>
SourceObjId b -> SourceObjId b -> Maybe Bool
forall {b :: BackendType} {b :: BackendType}.
(TableName b ~ TableName b, Eq (TableName b)) =>
SourceObjId b -> SourceObjId b -> Maybe Bool
go AnyBackend SourceObjId
e1 AnyBackend SourceObjId
e2 Maybe Bool
forall a. Maybe a
Nothing)
    induces SchemaObjId
o1 SchemaObjId
o2 = SchemaObjId
o1 SchemaObjId -> SchemaObjId -> Bool
forall a. Eq a => a -> a -> Bool
== SchemaObjId
o2

    go :: SourceObjId b -> SourceObjId b -> Maybe Bool
go (SOITable TableName b
tn1) (SOITable TableName b
tn2) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ TableName b
tn1 TableName b -> TableName b -> Bool
forall a. Eq a => a -> a -> Bool
== TableName b
TableName b
tn2
    go (SOITable TableName b
tn1) (SOITableObj TableName b
tn2 TableObjId b
_) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ TableName b
tn1 TableName b -> TableName b -> Bool
forall a. Eq a => a -> a -> Bool
== TableName b
TableName b
tn2
    go SourceObjId b
_ SourceObjId b
_ = Maybe Bool
forall a. Maybe a
Nothing

-- | Compute all remote dependencies on a source.
--
-- Given a source name, this function computes all of its dependencies, direct
-- or indirect, and returns all of the dependencies that are not "local" to the
-- source, i.e. that belong to another source or to a remote schema, here dubbed
-- "remote dependencies".
--
-- This functions returns a 'SchemaObjId' for each such dependency, but makes no
-- attempt at extracting the underlying `SourceObjId` (if any), for two reasons:
--   1. a `SourceObjId` no longer contains the source name, which most callers
--      need to identify where the corresponding dependency is
--   2. this would prevent us from returning remote schema dependencies, which
--      by definition do not have a corresponding `SourceObjId`
getRemoteDependencies ::
  SchemaCache ->
  SourceName ->
  [SchemaObjId]
getRemoteDependencies :: SchemaCache -> SourceName -> [SchemaObjId]
getRemoteDependencies SchemaCache
schemaCache SourceName
sourceName =
  (SchemaObjId -> Bool) -> [SchemaObjId] -> [SchemaObjId]
forall a. (a -> Bool) -> [a] -> [a]
filter SchemaObjId -> Bool
isRemoteDep ([SchemaObjId] -> [SchemaObjId]) -> [SchemaObjId] -> [SchemaObjId]
forall a b. (a -> b) -> a -> b
$ SchemaCache -> SchemaObjId -> [SchemaObjId]
getDependentObjs SchemaCache
schemaCache (SourceName -> SchemaObjId
SOSource SourceName
sourceName)
  where
    isRemoteDep :: SchemaObjId -> Bool
isRemoteDep = \case
      SOSourceObj SourceName
sn AnyBackend SourceObjId
_
        -- only true if the dependency is in another source
        | SourceName
sn SourceName -> SourceName -> Bool
forall a. Eq a => a -> a -> Bool
/= SourceName
sourceName -> Bool
True
        | Bool
otherwise -> Bool
False
      SORemoteSchemaRemoteRelationship {} -> Bool
True
      -- those relationshipss either do not exist or do not qualify as remote
      SOSource {} -> Bool
False
      SORemoteSchema {} -> Bool
False
      SORemoteSchemaPermission {} -> Bool
False
      SORole {} -> Bool
False

-- | What schema dependencies does a given row permission for a logical model
-- have? This will almost certainly involve some number of dependencies on
-- logical models, but may also involve dependencies on tables. Although we
-- can't relate tables and logical models yet, we can still declare permissions
-- like, "you can only see this logical model if your user ID exists in this
-- table".
getLogicalModelBoolExpDeps ::
  forall b.
  (GetAggregationPredicatesDeps b) =>
  SourceName ->
  LogicalModelName ->
  AnnBoolExpPartialSQL b ->
  [SchemaDependency]
getLogicalModelBoolExpDeps :: forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
SourceName
-> LogicalModelName -> AnnBoolExpPartialSQL b -> [SchemaDependency]
getLogicalModelBoolExpDeps SourceName
source LogicalModelName
logicalModelName = \case
  BoolAnd [AnnBoolExpPartialSQL b]
exps -> (AnnBoolExpPartialSQL b -> [SchemaDependency])
-> [AnnBoolExpPartialSQL b] -> [SchemaDependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SourceName
-> LogicalModelName -> AnnBoolExpPartialSQL b -> [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
SourceName
-> LogicalModelName -> AnnBoolExpPartialSQL b -> [SchemaDependency]
getLogicalModelBoolExpDeps SourceName
source LogicalModelName
logicalModelName) [AnnBoolExpPartialSQL b]
exps
  BoolOr [AnnBoolExpPartialSQL b]
exps -> (AnnBoolExpPartialSQL b -> [SchemaDependency])
-> [AnnBoolExpPartialSQL b] -> [SchemaDependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SourceName
-> LogicalModelName -> AnnBoolExpPartialSQL b -> [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
SourceName
-> LogicalModelName -> AnnBoolExpPartialSQL b -> [SchemaDependency]
getLogicalModelBoolExpDeps SourceName
source LogicalModelName
logicalModelName) [AnnBoolExpPartialSQL b]
exps
  BoolNot AnnBoolExpPartialSQL b
e -> SourceName
-> LogicalModelName -> AnnBoolExpPartialSQL b -> [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
SourceName
-> LogicalModelName -> AnnBoolExpPartialSQL b -> [SchemaDependency]
getLogicalModelBoolExpDeps SourceName
source LogicalModelName
logicalModelName AnnBoolExpPartialSQL b
e
  BoolField AnnBoolExpFld b (PartialSQLExp b)
fld -> SourceName
-> LogicalModelName
-> AnnBoolExpFld b (PartialSQLExp b)
-> [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
SourceName
-> LogicalModelName
-> AnnBoolExpFld b (PartialSQLExp b)
-> [SchemaDependency]
getLogicalModelColExpDeps SourceName
source LogicalModelName
logicalModelName AnnBoolExpFld b (PartialSQLExp b)
fld
  BoolExists (GExists TableName b
refqt AnnBoolExpPartialSQL b
whereExp) -> do
    let table :: SchemaObjId
        table :: SchemaObjId
table = SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). TableName b -> SourceObjId b
SOITable @b TableName b
refqt

    SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency SchemaObjId
table DependencyReason
DRRemoteTable SchemaDependency -> [SchemaDependency] -> [SchemaDependency]
forall a. a -> [a] -> [a]
: SourceName
-> TableName b -> AnnBoolExpPartialSQL b -> [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
SourceName
-> TableName b -> AnnBoolExpPartialSQL b -> [SchemaDependency]
getBoolExpDeps SourceName
source TableName b
refqt AnnBoolExpPartialSQL b
whereExp

-- | What schema dependencies does this row permission for a particular column
-- within a logical model have? This is a fairly simple function at the moment
-- as there's only one type of column: columns! As a result, we have no
-- dependencies from relationships, computed fields, or aggregation predicates,
-- as none of these things are supported.
getLogicalModelColExpDeps ::
  forall b.
  (GetAggregationPredicatesDeps b) =>
  SourceName ->
  LogicalModelName ->
  AnnBoolExpFld b (PartialSQLExp b) ->
  [SchemaDependency]
getLogicalModelColExpDeps :: forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
SourceName
-> LogicalModelName
-> AnnBoolExpFld b (PartialSQLExp b)
-> [SchemaDependency]
getLogicalModelColExpDeps SourceName
source LogicalModelName
logicalModelName = \case
  AVRelationship {} -> []
  AVComputedField AnnComputedFieldBoolExp b (PartialSQLExp b)
_ -> []
  AVAggregationPredicates AggregationPredicates b (PartialSQLExp b)
_ -> []
  AVColumn ColumnInfo b
colInfo [OpExpG b (PartialSQLExp b)]
opExps -> do
    let columnName :: Column b
        columnName :: Column b
columnName = ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo b
colInfo

        -- Do we depend on /any/ arbitrary SQL expression, or are /all/ our
        -- dependencies on session variables?
        colDepReason :: DependencyReason
        colDepReason :: DependencyReason
colDepReason = DependencyReason -> DependencyReason -> Bool -> DependencyReason
forall a. a -> a -> Bool -> a
bool DependencyReason
DRSessionVariable DependencyReason
DROnType ((OpExpG b (PartialSQLExp b) -> Bool)
-> [OpExpG b (PartialSQLExp b)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any OpExpG b (PartialSQLExp b) -> Bool
forall (b :: BackendType).
Backend b =>
OpExpG b (PartialSQLExp b) -> Bool
hasStaticExp [OpExpG b (PartialSQLExp b)]
opExps)

        colDep :: SchemaDependency
        colDep :: SchemaDependency
colDep = forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName -> LogicalModelName -> Column b -> SchemaDependency
mkLogicalModelColDep @b DependencyReason
colDepReason SourceName
source LogicalModelName
logicalModelName Column b
columnName

    SchemaDependency
colDep SchemaDependency -> [SchemaDependency] -> [SchemaDependency]
forall a. a -> [a] -> [a]
: SourceName
-> LogicalModelName
-> [OpExpG b (PartialSQLExp b)]
-> [SchemaDependency]
forall (b :: BackendType).
Backend b =>
SourceName
-> LogicalModelName
-> [OpExpG b (PartialSQLExp b)]
-> [SchemaDependency]
getLogicalModelOpExpDeps SourceName
source LogicalModelName
logicalModelName [OpExpG b (PartialSQLExp b)]
opExps

-- | Discover the schema dependencies of an @AnnBoolExpPartialSQL@.
getBoolExpDeps ::
  forall b.
  (GetAggregationPredicatesDeps b) =>
  SourceName ->
  TableName b ->
  AnnBoolExpPartialSQL b ->
  [SchemaDependency]
getBoolExpDeps :: forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
SourceName
-> TableName b -> AnnBoolExpPartialSQL b -> [SchemaDependency]
getBoolExpDeps SourceName
source TableName b
tableName =
  BoolExpCtx b -> BoolExpM b [SchemaDependency] -> [SchemaDependency]
forall (b :: BackendType) a. BoolExpCtx b -> BoolExpM b a -> a
runBoolExpM (BoolExpCtx {source :: SourceName
source = SourceName
source, currTable :: TableName b
currTable = TableName b
tableName, rootTable :: TableName b
rootTable = TableName b
tableName}) (BoolExpM b [SchemaDependency] -> [SchemaDependency])
-> (AnnBoolExpPartialSQL b -> BoolExpM b [SchemaDependency])
-> AnnBoolExpPartialSQL b
-> [SchemaDependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnBoolExpPartialSQL b -> BoolExpM b [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
AnnBoolExpPartialSQL b -> BoolExpM b [SchemaDependency]
getBoolExpDeps'

getBoolExpDeps' ::
  forall b.
  (GetAggregationPredicatesDeps b) =>
  AnnBoolExpPartialSQL b ->
  BoolExpM b [SchemaDependency]
getBoolExpDeps' :: forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
AnnBoolExpPartialSQL b -> BoolExpM b [SchemaDependency]
getBoolExpDeps' = \case
  BoolAnd [AnnBoolExpPartialSQL b]
exps -> [AnnBoolExpPartialSQL b] -> BoolExpM b [SchemaDependency]
procExps [AnnBoolExpPartialSQL b]
exps
  BoolOr [AnnBoolExpPartialSQL b]
exps -> [AnnBoolExpPartialSQL b] -> BoolExpM b [SchemaDependency]
procExps [AnnBoolExpPartialSQL b]
exps
  BoolNot AnnBoolExpPartialSQL b
e -> AnnBoolExpPartialSQL b -> BoolExpM b [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
AnnBoolExpPartialSQL b -> BoolExpM b [SchemaDependency]
getBoolExpDeps' AnnBoolExpPartialSQL b
e
  BoolField AnnBoolExpFld b (PartialSQLExp b)
fld -> AnnBoolExpFld b (PartialSQLExp b) -> BoolExpM b [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
AnnBoolExpFld b (PartialSQLExp b) -> BoolExpM b [SchemaDependency]
getColExpDeps AnnBoolExpFld b (PartialSQLExp b)
fld
  BoolExists (GExists TableName b
refqt AnnBoolExpPartialSQL b
whereExp) -> do
    BoolExpCtx {SourceName
source :: forall (b :: BackendType). BoolExpCtx b -> SourceName
source :: SourceName
source} <- BoolExpM b (BoolExpCtx b)
forall r (m :: * -> *). MonadReader r m => m r
ask
    let tableDep :: SchemaDependency
tableDep =
          SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
            ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
                (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). TableName b -> SourceObjId b
SOITable @b TableName b
refqt
            )
            DependencyReason
DRRemoteTable
    (SchemaDependency
tableDep SchemaDependency -> [SchemaDependency] -> [SchemaDependency]
forall a. a -> [a] -> [a]
:) ([SchemaDependency] -> [SchemaDependency])
-> BoolExpM b [SchemaDependency] -> BoolExpM b [SchemaDependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BoolExpCtx b -> BoolExpCtx b)
-> BoolExpM b [SchemaDependency] -> BoolExpM b [SchemaDependency]
forall a.
(BoolExpCtx b -> BoolExpCtx b) -> BoolExpM b a -> BoolExpM b a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\BoolExpCtx b
e -> BoolExpCtx b
e {currTable :: TableName b
currTable = TableName b
refqt}) (AnnBoolExpPartialSQL b -> BoolExpM b [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
AnnBoolExpPartialSQL b -> BoolExpM b [SchemaDependency]
getBoolExpDeps' AnnBoolExpPartialSQL b
whereExp)
  where
    procExps :: [AnnBoolExpPartialSQL b] -> BoolExpM b [SchemaDependency]
    procExps :: [AnnBoolExpPartialSQL b] -> BoolExpM b [SchemaDependency]
procExps = ([[SchemaDependency]] -> [SchemaDependency])
-> BoolExpM b [[SchemaDependency]] -> BoolExpM b [SchemaDependency]
forall a b. (a -> b) -> BoolExpM b a -> BoolExpM b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[SchemaDependency]] -> [SchemaDependency]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (BoolExpM b [[SchemaDependency]] -> BoolExpM b [SchemaDependency])
-> ([AnnBoolExpPartialSQL b] -> BoolExpM b [[SchemaDependency]])
-> [AnnBoolExpPartialSQL b]
-> BoolExpM b [SchemaDependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnnBoolExpPartialSQL b -> BoolExpM b [SchemaDependency])
-> [AnnBoolExpPartialSQL b] -> BoolExpM b [[SchemaDependency]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AnnBoolExpPartialSQL b -> BoolExpM b [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
AnnBoolExpPartialSQL b -> BoolExpM b [SchemaDependency]
getBoolExpDeps'

getColExpDeps ::
  forall b.
  (GetAggregationPredicatesDeps b) =>
  AnnBoolExpFld b (PartialSQLExp b) ->
  BoolExpM b [SchemaDependency]
getColExpDeps :: forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
AnnBoolExpFld b (PartialSQLExp b) -> BoolExpM b [SchemaDependency]
getColExpDeps AnnBoolExpFld b (PartialSQLExp b)
bexp = do
  BoolExpCtx {SourceName
source :: forall (b :: BackendType). BoolExpCtx b -> SourceName
source :: SourceName
source, TableName b
currTable :: forall (b :: BackendType). BoolExpCtx b -> TableName b
currTable :: TableName b
currTable} <- BoolExpM b (BoolExpCtx b)
forall r (m :: * -> *). MonadReader r m => m r
ask
  case AnnBoolExpFld b (PartialSQLExp b)
bexp of
    AVColumn ColumnInfo b
colInfo [OpExpG b (PartialSQLExp b)]
opExps ->
      let columnName :: Column b
columnName = ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo b
colInfo
          colDepReason :: DependencyReason
colDepReason = DependencyReason -> DependencyReason -> Bool -> DependencyReason
forall a. a -> a -> Bool -> a
bool DependencyReason
DRSessionVariable DependencyReason
DROnType (Bool -> DependencyReason) -> Bool -> DependencyReason
forall a b. (a -> b) -> a -> b
$ (OpExpG b (PartialSQLExp b) -> Bool)
-> [OpExpG b (PartialSQLExp b)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any OpExpG b (PartialSQLExp b) -> Bool
forall (b :: BackendType).
Backend b =>
OpExpG b (PartialSQLExp b) -> Bool
hasStaticExp [OpExpG b (PartialSQLExp b)]
opExps
          colDep :: SchemaDependency
colDep = forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName -> TableName b -> Column b -> SchemaDependency
mkColDep @b DependencyReason
colDepReason SourceName
source TableName b
currTable Column b
columnName
       in (SchemaDependency
colDep SchemaDependency -> [SchemaDependency] -> [SchemaDependency]
forall a. a -> [a] -> [a]
:) ([SchemaDependency] -> [SchemaDependency])
-> BoolExpM b [SchemaDependency] -> BoolExpM b [SchemaDependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OpExpG b (PartialSQLExp b)] -> BoolExpM b [SchemaDependency]
forall (b :: BackendType).
Backend b =>
[OpExpG b (PartialSQLExp b)] -> BoolExpM b [SchemaDependency]
getOpExpDeps [OpExpG b (PartialSQLExp b)]
opExps
    AVRelationship RelInfo b
relInfo RelationshipFilters {AnnBoolExp b (PartialSQLExp b)
rfTargetTablePermissions :: AnnBoolExp b (PartialSQLExp b)
rfTargetTablePermissions :: forall (backend :: BackendType) leaf.
RelationshipFilters backend leaf -> AnnBoolExp backend leaf
rfTargetTablePermissions, AnnBoolExp b (PartialSQLExp b)
rfFilter :: AnnBoolExp b (PartialSQLExp b)
rfFilter :: forall (backend :: BackendType) leaf.
RelationshipFilters backend leaf -> AnnBoolExp backend leaf
rfFilter} ->
      case RelInfo b -> RelTarget b
forall (b :: BackendType). RelInfo b -> RelTarget b
riTarget RelInfo b
relInfo of
        RelTargetNativeQuery NativeQueryName
_ -> String -> BoolExpM b [SchemaDependency]
forall a. HasCallStack => String -> a
error String
"getColExpDeps RelTargetNativeQuery"
        RelTargetTable TableName b
relationshipTable ->
          let relationshipName :: RelName
relationshipName = RelInfo b -> RelName
forall (b :: BackendType). RelInfo b -> RelName
riName RelInfo b
relInfo
              schemaDependency :: SchemaDependency
schemaDependency =
                SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
                  ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source
                      (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                      (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b TableName b
currTable (RelName -> TableObjId b
forall (b :: BackendType). RelName -> TableObjId b
TORel RelName
relationshipName)
                  )
                  DependencyReason
DROnType
           in do
                [SchemaDependency]
boolExpDeps <- (BoolExpCtx b -> BoolExpCtx b)
-> BoolExpM b [SchemaDependency] -> BoolExpM b [SchemaDependency]
forall a.
(BoolExpCtx b -> BoolExpCtx b) -> BoolExpM b a -> BoolExpM b a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\BoolExpCtx b
e -> BoolExpCtx b
e {currTable :: TableName b
currTable = TableName b
relationshipTable}) (AnnBoolExp b (PartialSQLExp b) -> BoolExpM b [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
AnnBoolExpPartialSQL b -> BoolExpM b [SchemaDependency]
getBoolExpDeps' AnnBoolExp b (PartialSQLExp b)
rfFilter)
                [SchemaDependency]
permDeps <-
                  (BoolExpCtx b -> BoolExpCtx b)
-> BoolExpM b [SchemaDependency] -> BoolExpM b [SchemaDependency]
forall a.
(BoolExpCtx b -> BoolExpCtx b) -> BoolExpM b a -> BoolExpM b a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
                    ( \BoolExpCtx b
e ->
                        BoolExpCtx b
e
                          { currTable :: TableName b
currTable = TableName b
relationshipTable,
                            rootTable :: TableName b
rootTable = TableName b
relationshipTable
                          }
                    )
                    (AnnBoolExp b (PartialSQLExp b) -> BoolExpM b [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
AnnBoolExpPartialSQL b -> BoolExpM b [SchemaDependency]
getBoolExpDeps' AnnBoolExp b (PartialSQLExp b)
rfTargetTablePermissions)
                [SchemaDependency] -> BoolExpM b [SchemaDependency]
forall a. a -> BoolExpM b a
forall (m :: * -> *) a. Monad m => a -> m a
return (SchemaDependency
schemaDependency SchemaDependency -> [SchemaDependency] -> [SchemaDependency]
forall a. a -> [a] -> [a]
: [SchemaDependency]
boolExpDeps [SchemaDependency] -> [SchemaDependency] -> [SchemaDependency]
forall a. Semigroup a => a -> a -> a
<> [SchemaDependency]
permDeps)
    AVComputedField AnnComputedFieldBoolExp b (PartialSQLExp b)
computedFieldBoolExp ->
      let mkComputedFieldDep' :: DependencyReason -> SchemaDependency
mkComputedFieldDep' DependencyReason
r =
            forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName
-> TableName b
-> ComputedFieldName
-> SchemaDependency
mkComputedFieldDep @b DependencyReason
r SourceName
source TableName b
currTable (ComputedFieldName -> SchemaDependency)
-> ComputedFieldName -> SchemaDependency
forall a b. (a -> b) -> a -> b
$ AnnComputedFieldBoolExp b (PartialSQLExp b) -> ComputedFieldName
forall (backend :: BackendType) scalar.
AnnComputedFieldBoolExp backend scalar -> ComputedFieldName
_acfbName AnnComputedFieldBoolExp b (PartialSQLExp b)
computedFieldBoolExp
       in case AnnComputedFieldBoolExp b (PartialSQLExp b)
-> ComputedFieldBoolExp b (PartialSQLExp b)
forall (backend :: BackendType) scalar.
AnnComputedFieldBoolExp backend scalar
-> ComputedFieldBoolExp backend scalar
_acfbBoolExp AnnComputedFieldBoolExp b (PartialSQLExp b)
computedFieldBoolExp of
            CFBEScalar [OpExpG b (PartialSQLExp b)]
opExps ->
              let computedFieldDep :: SchemaDependency
computedFieldDep =
                    DependencyReason -> SchemaDependency
mkComputedFieldDep'
                      (DependencyReason -> SchemaDependency)
-> DependencyReason -> SchemaDependency
forall a b. (a -> b) -> a -> b
$ DependencyReason -> DependencyReason -> Bool -> DependencyReason
forall a. a -> a -> Bool -> a
bool DependencyReason
DRSessionVariable DependencyReason
DROnType
                      (Bool -> DependencyReason) -> Bool -> DependencyReason
forall a b. (a -> b) -> a -> b
$ (OpExpG b (PartialSQLExp b) -> Bool)
-> [OpExpG b (PartialSQLExp b)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any OpExpG b (PartialSQLExp b) -> Bool
forall (b :: BackendType).
Backend b =>
OpExpG b (PartialSQLExp b) -> Bool
hasStaticExp [OpExpG b (PartialSQLExp b)]
opExps
               in (SchemaDependency
computedFieldDep SchemaDependency -> [SchemaDependency] -> [SchemaDependency]
forall a. a -> [a] -> [a]
:) ([SchemaDependency] -> [SchemaDependency])
-> BoolExpM b [SchemaDependency] -> BoolExpM b [SchemaDependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OpExpG b (PartialSQLExp b)] -> BoolExpM b [SchemaDependency]
forall (b :: BackendType).
Backend b =>
[OpExpG b (PartialSQLExp b)] -> BoolExpM b [SchemaDependency]
getOpExpDeps [OpExpG b (PartialSQLExp b)]
opExps
            CFBETable TableName b
cfTable AnnBoolExp b (PartialSQLExp b)
cfTableBoolExp ->
              (DependencyReason -> SchemaDependency
mkComputedFieldDep' DependencyReason
DROnType SchemaDependency -> [SchemaDependency] -> [SchemaDependency]
forall a. a -> [a] -> [a]
:) ([SchemaDependency] -> [SchemaDependency])
-> BoolExpM b [SchemaDependency] -> BoolExpM b [SchemaDependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BoolExpCtx b -> BoolExpCtx b)
-> BoolExpM b [SchemaDependency] -> BoolExpM b [SchemaDependency]
forall a.
(BoolExpCtx b -> BoolExpCtx b) -> BoolExpM b a -> BoolExpM b a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\BoolExpCtx b
e -> BoolExpCtx b
e {currTable :: TableName b
currTable = TableName b
cfTable}) (AnnBoolExp b (PartialSQLExp b) -> BoolExpM b [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
AnnBoolExpPartialSQL b -> BoolExpM b [SchemaDependency]
getBoolExpDeps' AnnBoolExp b (PartialSQLExp b)
cfTableBoolExp)
    AVAggregationPredicates AggregationPredicates b (PartialSQLExp b)
aggPreds -> AggregationPredicates b (PartialSQLExp b)
-> BoolExpM b [SchemaDependency]
forall (b :: BackendType).
GetAggregationPredicatesDeps b =>
AggregationPredicates b (PartialSQLExp b)
-> BoolExpM b [SchemaDependency]
getAggregationPredicateDeps AggregationPredicates b (PartialSQLExp b)
aggPreds

getOpExpDeps ::
  forall b.
  (Backend b) =>
  [OpExpG b (PartialSQLExp b)] ->
  BoolExpM b [SchemaDependency]
getOpExpDeps :: forall (b :: BackendType).
Backend b =>
[OpExpG b (PartialSQLExp b)] -> BoolExpM b [SchemaDependency]
getOpExpDeps [OpExpG b (PartialSQLExp b)]
opExps = do
  BoolExpCtx {SourceName
source :: forall (b :: BackendType). BoolExpCtx b -> SourceName
source :: SourceName
source, TableName b
rootTable :: forall (b :: BackendType). BoolExpCtx b -> TableName b
rootTable :: TableName b
rootTable, TableName b
currTable :: forall (b :: BackendType). BoolExpCtx b -> TableName b
currTable :: TableName b
currTable} <- BoolExpM b (BoolExpCtx b)
forall r (m :: * -> *). MonadReader r m => m r
ask
  [SchemaDependency] -> BoolExpM b [SchemaDependency]
forall a. a -> BoolExpM b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([SchemaDependency] -> BoolExpM b [SchemaDependency])
-> [SchemaDependency] -> BoolExpM b [SchemaDependency]
forall a b. (a -> b) -> a -> b
$ do
    RootOrCurrentColumn RootOrCurrent
rootOrCol Column b
col <- (OpExpG b (PartialSQLExp b) -> Maybe (RootOrCurrentColumn b))
-> [OpExpG b (PartialSQLExp b)] -> [RootOrCurrentColumn b]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe OpExpG b (PartialSQLExp b) -> Maybe (RootOrCurrentColumn b)
forall (backend :: BackendType) field.
OpExpG backend field -> Maybe (RootOrCurrentColumn backend)
opExpDepCol [OpExpG b (PartialSQLExp b)]
opExps
    let table :: TableName b
table = case RootOrCurrent
rootOrCol of
          RootOrCurrent
IsRoot -> TableName b
rootTable
          RootOrCurrent
IsCurrent -> TableName b
currTable
    SchemaDependency -> [SchemaDependency]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SchemaDependency -> [SchemaDependency])
-> SchemaDependency -> [SchemaDependency]
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName -> TableName b -> Column b -> SchemaDependency
mkColDep @b DependencyReason
DROnType SourceName
source TableName b
table Column b
col

-- | What dependencies does this row permission for a logical model have? This
-- is really a utility function for the tree of dependency traversals under
-- 'getLogicalModelBoolExpDeps', specifically focusing on boolean operators.
getLogicalModelOpExpDeps ::
  forall b.
  (Backend b) =>
  SourceName ->
  LogicalModelName ->
  [OpExpG b (PartialSQLExp b)] ->
  [SchemaDependency]
getLogicalModelOpExpDeps :: forall (b :: BackendType).
Backend b =>
SourceName
-> LogicalModelName
-> [OpExpG b (PartialSQLExp b)]
-> [SchemaDependency]
getLogicalModelOpExpDeps SourceName
source LogicalModelName
logicalModelName [OpExpG b (PartialSQLExp b)]
operatorExpressions = do
  RootOrCurrentColumn RootOrCurrent
_ Column b
column <- (OpExpG b (PartialSQLExp b) -> Maybe (RootOrCurrentColumn b))
-> [OpExpG b (PartialSQLExp b)] -> [RootOrCurrentColumn b]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe OpExpG b (PartialSQLExp b) -> Maybe (RootOrCurrentColumn b)
forall (backend :: BackendType) field.
OpExpG backend field -> Maybe (RootOrCurrentColumn backend)
opExpDepCol [OpExpG b (PartialSQLExp b)]
operatorExpressions
  SchemaDependency -> [SchemaDependency]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (b :: BackendType).
Backend b =>
DependencyReason
-> SourceName -> LogicalModelName -> Column b -> SchemaDependency
mkLogicalModelColDep @b DependencyReason
DROnType SourceName
source LogicalModelName
logicalModelName Column b
column)

-- | Asking for a table's fields info without explicit @'SourceName' argument.
-- The source name is implicitly inferred from @'SourceM' via @'TableCoreInfoRM'.
askFieldInfoMapSource ::
  (QErrM m, Backend b, TableCoreInfoRM b m) =>
  TableName b ->
  m (FieldInfoMap (FieldInfo b))
askFieldInfoMapSource :: forall (m :: * -> *) (b :: BackendType).
(QErrM m, Backend b, TableCoreInfoRM b m) =>
TableName b -> m (FieldInfoMap (FieldInfo b))
askFieldInfoMapSource TableName b
tableName = do
  (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
 -> FieldInfoMap (FieldInfo b))
-> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> m (FieldInfoMap (FieldInfo b))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> FieldInfoMap (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap
    (m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
 -> m (FieldInfoMap (FieldInfo b)))
-> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> m (FieldInfoMap (FieldInfo b))
forall a b. (a -> b) -> a -> b
$ m (Maybe (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)))
-> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a -> m a
onNothingM (TableName b
-> m (Maybe (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)))
forall (b :: BackendType) (m :: * -> *).
TableCoreInfoRM b m =>
TableName b -> m (Maybe (TableCoreInfo b))
lookupTableCoreInfo TableName b
tableName)
    (m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
 -> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)))
-> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
    (Text -> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)))
-> Text -> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
forall a b. (a -> b) -> a -> b
$ Text
"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
" does not exist"