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

-- | Types and functions used in the process of building the schema cache from metadata information
-- stored in the @hdb_catalog@ schema in Postgres.
module Hasura.RQL.Types.SchemaCache.Build
  ( MetadataDependency (..),
    recordInconsistencies,
    recordInconsistencyM,
    recordInconsistenciesM,
    recordDependencies,
    recordDependenciesM,
    withRecordInconsistency,
    withRecordInconsistencyM,
    withRecordInconsistencies,
    CacheRWM (..),
    buildSchemaCacheWithOptions,
    BuildReason (..),
    CacheInvalidations (..),
    ValidateNewSchemaCache,
    ValidateNewSchemaCacheResult (..),
    MetadataM (..),
    MetadataT (..),
    runMetadataT,
    buildSchemaCacheWithInvalidations,
    buildSchemaCache,
    tryBuildSchemaCache,
    tryBuildSchemaCacheWithModifiers,
    tryBuildSchemaCacheAndWarnOnFailingObjects,
    buildSchemaCacheFor,
    throwOnInconsistencies,
    withNewInconsistentObjsCheck,
    getInconsistentQueryCollections,
    StoredIntrospection (..),
    StoredIntrospectionItem (..),
    CollectItem (..),
  )
where

import Control.Arrow.Extended
import Control.Monad.Morph
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson (FromJSON (..), ToJSON (..), Value, genericParseJSON, genericToEncoding, genericToJSON)
import Data.HashMap.Strict.Extended qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.HashMap.Strict.Multi qualified as MultiMap
import Data.List qualified as L
import Data.List.Extended qualified as L
import Data.Sequence qualified as Seq
import Data.Text.Extended
import Data.Text.NonEmpty (unNonEmptyText)
import Data.Trie qualified as Trie
import Database.PG.Query qualified as PG
import Hasura.Backends.DataConnector.Adapter.Types (DataConnectorName)
import Hasura.Backends.Postgres.Connection
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.Analyse
import Hasura.GraphQL.Transport.HTTP.Protocol
import Hasura.Prelude
import Hasura.QueryTags
import Hasura.RQL.DDL.Warnings
import Hasura.RQL.Types.Allowlist (NormalizedQuery, unNormalizedQuery)
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Endpoint
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Session
import Hasura.RemoteSchema.Metadata (RemoteSchemaName)
import Hasura.Server.Init.FeatureFlag (HasFeatureFlagChecker)
import Hasura.Server.Types (MonadGetPolicies (..))
import Hasura.Services.Network
import Hasura.Tracing (TraceT)
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Syntax qualified as G

-- * Inconsistencies

recordInconsistencies ::
  (ArrowWriter (Seq CollectItem) arr, Functor f, Foldable f) => ((Maybe Value, f MetadataObject), Text) `arr` ()
recordInconsistencies :: forall (arr :: * -> * -> *) (f :: * -> *).
(ArrowWriter (Seq CollectItem) arr, Functor f, Foldable f) =>
arr ((Maybe Value, f MetadataObject), Text) ()
recordInconsistencies = proc ((Maybe Value
val, f MetadataObject
mo), Text
reason) ->
  arr (Seq CollectItem) ()
forall w (arr :: * -> * -> *). ArrowWriter w arr => arr w ()
tellA -< [CollectItem] -> Seq CollectItem
forall a. [a] -> Seq a
Seq.fromList ([CollectItem] -> Seq CollectItem)
-> [CollectItem] -> Seq CollectItem
forall a b. (a -> b) -> a -> b
$ f CollectItem -> [CollectItem]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (f CollectItem -> [CollectItem]) -> f CollectItem -> [CollectItem]
forall a b. (a -> b) -> a -> b
$ (MetadataObject -> CollectItem)
-> f MetadataObject -> f CollectItem
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (InconsistentMetadata -> CollectItem
CollectInconsistentMetadata (InconsistentMetadata -> CollectItem)
-> (MetadataObject -> InconsistentMetadata)
-> MetadataObject
-> CollectItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Value -> MetadataObject -> InconsistentMetadata
InconsistentObject Text
reason Maybe Value
val) f MetadataObject
mo

recordInconsistencyM ::
  (MonadWriter (Seq CollectItem) m) => Maybe Value -> MetadataObject -> Text -> m ()
recordInconsistencyM :: forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
Maybe Value -> MetadataObject -> Text -> m ()
recordInconsistencyM Maybe Value
val MetadataObject
mo Text
reason = [(Maybe Value, MetadataObject)] -> Text -> m ()
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
[(Maybe Value, MetadataObject)] -> Text -> m ()
recordInconsistenciesM' [(Maybe Value
val, MetadataObject
mo)] Text
reason

recordInconsistenciesM ::
  (MonadWriter (Seq CollectItem) m) => [MetadataObject] -> Text -> m ()
recordInconsistenciesM :: forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
[MetadataObject] -> Text -> m ()
recordInconsistenciesM [MetadataObject]
metadataObjects Text
reason = [(Maybe Value, MetadataObject)] -> Text -> m ()
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
[(Maybe Value, MetadataObject)] -> Text -> m ()
recordInconsistenciesM' ((Maybe Value
forall a. Maybe a
Nothing,) (MetadataObject -> (Maybe Value, MetadataObject))
-> [MetadataObject] -> [(Maybe Value, MetadataObject)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MetadataObject]
metadataObjects) Text
reason

recordInconsistenciesM' ::
  (MonadWriter (Seq CollectItem) m) => [(Maybe Value, MetadataObject)] -> Text -> m ()
recordInconsistenciesM' :: forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
[(Maybe Value, MetadataObject)] -> Text -> m ()
recordInconsistenciesM' [(Maybe Value, MetadataObject)]
metadataObjects Text
reason =
  Seq CollectItem -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Seq CollectItem -> m ()) -> Seq CollectItem -> m ()
forall a b. (a -> b) -> a -> b
$ [CollectItem] -> Seq CollectItem
forall a. [a] -> Seq a
Seq.fromList ([CollectItem] -> Seq CollectItem)
-> [CollectItem] -> Seq CollectItem
forall a b. (a -> b) -> a -> b
$ ((Maybe Value, MetadataObject) -> CollectItem)
-> [(Maybe Value, MetadataObject)] -> [CollectItem]
forall a b. (a -> b) -> [a] -> [b]
map (InconsistentMetadata -> CollectItem
CollectInconsistentMetadata (InconsistentMetadata -> CollectItem)
-> ((Maybe Value, MetadataObject) -> InconsistentMetadata)
-> (Maybe Value, MetadataObject)
-> CollectItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Value -> MetadataObject -> InconsistentMetadata)
-> (Maybe Value, MetadataObject) -> InconsistentMetadata
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Text -> Maybe Value -> MetadataObject -> InconsistentMetadata
InconsistentObject Text
reason)) [(Maybe Value, MetadataObject)]
metadataObjects

-- * Dependencies

data MetadataDependency
  = MetadataDependency
      -- | for error reporting on missing dependencies
      MetadataObject
      SchemaObjId
      SchemaDependency
  deriving (MetadataDependency -> MetadataDependency -> Bool
(MetadataDependency -> MetadataDependency -> Bool)
-> (MetadataDependency -> MetadataDependency -> Bool)
-> Eq MetadataDependency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetadataDependency -> MetadataDependency -> Bool
== :: MetadataDependency -> MetadataDependency -> Bool
$c/= :: MetadataDependency -> MetadataDependency -> Bool
/= :: MetadataDependency -> MetadataDependency -> Bool
Eq, Int -> MetadataDependency -> ShowS
[MetadataDependency] -> ShowS
MetadataDependency -> String
(Int -> MetadataDependency -> ShowS)
-> (MetadataDependency -> String)
-> ([MetadataDependency] -> ShowS)
-> Show MetadataDependency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetadataDependency -> ShowS
showsPrec :: Int -> MetadataDependency -> ShowS
$cshow :: MetadataDependency -> String
show :: MetadataDependency -> String
$cshowList :: [MetadataDependency] -> ShowS
showList :: [MetadataDependency] -> ShowS
Show)

recordDependencies ::
  (ArrowWriter (Seq CollectItem) arr) =>
  (MetadataObject, SchemaObjId, Seq SchemaDependency) `arr` ()
recordDependencies :: forall (arr :: * -> * -> *).
ArrowWriter (Seq CollectItem) arr =>
arr (MetadataObject, SchemaObjId, Seq SchemaDependency) ()
recordDependencies = proc (MetadataObject
metadataObject, SchemaObjId
schemaObjectId, Seq SchemaDependency
dependencies) ->
  arr (Seq CollectItem) ()
forall w (arr :: * -> * -> *). ArrowWriter w arr => arr w ()
tellA -< MetadataDependency -> CollectItem
CollectMetadataDependency (MetadataDependency -> CollectItem)
-> (SchemaDependency -> MetadataDependency)
-> SchemaDependency
-> CollectItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataObject
-> SchemaObjId -> SchemaDependency -> MetadataDependency
MetadataDependency MetadataObject
metadataObject SchemaObjId
schemaObjectId (SchemaDependency -> CollectItem)
-> Seq SchemaDependency -> Seq CollectItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq SchemaDependency
dependencies

recordDependenciesM ::
  (MonadWriter (Seq CollectItem) m) =>
  MetadataObject ->
  SchemaObjId ->
  Seq SchemaDependency ->
  m ()
recordDependenciesM :: forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
MetadataObject -> SchemaObjId -> Seq SchemaDependency -> m ()
recordDependenciesM MetadataObject
metadataObject SchemaObjId
schemaObjectId Seq SchemaDependency
dependencies = do
  Seq CollectItem -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Seq CollectItem -> m ()) -> Seq CollectItem -> m ()
forall a b. (a -> b) -> a -> b
$ MetadataDependency -> CollectItem
CollectMetadataDependency (MetadataDependency -> CollectItem)
-> (SchemaDependency -> MetadataDependency)
-> SchemaDependency
-> CollectItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataObject
-> SchemaObjId -> SchemaDependency -> MetadataDependency
MetadataDependency MetadataObject
metadataObject SchemaObjId
schemaObjectId (SchemaDependency -> CollectItem)
-> Seq SchemaDependency -> Seq CollectItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq SchemaDependency
dependencies

-- * Helpers

-- | Monadic version of 'withRecordInconsistency'
withRecordInconsistencyM ::
  (MonadWriter (Seq CollectItem) m) =>
  MetadataObject ->
  ExceptT QErr m a ->
  m (Maybe a)
withRecordInconsistencyM :: forall (m :: * -> *) a.
MonadWriter (Seq CollectItem) m =>
MetadataObject -> ExceptT QErr m a -> m (Maybe a)
withRecordInconsistencyM MetadataObject
metadataObject ExceptT QErr m a
f = do
  Either QErr a
result <- ExceptT QErr m a -> m (Either QErr a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT QErr m a
f
  case Either QErr a
result of
    Left QErr
err -> do
      case QErr -> Maybe QErrExtra
qeInternal QErr
err of
        Just (ExtraExtensions Value
exts) ->
          -- the QErr type contains an optional qeInternal :: Maybe QErrExtra field, which either stores an error coming
          -- from an action webhook (ExtraExtensions) or an internal error thrown somewhere within graphql-engine.
          --
          -- if we do have an error here, it should be an internal error and hence never be of the former case:
          Maybe Value -> MetadataObject -> Text -> m ()
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
Maybe Value -> MetadataObject -> Text -> m ()
recordInconsistencyM (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
exts)) MetadataObject
metadataObject Text
"withRecordInconsistency: unexpected ExtraExtensions"
        Just (ExtraInternal Value
internal) ->
          Maybe Value -> MetadataObject -> Text -> m ()
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
Maybe Value -> MetadataObject -> Text -> m ()
recordInconsistencyM (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
internal)) MetadataObject
metadataObject (QErr -> Text
qeError QErr
err)
        Maybe QErrExtra
Nothing ->
          Maybe Value -> MetadataObject -> Text -> m ()
forall (m :: * -> *).
MonadWriter (Seq CollectItem) m =>
Maybe Value -> MetadataObject -> Text -> m ()
recordInconsistencyM Maybe Value
forall a. Maybe a
Nothing MetadataObject
metadataObject (QErr -> Text
qeError QErr
err)
      Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Right a
v -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
v

recordInconsistenciesWith ::
  (ArrowChoice arr, ArrowWriter (Seq CollectItem) arr) =>
  ((ArrowWriter (Seq CollectItem) arr) => ((Maybe Value, mo), Text) `arr` ()) ->
  ErrorA QErr arr (e, s) a ->
  arr (e, (mo, s)) (Maybe a)
recordInconsistenciesWith :: forall (arr :: * -> * -> *) mo e s a.
(ArrowChoice arr, ArrowWriter (Seq CollectItem) arr) =>
(ArrowWriter (Seq CollectItem) arr =>
 arr ((Maybe Value, mo), Text) ())
-> ErrorA QErr arr (e, s) a -> arr (e, (mo, s)) (Maybe a)
recordInconsistenciesWith ArrowWriter (Seq CollectItem) arr =>
arr ((Maybe Value, mo), Text) ()
recordInconsistency' ErrorA QErr arr (e, s) a
f = proc (e
e, (mo
metadataObject, s
s)) -> do
  Either QErr a
result <- ErrorA QErr arr (e, s) a -> arr (e, s) (Either QErr a)
forall {k} e (arr :: k -> * -> *) (a :: k) b.
ErrorA e arr a b -> arr a (Either e b)
runErrorA ErrorA QErr arr (e, s) a
f -< (e
e, s
s)
  case Either QErr a
result of
    Left QErr
err -> do
      case QErr -> Maybe QErrExtra
qeInternal QErr
err of
        Just (ExtraExtensions Value
exts) ->
          -- the QErr type contains an optional qeInternal :: Maybe QErrExtra field, which either stores an error coming
          -- from an action webhook (ExtraExtensions) or an internal error thrown somewhere within graphql-engine.
          --
          -- if we do have an error here, it should be an internal error and hence never be of the former case:
          arr ((Maybe Value, mo), Text) ()
ArrowWriter (Seq CollectItem) arr =>
arr ((Maybe Value, mo), Text) ()
recordInconsistency' -< ((Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
exts), mo
metadataObject), Text
"withRecordInconsistency: unexpected ExtraExtensions")
        Just (ExtraInternal Value
internal) ->
          arr ((Maybe Value, mo), Text) ()
ArrowWriter (Seq CollectItem) arr =>
arr ((Maybe Value, mo), Text) ()
recordInconsistency' -< ((Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
internal), mo
metadataObject), QErr -> Text
qeError QErr
err)
        Maybe QErrExtra
Nothing ->
          arr ((Maybe Value, mo), Text) ()
ArrowWriter (Seq CollectItem) arr =>
arr ((Maybe Value, mo), Text) ()
recordInconsistency' -< ((Maybe Value
forall a. Maybe a
Nothing, mo
metadataObject), QErr -> Text
qeError QErr
err)
      arr (Maybe a) (Maybe a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< Maybe a
forall a. Maybe a
Nothing
    Right a
v -> arr (Maybe a) (Maybe a)
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< a -> Maybe a
forall a. a -> Maybe a
Just a
v
{-# INLINEABLE recordInconsistenciesWith #-}

-- | Record any errors resulting from a computation as inconsistencies
withRecordInconsistency ::
  (ArrowChoice arr, ArrowWriter (Seq CollectItem) arr) =>
  ErrorA QErr arr (e, s) a ->
  arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency :: forall (arr :: * -> * -> *) e s a.
(ArrowChoice arr, ArrowWriter (Seq CollectItem) arr) =>
ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency ErrorA QErr arr (e, s) a
err = proc (e
e, (MetadataObject
mo, s
s)) ->
  (ArrowWriter (Seq CollectItem) arr =>
 arr ((Maybe Value, Identity MetadataObject), Text) ())
-> ErrorA QErr arr (e, s) a
-> arr (e, (Identity MetadataObject, s)) (Maybe a)
forall (arr :: * -> * -> *) mo e s a.
(ArrowChoice arr, ArrowWriter (Seq CollectItem) arr) =>
(ArrowWriter (Seq CollectItem) arr =>
 arr ((Maybe Value, mo), Text) ())
-> ErrorA QErr arr (e, s) a -> arr (e, (mo, s)) (Maybe a)
recordInconsistenciesWith arr ((Maybe Value, Identity MetadataObject), Text) ()
ArrowWriter (Seq CollectItem) arr =>
arr ((Maybe Value, Identity MetadataObject), Text) ()
forall (arr :: * -> * -> *) (f :: * -> *).
(ArrowWriter (Seq CollectItem) arr, Functor f, Foldable f) =>
arr ((Maybe Value, f MetadataObject), Text) ()
recordInconsistencies ErrorA QErr arr (e, s) a
err -< (e
e, ((MetadataObject -> Identity MetadataObject
forall a. a -> Identity a
Identity MetadataObject
mo), s
s))
{-# INLINEABLE withRecordInconsistency #-}

withRecordInconsistencies ::
  (ArrowChoice arr, ArrowWriter (Seq CollectItem) arr) =>
  ErrorA QErr arr (e, s) a ->
  arr (e, ([MetadataObject], s)) (Maybe a)
withRecordInconsistencies :: forall (arr :: * -> * -> *) e s a.
(ArrowChoice arr, ArrowWriter (Seq CollectItem) arr) =>
ErrorA QErr arr (e, s) a
-> arr (e, ([MetadataObject], s)) (Maybe a)
withRecordInconsistencies = (ArrowWriter (Seq CollectItem) arr =>
 arr ((Maybe Value, [MetadataObject]), Text) ())
-> ErrorA QErr arr (e, s) a
-> arr (e, ([MetadataObject], s)) (Maybe a)
forall (arr :: * -> * -> *) mo e s a.
(ArrowChoice arr, ArrowWriter (Seq CollectItem) arr) =>
(ArrowWriter (Seq CollectItem) arr =>
 arr ((Maybe Value, mo), Text) ())
-> ErrorA QErr arr (e, s) a -> arr (e, (mo, s)) (Maybe a)
recordInconsistenciesWith arr ((Maybe Value, [MetadataObject]), Text) ()
ArrowWriter (Seq CollectItem) arr =>
arr ((Maybe Value, [MetadataObject]), Text) ()
forall (arr :: * -> * -> *) (f :: * -> *).
(ArrowWriter (Seq CollectItem) arr, Functor f, Foldable f) =>
arr ((Maybe Value, f MetadataObject), Text) ()
recordInconsistencies
{-# INLINEABLE withRecordInconsistencies #-}

-- ----------------------------------------------------------------------------
-- operations for triggering a schema cache rebuild

class (CacheRM m) => CacheRWM m where
  tryBuildSchemaCacheWithOptions :: BuildReason -> CacheInvalidations -> Metadata -> Maybe MetadataResourceVersion -> ValidateNewSchemaCache a -> m a
  setMetadataResourceVersionInSchemaCache :: MetadataResourceVersion -> m ()

buildSchemaCacheWithOptions :: (CacheRWM m) => BuildReason -> CacheInvalidations -> Metadata -> Maybe MetadataResourceVersion -> m ()
buildSchemaCacheWithOptions :: forall (m :: * -> *).
CacheRWM m =>
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> m ()
buildSchemaCacheWithOptions BuildReason
buildReason CacheInvalidations
cacheInvalidation Metadata
metadata Maybe MetadataResourceVersion
metadataResourceVersion =
  BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache ()
-> m ()
forall a.
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> m a
forall (m :: * -> *) a.
CacheRWM m =>
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> m a
tryBuildSchemaCacheWithOptions BuildReason
buildReason CacheInvalidations
cacheInvalidation Metadata
metadata Maybe MetadataResourceVersion
metadataResourceVersion (\SchemaCache
_ SchemaCache
_ -> (ValidateNewSchemaCacheResult
KeepNewSchemaCache, ()))

data BuildReason
  = -- | The build was triggered by an update this instance made to the catalog (in the
    -- currently-active transaction), so information in Postgres that needs to be kept in sync with
    -- the catalog (i.e. table event triggers in @hdb_catalog@ schema) should be updated.
    CatalogUpdate (Maybe (HashSet SourceName))
  | -- | The build was triggered by a notification that some other currently-running Hasura instance
    -- updated the catalog. Since that instance already updated table event triggers in @hdb_catalog@,
    -- this build should be read-only.
    CatalogSync
  deriving (BuildReason -> BuildReason -> Bool
(BuildReason -> BuildReason -> Bool)
-> (BuildReason -> BuildReason -> Bool) -> Eq BuildReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildReason -> BuildReason -> Bool
== :: BuildReason -> BuildReason -> Bool
$c/= :: BuildReason -> BuildReason -> Bool
/= :: BuildReason -> BuildReason -> Bool
Eq, Int -> BuildReason -> ShowS
[BuildReason] -> ShowS
BuildReason -> String
(Int -> BuildReason -> ShowS)
-> (BuildReason -> String)
-> ([BuildReason] -> ShowS)
-> Show BuildReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildReason -> ShowS
showsPrec :: Int -> BuildReason -> ShowS
$cshow :: BuildReason -> String
show :: BuildReason -> String
$cshowList :: [BuildReason] -> ShowS
showList :: [BuildReason] -> ShowS
Show)

data CacheInvalidations = CacheInvalidations
  { -- | Force reloading of all database information, including information not technically stored in
    -- metadata (currently just enum values). Set by the @reload_metadata@ API.
    CacheInvalidations -> Bool
ciMetadata :: Bool,
    -- | Force refetching of the given remote schemas, even if their definition has not changed. Set
    -- by the @reload_remote_schema@ API.
    CacheInvalidations -> HashSet RemoteSchemaName
ciRemoteSchemas :: HashSet RemoteSchemaName,
    -- | Force re-establishing connections of the given data sources, even if their configuration has not changed. Set
    -- by the @pg_reload_source@ API.
    CacheInvalidations -> HashSet SourceName
ciSources :: HashSet SourceName,
    -- | Force re-fetching of `DataConnectorInfo` from the named data connectors.
    CacheInvalidations -> HashSet DataConnectorName
ciDataConnectors :: HashSet DataConnectorName
  }
  deriving stock ((forall x. CacheInvalidations -> Rep CacheInvalidations x)
-> (forall x. Rep CacheInvalidations x -> CacheInvalidations)
-> Generic CacheInvalidations
forall x. Rep CacheInvalidations x -> CacheInvalidations
forall x. CacheInvalidations -> Rep CacheInvalidations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CacheInvalidations -> Rep CacheInvalidations x
from :: forall x. CacheInvalidations -> Rep CacheInvalidations x
$cto :: forall x. Rep CacheInvalidations x -> CacheInvalidations
to :: forall x. Rep CacheInvalidations x -> CacheInvalidations
Generic)

instance FromJSON CacheInvalidations where
  parseJSON :: Value -> Parser CacheInvalidations
parseJSON = Options -> Value -> Parser CacheInvalidations
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

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

instance Semigroup CacheInvalidations where
  CacheInvalidations Bool
a1 HashSet RemoteSchemaName
b1 HashSet SourceName
c1 HashSet DataConnectorName
d1 <> :: CacheInvalidations -> CacheInvalidations -> CacheInvalidations
<> CacheInvalidations Bool
a2 HashSet RemoteSchemaName
b2 HashSet SourceName
c2 HashSet DataConnectorName
d2 =
    Bool
-> HashSet RemoteSchemaName
-> HashSet SourceName
-> HashSet DataConnectorName
-> CacheInvalidations
CacheInvalidations (Bool
a1 Bool -> Bool -> Bool
|| Bool
a2) (HashSet RemoteSchemaName
b1 HashSet RemoteSchemaName
-> HashSet RemoteSchemaName -> HashSet RemoteSchemaName
forall a. Semigroup a => a -> a -> a
<> HashSet RemoteSchemaName
b2) (HashSet SourceName
c1 HashSet SourceName -> HashSet SourceName -> HashSet SourceName
forall a. Semigroup a => a -> a -> a
<> HashSet SourceName
c2) (HashSet DataConnectorName
d1 HashSet DataConnectorName
-> HashSet DataConnectorName -> HashSet DataConnectorName
forall a. Semigroup a => a -> a -> a
<> HashSet DataConnectorName
d2)

instance Monoid CacheInvalidations where
  mempty :: CacheInvalidations
mempty = Bool
-> HashSet RemoteSchemaName
-> HashSet SourceName
-> HashSet DataConnectorName
-> CacheInvalidations
CacheInvalidations Bool
False HashSet RemoteSchemaName
forall a. Monoid a => a
mempty HashSet SourceName
forall a. Monoid a => a
mempty HashSet DataConnectorName
forall a. Monoid a => a
mempty

-- | Function that validates the new schema cache (usually involves checking for any metadata inconsistencies)
-- and can decide whether or not to keep or discard the new schema cache ('ValidateNewSchemaCacheResult'). It
-- can also return some arbitrary extra information that will be returned from 'tryBuildSchemaCacheWithOptions'.
--
-- First parameter is the old schema cache, the second is the new schema cache.
type ValidateNewSchemaCache a = SchemaCache -> SchemaCache -> (ValidateNewSchemaCacheResult, a)

data ValidateNewSchemaCacheResult
  = KeepNewSchemaCache
  | DiscardNewSchemaCache
  deriving stock (ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Bool
(ValidateNewSchemaCacheResult
 -> ValidateNewSchemaCacheResult -> Bool)
-> (ValidateNewSchemaCacheResult
    -> ValidateNewSchemaCacheResult -> Bool)
-> Eq ValidateNewSchemaCacheResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Bool
== :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Bool
$c/= :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Bool
/= :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Bool
Eq, Int -> ValidateNewSchemaCacheResult -> ShowS
[ValidateNewSchemaCacheResult] -> ShowS
ValidateNewSchemaCacheResult -> String
(Int -> ValidateNewSchemaCacheResult -> ShowS)
-> (ValidateNewSchemaCacheResult -> String)
-> ([ValidateNewSchemaCacheResult] -> ShowS)
-> Show ValidateNewSchemaCacheResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidateNewSchemaCacheResult -> ShowS
showsPrec :: Int -> ValidateNewSchemaCacheResult -> ShowS
$cshow :: ValidateNewSchemaCacheResult -> String
show :: ValidateNewSchemaCacheResult -> String
$cshowList :: [ValidateNewSchemaCacheResult] -> ShowS
showList :: [ValidateNewSchemaCacheResult] -> ShowS
Show, Eq ValidateNewSchemaCacheResult
Eq ValidateNewSchemaCacheResult
-> (ValidateNewSchemaCacheResult
    -> ValidateNewSchemaCacheResult -> Ordering)
-> (ValidateNewSchemaCacheResult
    -> ValidateNewSchemaCacheResult -> Bool)
-> (ValidateNewSchemaCacheResult
    -> ValidateNewSchemaCacheResult -> Bool)
-> (ValidateNewSchemaCacheResult
    -> ValidateNewSchemaCacheResult -> Bool)
-> (ValidateNewSchemaCacheResult
    -> ValidateNewSchemaCacheResult -> Bool)
-> (ValidateNewSchemaCacheResult
    -> ValidateNewSchemaCacheResult -> ValidateNewSchemaCacheResult)
-> (ValidateNewSchemaCacheResult
    -> ValidateNewSchemaCacheResult -> ValidateNewSchemaCacheResult)
-> Ord ValidateNewSchemaCacheResult
ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Bool
ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Ordering
ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> ValidateNewSchemaCacheResult
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Ordering
compare :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Ordering
$c< :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Bool
< :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Bool
$c<= :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Bool
<= :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Bool
$c> :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Bool
> :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Bool
$c>= :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Bool
>= :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> Bool
$cmax :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> ValidateNewSchemaCacheResult
max :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> ValidateNewSchemaCacheResult
$cmin :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> ValidateNewSchemaCacheResult
min :: ValidateNewSchemaCacheResult
-> ValidateNewSchemaCacheResult -> ValidateNewSchemaCacheResult
Ord)

instance (CacheRWM m) => CacheRWM (ReaderT r m) where
  tryBuildSchemaCacheWithOptions :: forall a.
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> ReaderT r m a
tryBuildSchemaCacheWithOptions BuildReason
a CacheInvalidations
b Metadata
c Maybe MetadataResourceVersion
d ValidateNewSchemaCache a
e = m a -> ReaderT r m a
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 a -> ReaderT r m a) -> m a -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> m a
forall a.
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> m a
forall (m :: * -> *) a.
CacheRWM m =>
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> m a
tryBuildSchemaCacheWithOptions BuildReason
a CacheInvalidations
b Metadata
c Maybe MetadataResourceVersion
d ValidateNewSchemaCache a
e
  setMetadataResourceVersionInSchemaCache :: MetadataResourceVersion -> ReaderT r m ()
setMetadataResourceVersionInSchemaCache = m () -> ReaderT r m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ())
-> (MetadataResourceVersion -> m ())
-> MetadataResourceVersion
-> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataResourceVersion -> m ()
forall (m :: * -> *). CacheRWM m => MetadataResourceVersion -> m ()
setMetadataResourceVersionInSchemaCache

instance (CacheRWM m) => CacheRWM (StateT s m) where
  tryBuildSchemaCacheWithOptions :: forall a.
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> StateT s m a
tryBuildSchemaCacheWithOptions BuildReason
a CacheInvalidations
b Metadata
c Maybe MetadataResourceVersion
d ValidateNewSchemaCache a
e = m a -> StateT s m a
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 a -> StateT s m a) -> m a -> StateT s m a
forall a b. (a -> b) -> a -> b
$ BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> m a
forall a.
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> m a
forall (m :: * -> *) a.
CacheRWM m =>
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> m a
tryBuildSchemaCacheWithOptions BuildReason
a CacheInvalidations
b Metadata
c Maybe MetadataResourceVersion
d ValidateNewSchemaCache a
e
  setMetadataResourceVersionInSchemaCache :: MetadataResourceVersion -> StateT s m ()
setMetadataResourceVersionInSchemaCache = m () -> StateT s m ()
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 () -> StateT s m ())
-> (MetadataResourceVersion -> m ())
-> MetadataResourceVersion
-> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataResourceVersion -> m ()
forall (m :: * -> *). CacheRWM m => MetadataResourceVersion -> m ()
setMetadataResourceVersionInSchemaCache

instance (CacheRWM m) => CacheRWM (TraceT m) where
  tryBuildSchemaCacheWithOptions :: forall a.
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> TraceT m a
tryBuildSchemaCacheWithOptions BuildReason
a CacheInvalidations
b Metadata
c Maybe MetadataResourceVersion
d ValidateNewSchemaCache a
e = m a -> TraceT m a
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 a -> TraceT m a) -> m a -> TraceT m a
forall a b. (a -> b) -> a -> b
$ BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> m a
forall a.
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> m a
forall (m :: * -> *) a.
CacheRWM m =>
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> m a
tryBuildSchemaCacheWithOptions BuildReason
a CacheInvalidations
b Metadata
c Maybe MetadataResourceVersion
d ValidateNewSchemaCache a
e
  setMetadataResourceVersionInSchemaCache :: MetadataResourceVersion -> TraceT m ()
setMetadataResourceVersionInSchemaCache = m () -> TraceT m ()
forall (m :: * -> *) a. Monad m => m a -> TraceT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> TraceT m ())
-> (MetadataResourceVersion -> m ())
-> MetadataResourceVersion
-> TraceT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataResourceVersion -> m ()
forall (m :: * -> *). CacheRWM m => MetadataResourceVersion -> m ()
setMetadataResourceVersionInSchemaCache

instance (CacheRWM m) => CacheRWM (PG.TxET QErr m) where
  tryBuildSchemaCacheWithOptions :: forall a.
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> TxET QErr m a
tryBuildSchemaCacheWithOptions BuildReason
a CacheInvalidations
b Metadata
c Maybe MetadataResourceVersion
d ValidateNewSchemaCache a
e = m a -> TxET QErr m a
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 a -> TxET QErr m a) -> m a -> TxET QErr m a
forall a b. (a -> b) -> a -> b
$ BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> m a
forall a.
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> m a
forall (m :: * -> *) a.
CacheRWM m =>
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> m a
tryBuildSchemaCacheWithOptions BuildReason
a CacheInvalidations
b Metadata
c Maybe MetadataResourceVersion
d ValidateNewSchemaCache a
e
  setMetadataResourceVersionInSchemaCache :: MetadataResourceVersion -> TxET QErr m ()
setMetadataResourceVersionInSchemaCache = m () -> TxET QErr m ()
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 () -> TxET QErr m ())
-> (MetadataResourceVersion -> m ())
-> MetadataResourceVersion
-> TxET QErr m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataResourceVersion -> m ()
forall (m :: * -> *). CacheRWM m => MetadataResourceVersion -> m ()
setMetadataResourceVersionInSchemaCache

newtype MetadataT m a = MetadataT {forall (m :: * -> *) a. MetadataT m a -> StateT Metadata m a
unMetadataT :: StateT Metadata m a}
  deriving newtype
    ( (forall a b. (a -> b) -> MetadataT m a -> MetadataT m b)
-> (forall a b. a -> MetadataT m b -> MetadataT m a)
-> Functor (MetadataT m)
forall a b. a -> MetadataT m b -> MetadataT m a
forall a b. (a -> b) -> MetadataT m a -> MetadataT m b
forall (m :: * -> *) a b.
Functor m =>
a -> MetadataT m b -> MetadataT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MetadataT m a -> MetadataT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MetadataT m a -> MetadataT m b
fmap :: forall a b. (a -> b) -> MetadataT m a -> MetadataT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> MetadataT m b -> MetadataT m a
<$ :: forall a b. a -> MetadataT m b -> MetadataT m a
Functor,
      Functor (MetadataT m)
Functor (MetadataT m)
-> (forall a. a -> MetadataT m a)
-> (forall a b.
    MetadataT m (a -> b) -> MetadataT m a -> MetadataT m b)
-> (forall a b c.
    (a -> b -> c) -> MetadataT m a -> MetadataT m b -> MetadataT m c)
-> (forall a b. MetadataT m a -> MetadataT m b -> MetadataT m b)
-> (forall a b. MetadataT m a -> MetadataT m b -> MetadataT m a)
-> Applicative (MetadataT m)
forall a. a -> MetadataT m a
forall a b. MetadataT m a -> MetadataT m b -> MetadataT m a
forall a b. MetadataT m a -> MetadataT m b -> MetadataT m b
forall a b. MetadataT m (a -> b) -> MetadataT m a -> MetadataT m b
forall a b c.
(a -> b -> c) -> MetadataT m a -> MetadataT m b -> MetadataT m c
forall {m :: * -> *}. Monad m => Functor (MetadataT m)
forall (m :: * -> *) a. Monad m => a -> MetadataT m a
forall (m :: * -> *) a b.
Monad m =>
MetadataT m a -> MetadataT m b -> MetadataT m a
forall (m :: * -> *) a b.
Monad m =>
MetadataT m a -> MetadataT m b -> MetadataT m b
forall (m :: * -> *) a b.
Monad m =>
MetadataT m (a -> b) -> MetadataT m a -> MetadataT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> MetadataT m a -> MetadataT m b -> MetadataT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> MetadataT m a
pure :: forall a. a -> MetadataT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
MetadataT m (a -> b) -> MetadataT m a -> MetadataT m b
<*> :: forall a b. MetadataT m (a -> b) -> MetadataT m a -> MetadataT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> MetadataT m a -> MetadataT m b -> MetadataT m c
liftA2 :: forall a b c.
(a -> b -> c) -> MetadataT m a -> MetadataT m b -> MetadataT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
MetadataT m a -> MetadataT m b -> MetadataT m b
*> :: forall a b. MetadataT m a -> MetadataT m b -> MetadataT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
MetadataT m a -> MetadataT m b -> MetadataT m a
<* :: forall a b. MetadataT m a -> MetadataT m b -> MetadataT m a
Applicative,
      Applicative (MetadataT m)
Applicative (MetadataT m)
-> (forall a b.
    MetadataT m a -> (a -> MetadataT m b) -> MetadataT m b)
-> (forall a b. MetadataT m a -> MetadataT m b -> MetadataT m b)
-> (forall a. a -> MetadataT m a)
-> Monad (MetadataT m)
forall a. a -> MetadataT m a
forall a b. MetadataT m a -> MetadataT m b -> MetadataT m b
forall a b. MetadataT m a -> (a -> MetadataT m b) -> MetadataT m b
forall (m :: * -> *). Monad m => Applicative (MetadataT m)
forall (m :: * -> *) a. Monad m => a -> MetadataT m a
forall (m :: * -> *) a b.
Monad m =>
MetadataT m a -> MetadataT m b -> MetadataT m b
forall (m :: * -> *) a b.
Monad m =>
MetadataT m a -> (a -> MetadataT m b) -> MetadataT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
MetadataT m a -> (a -> MetadataT m b) -> MetadataT m b
>>= :: forall a b. MetadataT m a -> (a -> MetadataT m b) -> MetadataT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
MetadataT m a -> MetadataT m b -> MetadataT m b
>> :: forall a b. MetadataT m a -> MetadataT m b -> MetadataT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> MetadataT m a
return :: forall a. a -> MetadataT m a
Monad,
      (forall (m :: * -> *) a. Monad m => m a -> MetadataT m a)
-> MonadTrans MetadataT
forall (m :: * -> *) a. Monad m => m a -> MetadataT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> MetadataT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> MetadataT m a
MonadTrans,
      Monad (MetadataT m)
Monad (MetadataT m)
-> (forall a. IO a -> MetadataT m a) -> MonadIO (MetadataT m)
forall a. IO a -> MetadataT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (MetadataT m)
forall (m :: * -> *) a. MonadIO m => IO a -> MetadataT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> MetadataT m a
liftIO :: forall a. IO a -> MetadataT m a
MonadIO,
      MonadReader r,
      MonadError e,
      MonadError QErr (MetadataT m)
MonadError QErr (MetadataT m)
-> (forall a. TxE QErr a -> MetadataT m a) -> MonadTx (MetadataT m)
forall a. TxE QErr a -> MetadataT m a
forall (m :: * -> *).
MonadError QErr m -> (forall a. TxE QErr a -> m a) -> MonadTx m
forall {m :: * -> *}. MonadTx m => MonadError QErr (MetadataT m)
forall (m :: * -> *) a. MonadTx m => TxE QErr a -> MetadataT m a
$cliftTx :: forall (m :: * -> *) a. MonadTx m => TxE QErr a -> MetadataT m a
liftTx :: forall a. TxE QErr a -> MetadataT m a
MonadTx,
      TableCoreInfoRM b,
      Monad (MetadataT m)
MetadataT m SchemaCache
Monad (MetadataT m)
-> MetadataT m SchemaCache -> CacheRM (MetadataT m)
forall (m :: * -> *). Monad m -> m SchemaCache -> CacheRM m
forall {m :: * -> *}. CacheRM m => Monad (MetadataT m)
forall (m :: * -> *). CacheRM m => MetadataT m SchemaCache
$caskSchemaCache :: forall (m :: * -> *). CacheRM m => MetadataT m SchemaCache
askSchemaCache :: MetadataT m SchemaCache
CacheRM,
      CacheRM (MetadataT m)
CacheRM (MetadataT m)
-> (forall a.
    BuildReason
    -> CacheInvalidations
    -> Metadata
    -> Maybe MetadataResourceVersion
    -> ValidateNewSchemaCache a
    -> MetadataT m a)
-> (MetadataResourceVersion -> MetadataT m ())
-> CacheRWM (MetadataT m)
MetadataResourceVersion -> MetadataT m ()
forall a.
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> MetadataT m a
forall (m :: * -> *).
CacheRM m
-> (forall a.
    BuildReason
    -> CacheInvalidations
    -> Metadata
    -> Maybe MetadataResourceVersion
    -> ValidateNewSchemaCache a
    -> m a)
-> (MetadataResourceVersion -> m ())
-> CacheRWM m
forall {m :: * -> *}. CacheRWM m => CacheRM (MetadataT m)
forall (m :: * -> *).
CacheRWM m =>
MetadataResourceVersion -> MetadataT m ()
forall (m :: * -> *) a.
CacheRWM m =>
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> MetadataT m a
$ctryBuildSchemaCacheWithOptions :: forall (m :: * -> *) a.
CacheRWM m =>
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> MetadataT m a
tryBuildSchemaCacheWithOptions :: forall a.
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> MetadataT m a
$csetMetadataResourceVersionInSchemaCache :: forall (m :: * -> *).
CacheRWM m =>
MetadataResourceVersion -> MetadataT m ()
setMetadataResourceVersionInSchemaCache :: MetadataResourceVersion -> MetadataT m ()
CacheRWM,
      (forall (m :: * -> *) (n :: * -> *) b.
 Monad m =>
 (forall a. m a -> n a) -> MetadataT m b -> MetadataT n b)
-> MFunctor MetadataT
forall {k} (t :: (* -> *) -> k -> *).
(forall (m :: * -> *) (n :: * -> *) (b :: k).
 Monad m =>
 (forall a. m a -> n a) -> t m b -> t n b)
-> MFunctor t
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> MetadataT m b -> MetadataT n b
$choist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> MetadataT m b -> MetadataT n b
hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> MetadataT m b -> MetadataT n b
MFunctor,
      Monad (MetadataT m)
MetadataT m (Maybe TraceContext)
Monad (MetadataT m)
-> (forall a.
    TraceContext
    -> SamplingPolicy -> Text -> MetadataT m a -> MetadataT m a)
-> (forall a. SpanId -> Text -> MetadataT m a -> MetadataT m a)
-> MetadataT m (Maybe TraceContext)
-> (TraceMetadata -> MetadataT m ())
-> MonadTrace (MetadataT m)
TraceMetadata -> MetadataT m ()
forall a. SpanId -> Text -> MetadataT m a -> MetadataT m a
forall a.
TraceContext
-> SamplingPolicy -> Text -> MetadataT m a -> MetadataT m a
forall (m :: * -> *).
Monad m
-> (forall a. TraceContext -> SamplingPolicy -> Text -> m a -> m a)
-> (forall a. SpanId -> Text -> m a -> m a)
-> m (Maybe TraceContext)
-> (TraceMetadata -> m ())
-> MonadTrace m
forall {m :: * -> *}. MonadTrace m => Monad (MetadataT m)
forall (m :: * -> *).
MonadTrace m =>
MetadataT m (Maybe TraceContext)
forall (m :: * -> *).
MonadTrace m =>
TraceMetadata -> MetadataT m ()
forall (m :: * -> *) a.
MonadTrace m =>
SpanId -> Text -> MetadataT m a -> MetadataT m a
forall (m :: * -> *) a.
MonadTrace m =>
TraceContext
-> SamplingPolicy -> Text -> MetadataT m a -> MetadataT m a
$cnewTraceWith :: forall (m :: * -> *) a.
MonadTrace m =>
TraceContext
-> SamplingPolicy -> Text -> MetadataT m a -> MetadataT m a
newTraceWith :: forall a.
TraceContext
-> SamplingPolicy -> Text -> MetadataT m a -> MetadataT m a
$cnewSpanWith :: forall (m :: * -> *) a.
MonadTrace m =>
SpanId -> Text -> MetadataT m a -> MetadataT m a
newSpanWith :: forall a. SpanId -> Text -> MetadataT m a -> MetadataT m a
$ccurrentContext :: forall (m :: * -> *).
MonadTrace m =>
MetadataT m (Maybe TraceContext)
currentContext :: MetadataT m (Maybe TraceContext)
$cattachMetadata :: forall (m :: * -> *).
MonadTrace m =>
TraceMetadata -> MetadataT m ()
attachMetadata :: TraceMetadata -> MetadataT m ()
Tracing.MonadTrace,
      MonadBase b,
      MonadBaseControl b,
      Monad (MetadataT m)
MetadataT m Manager
Monad (MetadataT m)
-> MetadataT m Manager -> ProvidesNetwork (MetadataT m)
forall (m :: * -> *). Monad m -> m Manager -> ProvidesNetwork m
forall {m :: * -> *}. ProvidesNetwork m => Monad (MetadataT m)
forall (m :: * -> *). ProvidesNetwork m => MetadataT m Manager
$caskHTTPManager :: forall (m :: * -> *). ProvidesNetwork m => MetadataT m Manager
askHTTPManager :: MetadataT m Manager
ProvidesNetwork,
      Monad (MetadataT m)
Monad (MetadataT m)
-> (FeatureFlag -> MetadataT m Bool)
-> HasFeatureFlagChecker (MetadataT m)
FeatureFlag -> MetadataT m Bool
forall (m :: * -> *).
Monad m -> (FeatureFlag -> m Bool) -> HasFeatureFlagChecker m
forall {m :: * -> *}.
HasFeatureFlagChecker m =>
Monad (MetadataT m)
forall (m :: * -> *).
HasFeatureFlagChecker m =>
FeatureFlag -> MetadataT m Bool
$ccheckFlag :: forall (m :: * -> *).
HasFeatureFlagChecker m =>
FeatureFlag -> MetadataT m Bool
checkFlag :: FeatureFlag -> MetadataT m Bool
HasFeatureFlagChecker
    )
  deriving anyclass (Monad (MetadataT m)
Monad (MetadataT m)
-> (QueryTagsAttributes
    -> Maybe QueryTagsConfig -> Tagged (MetadataT m) QueryTagsComment)
-> MonadQueryTags (MetadataT m)
QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged (MetadataT m) QueryTagsComment
forall (m :: * -> *).
Monad m
-> (QueryTagsAttributes
    -> Maybe QueryTagsConfig -> Tagged m QueryTagsComment)
-> MonadQueryTags m
forall {m :: * -> *}. MonadQueryTags m => Monad (MetadataT m)
forall (m :: * -> *).
MonadQueryTags m =>
QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged (MetadataT m) QueryTagsComment
$ccreateQueryTags :: forall (m :: * -> *).
MonadQueryTags m =>
QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged (MetadataT m) QueryTagsComment
createQueryTags :: QueryTagsAttributes
-> Maybe QueryTagsConfig -> Tagged (MetadataT m) QueryTagsComment
MonadQueryTags)

instance (Monad m) => MetadataM (MetadataT m) where
  getMetadata :: MetadataT m Metadata
getMetadata = StateT Metadata m Metadata -> MetadataT m Metadata
forall (m :: * -> *) a. StateT Metadata m a -> MetadataT m a
MetadataT StateT Metadata m Metadata
forall s (m :: * -> *). MonadState s m => m s
get
  putMetadata :: Metadata -> MetadataT m ()
putMetadata = StateT Metadata m () -> MetadataT m ()
forall (m :: * -> *) a. StateT Metadata m a -> MetadataT m a
MetadataT (StateT Metadata m () -> MetadataT m ())
-> (Metadata -> StateT Metadata m ()) -> Metadata -> MetadataT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> StateT Metadata m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

instance (UserInfoM m) => UserInfoM (MetadataT m) where
  askUserInfo :: MetadataT m UserInfo
askUserInfo = m UserInfo -> MetadataT m UserInfo
forall (m :: * -> *) a. Monad m => m a -> MetadataT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m UserInfo
forall (m :: * -> *). UserInfoM m => m UserInfo
askUserInfo

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

-- | @runMetadataT@ puts a stateful metadata in scope. @MetadataDefaults@ is
-- provided so that it can be considered from the --metadataDefaults arguments.
runMetadataT :: Metadata -> MetadataDefaults -> MetadataT m a -> m (a, Metadata)
runMetadataT :: forall (m :: * -> *) a.
Metadata -> MetadataDefaults -> MetadataT m a -> m (a, Metadata)
runMetadataT Metadata
metadata MetadataDefaults
defaults (MetadataT StateT Metadata m a
m) =
  StateT Metadata m a -> Metadata -> m (a, Metadata)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT Metadata m a
m (Metadata
metadata Metadata -> MetadataDefaults -> Metadata
`overrideMetadataDefaults` MetadataDefaults
defaults)

buildSchemaCacheWithInvalidations :: (MetadataM m, CacheRWM m) => CacheInvalidations -> MetadataModifier -> m ()
buildSchemaCacheWithInvalidations :: forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
CacheInvalidations -> MetadataModifier -> m ()
buildSchemaCacheWithInvalidations CacheInvalidations
cacheInvalidations MetadataModifier {Metadata -> Metadata
runMetadataModifier :: Metadata -> Metadata
runMetadataModifier :: MetadataModifier -> Metadata -> Metadata
..} = do
  Metadata
metadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  let modifiedMetadata :: Metadata
modifiedMetadata = Metadata -> Metadata
runMetadataModifier Metadata
metadata
  BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> m ()
forall (m :: * -> *).
CacheRWM m =>
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> m ()
buildSchemaCacheWithOptions
    (Maybe (HashSet SourceName) -> BuildReason
CatalogUpdate Maybe (HashSet SourceName)
forall a. Monoid a => a
mempty)
    CacheInvalidations
cacheInvalidations
    Metadata
modifiedMetadata
    Maybe MetadataResourceVersion
forall a. Maybe a
Nothing
  Metadata -> m ()
forall (m :: * -> *). MetadataM m => Metadata -> m ()
putMetadata Metadata
modifiedMetadata

buildSchemaCache :: (MetadataM m, CacheRWM m) => MetadataModifier -> m ()
buildSchemaCache :: forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache = CacheInvalidations -> MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
CacheInvalidations -> MetadataModifier -> m ()
buildSchemaCacheWithInvalidations CacheInvalidations
forall a. Monoid a => a
mempty

-- | Rebuilds the schema cache after modifying metadata and returns any _new_ metadata inconsistencies.
-- If there are any new inconsistencies, the changes to the metadata and the schema cache are abandoned.
tryBuildSchemaCache ::
  (CacheRWM m, MetadataM m) =>
  MetadataModifier ->
  m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
tryBuildSchemaCache :: forall (m :: * -> *).
(CacheRWM m, MetadataM m) =>
MetadataModifier
-> m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
tryBuildSchemaCache MetadataModifier {Metadata -> Metadata
runMetadataModifier :: MetadataModifier -> Metadata -> Metadata
runMetadataModifier :: Metadata -> Metadata
..} =
  [Metadata -> m Metadata]
-> m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
forall (m :: * -> *).
(CacheRWM m, MetadataM m) =>
[Metadata -> m Metadata]
-> m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
tryBuildSchemaCacheWithModifiers [Metadata -> m Metadata
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Metadata -> m Metadata)
-> (Metadata -> Metadata) -> Metadata -> m Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> Metadata
runMetadataModifier]

-- | Rebuilds the schema cache after modifying metadata sequentially and returns any _new_ metadata inconsistencies.
-- If there are any new inconsistencies, the changes to the metadata and the schema cache are abandoned.
-- If the metadata modifiers run into validation issues (e.g. a native query is already tracked in the metadata),
-- we throw these errors back without changing the metadata and schema cache.
tryBuildSchemaCacheWithModifiers ::
  (CacheRWM m, MetadataM m) =>
  [Metadata -> m Metadata] ->
  m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
tryBuildSchemaCacheWithModifiers :: forall (m :: * -> *).
(CacheRWM m, MetadataM m) =>
[Metadata -> m Metadata]
-> m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
tryBuildSchemaCacheWithModifiers [Metadata -> m Metadata]
modifiers = do
  Metadata
modifiedMetadata <- do
    Metadata
metadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
    (Metadata -> (Metadata -> m Metadata) -> m Metadata)
-> Metadata -> [Metadata -> m Metadata] -> m Metadata
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (((Metadata -> m Metadata) -> Metadata -> m Metadata)
-> Metadata -> (Metadata -> m Metadata) -> m Metadata
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Metadata -> m Metadata) -> Metadata -> m Metadata
forall a b. (a -> b) -> a -> b
($)) Metadata
metadata [Metadata -> m Metadata]
modifiers

  HashMap MetadataObjId (NonEmpty InconsistentMetadata)
newInconsistentObjects <-
    BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache
     (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
-> m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
forall a.
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> m a
forall (m :: * -> *) a.
CacheRWM m =>
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> ValidateNewSchemaCache a
-> m a
tryBuildSchemaCacheWithOptions
      (Maybe (HashSet SourceName) -> BuildReason
CatalogUpdate Maybe (HashSet SourceName)
forall a. Monoid a => a
mempty)
      CacheInvalidations
forall a. Monoid a => a
mempty
      Metadata
modifiedMetadata
      Maybe MetadataResourceVersion
forall a. Maybe a
Nothing
      ValidateNewSchemaCache
  (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
validateNewSchemaCache
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HashMap MetadataObjId (NonEmpty InconsistentMetadata)
newInconsistentObjects HashMap MetadataObjId (NonEmpty InconsistentMetadata)
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata) -> Bool
forall a. Eq a => a -> a -> Bool
== HashMap MetadataObjId (NonEmpty InconsistentMetadata)
forall a. Monoid a => a
mempty)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Metadata -> m ()
forall (m :: * -> *). MetadataM m => Metadata -> m ()
putMetadata Metadata
modifiedMetadata
  HashMap MetadataObjId (NonEmpty InconsistentMetadata)
-> m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap MetadataObjId (NonEmpty InconsistentMetadata)
 -> m (HashMap MetadataObjId (NonEmpty InconsistentMetadata)))
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
-> m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
forall a b. (a -> b) -> a -> b
$ HashMap MetadataObjId (NonEmpty InconsistentMetadata)
newInconsistentObjects
  where
    validateNewSchemaCache :: SchemaCache -> SchemaCache -> (ValidateNewSchemaCacheResult, HashMap MetadataObjId (NonEmpty InconsistentMetadata))
    validateNewSchemaCache :: ValidateNewSchemaCache
  (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
validateNewSchemaCache SchemaCache
oldSchemaCache SchemaCache
newSchemaCache =
      let diffInconsistentObjects :: SchemaCache
-> SchemaCache
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
diffInconsistentObjects = HashMap MetadataObjId (NonEmpty InconsistentMetadata)
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HashMap.difference (HashMap MetadataObjId (NonEmpty InconsistentMetadata)
 -> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
 -> HashMap MetadataObjId (NonEmpty InconsistentMetadata))
-> (SchemaCache
    -> HashMap MetadataObjId (NonEmpty InconsistentMetadata))
-> SchemaCache
-> SchemaCache
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ([InconsistentMetadata]
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
groupInconsistentMetadataById ([InconsistentMetadata]
 -> HashMap MetadataObjId (NonEmpty InconsistentMetadata))
-> (SchemaCache -> [InconsistentMetadata])
-> SchemaCache
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaCache -> [InconsistentMetadata]
scInconsistentObjs)
          newInconsistentObjects :: HashMap MetadataObjId (NonEmpty InconsistentMetadata)
newInconsistentObjects = SchemaCache
newSchemaCache SchemaCache
-> SchemaCache
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
`diffInconsistentObjects` SchemaCache
oldSchemaCache
       in if HashMap MetadataObjId (NonEmpty InconsistentMetadata)
newInconsistentObjects HashMap MetadataObjId (NonEmpty InconsistentMetadata)
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata) -> Bool
forall a. Eq a => a -> a -> Bool
== HashMap MetadataObjId (NonEmpty InconsistentMetadata)
forall a. Monoid a => a
mempty
            then (ValidateNewSchemaCacheResult
KeepNewSchemaCache, HashMap MetadataObjId (NonEmpty InconsistentMetadata)
newInconsistentObjects)
            else (ValidateNewSchemaCacheResult
DiscardNewSchemaCache, HashMap MetadataObjId (NonEmpty InconsistentMetadata)
newInconsistentObjects)

-- | Tries to modify the metadata for all the specified metadata objects. If the modification fails,
-- any objects that directly caused a new metadata inconsistency are removed and the modification
-- is attempted again without those failing objects. The failing objects are raised as warnings
-- in 'MonadWarnings' and the successful objects are returned. If there are metadata inconsistencies
-- that are not directly related to the specified metadata objects, an error is thrown.
tryBuildSchemaCacheAndWarnOnFailingObjects ::
  forall m a.
  (CacheRWM m, MonadWarnings m, QErrM m, MetadataM m) =>
  -- | Function makes a metadata modifier for a metadata object
  (a -> m MetadataModifier) ->
  -- | Warning code to use for failed metadata objects
  WarningCode ->
  -- | Map of metadata objects to apply to metadata using the 'mkMetadataModifier' function
  HashMap MetadataObjId a ->
  -- | Successfully applied metadata objects
  m (HashMap MetadataObjId a)
tryBuildSchemaCacheAndWarnOnFailingObjects :: forall (m :: * -> *) a.
(CacheRWM m, MonadWarnings m, QErrM m, MetadataM m) =>
(a -> m MetadataModifier)
-> WarningCode
-> HashMap MetadataObjId a
-> m (HashMap MetadataObjId a)
tryBuildSchemaCacheAndWarnOnFailingObjects a -> m MetadataModifier
mkMetadataModifier WarningCode
warningCode HashMap MetadataObjId a
metadataObjects = do
  MetadataModifier
metadataModifier <- ([MetadataModifier] -> MetadataModifier)
-> m [MetadataModifier] -> m MetadataModifier
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [MetadataModifier] -> MetadataModifier
forall a. Monoid a => [a] -> a
mconcat (m [MetadataModifier] -> m MetadataModifier)
-> ([a] -> m [MetadataModifier]) -> [a] -> m MetadataModifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m MetadataModifier) -> [a] -> m [MetadataModifier]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse a -> m MetadataModifier
mkMetadataModifier ([a] -> m MetadataModifier) -> [a] -> m MetadataModifier
forall a b. (a -> b) -> a -> b
$ HashMap MetadataObjId a -> [a]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap MetadataObjId a
metadataObjects
  HashMap MetadataObjId (NonEmpty InconsistentMetadata)
metadataInconsistencies <- MetadataModifier
-> m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
forall (m :: * -> *).
(CacheRWM m, MetadataM m) =>
MetadataModifier
-> m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
tryBuildSchemaCache MetadataModifier
metadataModifier

  let inconsistentObjects :: HashMap MetadataObjId (NonEmpty InconsistentMetadata, a)
inconsistentObjects = (NonEmpty InconsistentMetadata
 -> a -> (NonEmpty InconsistentMetadata, a))
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
-> HashMap MetadataObjId a
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata, a)
forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HashMap.intersectionWith (,) HashMap MetadataObjId (NonEmpty InconsistentMetadata)
metadataInconsistencies HashMap MetadataObjId a
metadataObjects
  let successfulObjects :: HashMap MetadataObjId a
successfulObjects = HashMap MetadataObjId a
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata, a)
-> HashMap MetadataObjId a
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HashMap.difference HashMap MetadataObjId a
metadataObjects HashMap MetadataObjId (NonEmpty InconsistentMetadata, a)
inconsistentObjects

  HashMap MetadataObjId (NonEmpty InconsistentMetadata)
finalMetadataInconsistencies <-
    if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ HashMap MetadataObjId (NonEmpty InconsistentMetadata, a) -> Bool
forall a. HashMap MetadataObjId a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap MetadataObjId (NonEmpty InconsistentMetadata, a)
inconsistentObjects
      then do
        -- Raise warnings for objects that failed to track
        [(MetadataObjId, (NonEmpty InconsistentMetadata, a))]
-> ((MetadataObjId, (NonEmpty InconsistentMetadata, a)) -> m ())
-> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (HashMap MetadataObjId (NonEmpty InconsistentMetadata, a)
-> [(MetadataObjId, (NonEmpty InconsistentMetadata, a))]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap MetadataObjId (NonEmpty InconsistentMetadata, a)
inconsistentObjects) (((MetadataObjId, (NonEmpty InconsistentMetadata, a)) -> m ())
 -> m ())
-> ((MetadataObjId, (NonEmpty InconsistentMetadata, a)) -> m ())
-> m ()
forall a b. (a -> b) -> a -> b
$ \(MetadataObjId
metadataObjId, (NonEmpty InconsistentMetadata
inconsistencies, a
_)) -> do
          let errorReasons :: Text
errorReasons = NonEmpty Text -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated (NonEmpty Text -> Text) -> NonEmpty Text -> Text
forall a b. (a -> b) -> a -> b
$ InconsistentMetadata -> Text
imReason (InconsistentMetadata -> Text)
-> NonEmpty InconsistentMetadata -> NonEmpty Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty InconsistentMetadata
inconsistencies
          MetadataWarning -> m ()
forall (m :: * -> *). MonadWarnings m => MetadataWarning -> m ()
warn (MetadataWarning -> m ()) -> MetadataWarning -> m ()
forall a b. (a -> b) -> a -> b
$ WarningCode -> MetadataObjId -> Text -> MetadataWarning
MetadataWarning WarningCode
warningCode MetadataObjId
metadataObjId Text
errorReasons

        -- Try again, this time only with objects that were previously successful
        MetadataModifier
withoutFailedObjectsMetadataModifier <- ([MetadataModifier] -> MetadataModifier)
-> m [MetadataModifier] -> m MetadataModifier
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [MetadataModifier] -> MetadataModifier
forall a. Monoid a => [a] -> a
mconcat (m [MetadataModifier] -> m MetadataModifier)
-> ([a] -> m [MetadataModifier]) -> [a] -> m MetadataModifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m MetadataModifier) -> [a] -> m [MetadataModifier]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse a -> m MetadataModifier
mkMetadataModifier ([a] -> m MetadataModifier) -> [a] -> m MetadataModifier
forall a b. (a -> b) -> a -> b
$ HashMap MetadataObjId a -> [a]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap MetadataObjId a
successfulObjects
        MetadataModifier
-> m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
forall (m :: * -> *).
(CacheRWM m, MetadataM m) =>
MetadataModifier
-> m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
tryBuildSchemaCache MetadataModifier
withoutFailedObjectsMetadataModifier
      else -- Otherwise just look at the rest of the errors, if any
        HashMap MetadataObjId (NonEmpty InconsistentMetadata)
-> m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap MetadataObjId (NonEmpty InconsistentMetadata)
metadataInconsistencies

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashMap MetadataObjId (NonEmpty InconsistentMetadata) -> Bool
forall a. HashMap MetadataObjId a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap MetadataObjId (NonEmpty InconsistentMetadata)
finalMetadataInconsistencies)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ QErr -> m ()
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
      (Code -> Text -> QErr
err400 Code
Unexpected Text
"cannot continue due to newly found inconsistent metadata")
        { qeInternal :: Maybe QErrExtra
qeInternal = QErrExtra -> Maybe QErrExtra
forall a. a -> Maybe a
Just (QErrExtra -> Maybe QErrExtra) -> QErrExtra -> Maybe QErrExtra
forall a b. (a -> b) -> a -> b
$ Value -> QErrExtra
ExtraInternal (Value -> QErrExtra) -> Value -> QErrExtra
forall a b. (a -> b) -> a -> b
$ [InconsistentMetadata] -> Value
forall a. ToJSON a => a -> Value
toJSON ([InconsistentMetadata] -> [InconsistentMetadata]
forall a. Eq a => [a] -> [a]
L.nub ([InconsistentMetadata] -> [InconsistentMetadata])
-> ([NonEmpty InconsistentMetadata] -> [InconsistentMetadata])
-> [NonEmpty InconsistentMetadata]
-> [InconsistentMetadata]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty InconsistentMetadata -> [InconsistentMetadata])
-> [NonEmpty InconsistentMetadata] -> [InconsistentMetadata]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty InconsistentMetadata -> [InconsistentMetadata]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([NonEmpty InconsistentMetadata] -> [InconsistentMetadata])
-> [NonEmpty InconsistentMetadata] -> [InconsistentMetadata]
forall a b. (a -> b) -> a -> b
$ HashMap MetadataObjId (NonEmpty InconsistentMetadata)
-> [NonEmpty InconsistentMetadata]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap MetadataObjId (NonEmpty InconsistentMetadata)
finalMetadataInconsistencies)
        }

  HashMap MetadataObjId a -> m (HashMap MetadataObjId a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap MetadataObjId a
successfulObjects

-- | Rebuilds the schema cache after modifying metadata. If an object with the given object id became newly inconsistent,
-- raises an error about it specifically. Otherwise, raises a generic metadata inconsistency error.
buildSchemaCacheFor ::
  (QErrM m, CacheRWM m, MetadataM m) =>
  MetadataObjId ->
  MetadataModifier ->
  m ()
buildSchemaCacheFor :: forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor MetadataObjId
objectId MetadataModifier
metadataModifier = do
  HashMap MetadataObjId (NonEmpty InconsistentMetadata)
newInconsistentObjects <- MetadataModifier
-> m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
forall (m :: * -> *).
(CacheRWM m, MetadataM m) =>
MetadataModifier
-> m (HashMap MetadataObjId (NonEmpty InconsistentMetadata))
tryBuildSchemaCache MetadataModifier
metadataModifier

  Maybe (NonEmpty InconsistentMetadata)
-> (NonEmpty InconsistentMetadata -> m Any) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (MetadataObjId
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
-> Maybe (NonEmpty InconsistentMetadata)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup MetadataObjId
objectId HashMap MetadataObjId (NonEmpty InconsistentMetadata)
newInconsistentObjects) ((NonEmpty InconsistentMetadata -> m Any) -> m ())
-> (NonEmpty InconsistentMetadata -> m Any) -> m ()
forall a b. (a -> b) -> a -> b
$ \NonEmpty InconsistentMetadata
matchingObjects -> do
    let reasons :: Text
reasons = NonEmpty Text -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated (NonEmpty Text -> Text) -> NonEmpty Text -> Text
forall a b. (a -> b) -> a -> b
$ InconsistentMetadata -> Text
imReason (InconsistentMetadata -> Text)
-> NonEmpty InconsistentMetadata -> NonEmpty Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty InconsistentMetadata
matchingObjects
    QErr -> m Any
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Code -> Text -> QErr
err400 Code
InvalidConfiguration Text
reasons) {qeInternal :: Maybe QErrExtra
qeInternal = QErrExtra -> Maybe QErrExtra
forall a. a -> Maybe a
Just (QErrExtra -> Maybe QErrExtra) -> QErrExtra -> Maybe QErrExtra
forall a b. (a -> b) -> a -> b
$ Value -> QErrExtra
ExtraInternal (Value -> QErrExtra) -> Value -> QErrExtra
forall a b. (a -> b) -> a -> b
$ NonEmpty InconsistentMetadata -> Value
forall a. ToJSON a => a -> Value
toJSON NonEmpty InconsistentMetadata
matchingObjects}

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HashMap MetadataObjId (NonEmpty InconsistentMetadata) -> Bool
forall a. HashMap MetadataObjId a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap MetadataObjId (NonEmpty InconsistentMetadata)
newInconsistentObjects)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ QErr -> m ()
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
      (Code -> Text -> QErr
err400 Code
Unexpected Text
"cannot continue due to new inconsistent metadata")
        { qeInternal :: Maybe QErrExtra
qeInternal = QErrExtra -> Maybe QErrExtra
forall a. a -> Maybe a
Just (QErrExtra -> Maybe QErrExtra) -> QErrExtra -> Maybe QErrExtra
forall a b. (a -> b) -> a -> b
$ Value -> QErrExtra
ExtraInternal (Value -> QErrExtra) -> Value -> QErrExtra
forall a b. (a -> b) -> a -> b
$ [InconsistentMetadata] -> Value
forall a. ToJSON a => a -> Value
toJSON ([InconsistentMetadata] -> [InconsistentMetadata]
forall a. Eq a => [a] -> [a]
L.nub ([InconsistentMetadata] -> [InconsistentMetadata])
-> ([NonEmpty InconsistentMetadata] -> [InconsistentMetadata])
-> [NonEmpty InconsistentMetadata]
-> [InconsistentMetadata]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty InconsistentMetadata -> [InconsistentMetadata])
-> [NonEmpty InconsistentMetadata] -> [InconsistentMetadata]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty InconsistentMetadata -> [InconsistentMetadata]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([NonEmpty InconsistentMetadata] -> [InconsistentMetadata])
-> [NonEmpty InconsistentMetadata] -> [InconsistentMetadata]
forall a b. (a -> b) -> a -> b
$ HashMap MetadataObjId (NonEmpty InconsistentMetadata)
-> [NonEmpty InconsistentMetadata]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap MetadataObjId (NonEmpty InconsistentMetadata)
newInconsistentObjects)
        }

-- | Requests the schema cache, and fails if there is any inconsistent metadata.
throwOnInconsistencies :: (QErrM m, CacheRWM m) => m ()
throwOnInconsistencies :: forall (m :: * -> *). (QErrM m, CacheRWM m) => m ()
throwOnInconsistencies = do
  SchemaCache
sc <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  let inconsObjs :: [InconsistentMetadata]
inconsObjs = SchemaCache -> [InconsistentMetadata]
scInconsistentObjs SchemaCache
sc
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([InconsistentMetadata] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InconsistentMetadata]
inconsObjs) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let err :: QErr
err = Code -> Text -> QErr
err400 Code
Unexpected Text
"cannot continue due to inconsistent metadata"
    QErr -> m ()
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError QErr
err {qeInternal :: Maybe QErrExtra
qeInternal = QErrExtra -> Maybe QErrExtra
forall a. a -> Maybe a
Just (QErrExtra -> Maybe QErrExtra) -> QErrExtra -> Maybe QErrExtra
forall a b. (a -> b) -> a -> b
$ Value -> QErrExtra
ExtraInternal (Value -> QErrExtra) -> Value -> QErrExtra
forall a b. (a -> b) -> a -> b
$ [InconsistentMetadata] -> Value
forall a. ToJSON a => a -> Value
toJSON [InconsistentMetadata]
inconsObjs}

-- | Executes the given action, and if any new 'InconsistentMetadata's are added to the schema
-- cache as a result of its execution, raises an error.
withNewInconsistentObjsCheck :: (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck :: forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck m a
action = do
  [InconsistentMetadata]
originalObjects <- SchemaCache -> [InconsistentMetadata]
scInconsistentObjs (SchemaCache -> [InconsistentMetadata])
-> m SchemaCache -> m [InconsistentMetadata]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  a
result <- m a
action
  [InconsistentMetadata]
currentObjects <- SchemaCache -> [InconsistentMetadata]
scInconsistentObjs (SchemaCache -> [InconsistentMetadata])
-> m SchemaCache -> m [InconsistentMetadata]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache

  let diffInconsistentObjects :: [InconsistentMetadata]
-> [InconsistentMetadata]
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
diffInconsistentObjects = HashMap MetadataObjId (NonEmpty InconsistentMetadata)
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HashMap.difference (HashMap MetadataObjId (NonEmpty InconsistentMetadata)
 -> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
 -> HashMap MetadataObjId (NonEmpty InconsistentMetadata))
-> ([InconsistentMetadata]
    -> HashMap MetadataObjId (NonEmpty InconsistentMetadata))
-> [InconsistentMetadata]
-> [InconsistentMetadata]
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` [InconsistentMetadata]
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
groupInconsistentMetadataById
      newInconsistentObjects :: [InconsistentMetadata]
newInconsistentObjects =
        [InconsistentMetadata] -> [InconsistentMetadata]
forall a. Ord a => [a] -> [a]
L.uniques ([InconsistentMetadata] -> [InconsistentMetadata])
-> [InconsistentMetadata] -> [InconsistentMetadata]
forall a b. (a -> b) -> a -> b
$ (NonEmpty InconsistentMetadata -> [InconsistentMetadata])
-> [NonEmpty InconsistentMetadata] -> [InconsistentMetadata]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty InconsistentMetadata -> [InconsistentMetadata]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([NonEmpty InconsistentMetadata] -> [InconsistentMetadata])
-> [NonEmpty InconsistentMetadata] -> [InconsistentMetadata]
forall a b. (a -> b) -> a -> b
$ HashMap MetadataObjId (NonEmpty InconsistentMetadata)
-> [NonEmpty InconsistentMetadata]
forall k v. HashMap k v -> [v]
HashMap.elems ([InconsistentMetadata]
currentObjects [InconsistentMetadata]
-> [InconsistentMetadata]
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
`diffInconsistentObjects` [InconsistentMetadata]
originalObjects)
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([InconsistentMetadata] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InconsistentMetadata]
newInconsistentObjects)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ QErr -> m ()
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
      (Code -> Text -> QErr
err500 Code
Unexpected Text
"cannot continue due to newly found inconsistent metadata")
        { qeInternal :: Maybe QErrExtra
qeInternal = QErrExtra -> Maybe QErrExtra
forall a. a -> Maybe a
Just (QErrExtra -> Maybe QErrExtra) -> QErrExtra -> Maybe QErrExtra
forall a b. (a -> b) -> a -> b
$ Value -> QErrExtra
ExtraInternal (Value -> QErrExtra) -> Value -> QErrExtra
forall a b. (a -> b) -> a -> b
$ [InconsistentMetadata] -> Value
forall a. ToJSON a => a -> Value
toJSON [InconsistentMetadata]
newInconsistentObjects
        }

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

-- | getInconsistentQueryCollections is a helper function that runs the
-- static analysis over the saved queries and reports any inconsistenties
-- with the current schema.
getInconsistentQueryCollections ::
  G.SchemaIntrospection ->
  QueryCollections ->
  ((CollectionName, ListedQuery) -> MetadataObject) ->
  EndpointTrie GQLQueryWithText ->
  [NormalizedQuery] ->
  [InconsistentMetadata]
getInconsistentQueryCollections :: SchemaIntrospection
-> QueryCollections
-> ((CollectionName, ListedQuery) -> MetadataObject)
-> EndpointTrie GQLQueryWithText
-> [NormalizedQuery]
-> [InconsistentMetadata]
getInconsistentQueryCollections SchemaIntrospection
rs QueryCollections
qcs (CollectionName, ListedQuery) -> MetadataObject
lqToMetadataObj EndpointTrie GQLQueryWithText
restEndpoints [NormalizedQuery]
allowLst =
  ((MetadataObject, Text) -> InconsistentMetadata)
-> [(MetadataObject, Text)] -> [InconsistentMetadata]
forall a b. (a -> b) -> [a] -> [b]
map (\(MetadataObject
o, Text
t) -> Text -> Maybe Value -> MetadataObject -> InconsistentMetadata
InconsistentObject Text
t Maybe Value
forall a. Maybe a
Nothing MetadataObject
o) [(MetadataObject, Text)]
inconsistentMetaObjs
  where
    inconsistentMetaObjs :: [(MetadataObject, Text)]
inconsistentMetaObjs = [Either (MetadataObject, Text) ()] -> [(MetadataObject, Text)]
forall a b. [Either a b] -> [a]
lefts ([Either (MetadataObject, Text) ()] -> [(MetadataObject, Text)])
-> [Either (MetadataObject, Text) ()] -> [(MetadataObject, Text)]
forall a b. (a -> b) -> a -> b
$ ((CollectionName, ListedQuery), [ExecutableDefinition Name])
-> Either (MetadataObject, Text) ()
validateQuery (((CollectionName, ListedQuery), [ExecutableDefinition Name])
 -> Either (MetadataObject, Text) ())
-> [((CollectionName, ListedQuery), [ExecutableDefinition Name])]
-> [Either (MetadataObject, Text) ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [((CollectionName, ListedQuery), [ExecutableDefinition Name])]
lqLst

    zipLQwithDef :: (CollectionName, CreateCollection) -> [((CollectionName, ListedQuery), [G.ExecutableDefinition G.Name])]
    zipLQwithDef :: (CollectionName, CreateCollection)
-> [((CollectionName, ListedQuery), [ExecutableDefinition Name])]
zipLQwithDef (CollectionName
cName, CreateCollection
cc) = (ListedQuery
 -> ((CollectionName, ListedQuery), [ExecutableDefinition Name]))
-> [ListedQuery]
-> [((CollectionName, ListedQuery), [ExecutableDefinition Name])]
forall a b. (a -> b) -> [a] -> [b]
map (\ListedQuery
lq -> ((CollectionName
cName, ListedQuery
lq), (ExecutableDocument Name -> [ExecutableDefinition Name]
forall var. ExecutableDocument var -> [ExecutableDefinition var]
G.getExecutableDefinitions (ExecutableDocument Name -> [ExecutableDefinition Name])
-> (ListedQuery -> ExecutableDocument Name)
-> ListedQuery
-> [ExecutableDefinition Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLQuery -> ExecutableDocument Name
unGQLQuery (GQLQuery -> ExecutableDocument Name)
-> (ListedQuery -> GQLQuery)
-> ListedQuery
-> ExecutableDocument Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLQueryWithText -> GQLQuery
getGQLQuery (GQLQueryWithText -> GQLQuery)
-> (ListedQuery -> GQLQueryWithText) -> ListedQuery -> GQLQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListedQuery -> GQLQueryWithText
_lqQuery (ListedQuery -> [ExecutableDefinition Name])
-> ListedQuery -> [ExecutableDefinition Name]
forall a b. (a -> b) -> a -> b
$ ListedQuery
lq))) [ListedQuery]
lqs
      where
        lqs :: [ListedQuery]
lqs = CollectionDef -> [ListedQuery]
_cdQueries (CollectionDef -> [ListedQuery])
-> (CreateCollection -> CollectionDef)
-> CreateCollection
-> [ListedQuery]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateCollection -> CollectionDef
_ccDefinition (CreateCollection -> [ListedQuery])
-> CreateCollection -> [ListedQuery]
forall a b. (a -> b) -> a -> b
$ CreateCollection
cc

    inAllowList :: [NormalizedQuery] -> (ListedQuery) -> Bool
    inAllowList :: [NormalizedQuery] -> ListedQuery -> Bool
inAllowList [NormalizedQuery]
nativeQueryList (ListedQuery {GQLQueryWithText
QueryName
_lqQuery :: ListedQuery -> GQLQueryWithText
_lqName :: QueryName
_lqQuery :: GQLQueryWithText
_lqName :: ListedQuery -> QueryName
..}) = (NormalizedQuery -> Bool) -> [NormalizedQuery] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\NormalizedQuery
nqCode -> NormalizedQuery -> ExecutableDocument Name
unNormalizedQuery NormalizedQuery
nqCode ExecutableDocument Name -> ExecutableDocument Name -> Bool
forall a. Eq a => a -> a -> Bool
== (GQLQuery -> ExecutableDocument Name
unGQLQuery (GQLQuery -> ExecutableDocument Name)
-> (GQLQueryWithText -> GQLQuery)
-> GQLQueryWithText
-> ExecutableDocument Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLQueryWithText -> GQLQuery
getGQLQuery) GQLQueryWithText
_lqQuery) [NormalizedQuery]
nativeQueryList

    inRESTEndpoints :: EndpointTrie GQLQueryWithText -> (ListedQuery) -> [Text]
    inRESTEndpoints :: EndpointTrie GQLQueryWithText -> ListedQuery -> [Text]
inRESTEndpoints EndpointTrie GQLQueryWithText
edTrie ListedQuery
lq = ((Text, GQLQueryWithText) -> Text)
-> [(Text, GQLQueryWithText)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, GQLQueryWithText) -> Text
forall a b. (a, b) -> a
fst ([(Text, GQLQueryWithText)] -> [Text])
-> [(Text, GQLQueryWithText)] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((Text, GQLQueryWithText) -> Bool)
-> [(Text, GQLQueryWithText)] -> [(Text, GQLQueryWithText)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text, GQLQueryWithText) -> Bool
queryIsFaulty) [(Text, GQLQueryWithText)]
allQueries
      where
        methodMaps :: [MultiMap EndpointMethod (EndpointMetadata GQLQueryWithText)]
methodMaps = EndpointTrie GQLQueryWithText
-> [MultiMap EndpointMethod (EndpointMetadata GQLQueryWithText)]
forall k v. Trie k v -> [v]
Trie.elems EndpointTrie GQLQueryWithText
edTrie
        endpoints :: [EndpointMetadata GQLQueryWithText]
endpoints = ((EndpointMethod, [EndpointMetadata GQLQueryWithText])
 -> [EndpointMetadata GQLQueryWithText])
-> [(EndpointMethod, [EndpointMetadata GQLQueryWithText])]
-> [EndpointMetadata GQLQueryWithText]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (EndpointMethod, [EndpointMetadata GQLQueryWithText])
-> [EndpointMetadata GQLQueryWithText]
forall a b. (a, b) -> b
snd ([(EndpointMethod, [EndpointMetadata GQLQueryWithText])]
 -> [EndpointMetadata GQLQueryWithText])
-> [(EndpointMethod, [EndpointMetadata GQLQueryWithText])]
-> [EndpointMetadata GQLQueryWithText]
forall a b. (a -> b) -> a -> b
$ (MultiMap EndpointMethod (EndpointMetadata GQLQueryWithText)
 -> [(EndpointMethod, [EndpointMetadata GQLQueryWithText])])
-> [MultiMap EndpointMethod (EndpointMetadata GQLQueryWithText)]
-> [(EndpointMethod, [EndpointMetadata GQLQueryWithText])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (MultiMap EndpointMethod (EndpointMetadata GQLQueryWithText)
-> [(EndpointMethod, [EndpointMetadata GQLQueryWithText])]
forall k v. MultiMap k v -> [(k, [v])]
MultiMap.toList) [MultiMap EndpointMethod (EndpointMetadata GQLQueryWithText)]
methodMaps
        allQueries :: [(Text, GQLQueryWithText)]
        allQueries :: [(Text, GQLQueryWithText)]
allQueries = (EndpointMetadata GQLQueryWithText -> (Text, GQLQueryWithText))
-> [EndpointMetadata GQLQueryWithText]
-> [(Text, GQLQueryWithText)]
forall a b. (a -> b) -> [a] -> [b]
map (\EndpointMetadata GQLQueryWithText
d -> (NonEmptyText -> Text
unNonEmptyText (NonEmptyText -> Text)
-> (EndpointMetadata GQLQueryWithText -> NonEmptyText)
-> EndpointMetadata GQLQueryWithText
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndpointName -> NonEmptyText
unEndpointName (EndpointName -> NonEmptyText)
-> (EndpointMetadata GQLQueryWithText -> EndpointName)
-> EndpointMetadata GQLQueryWithText
-> NonEmptyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndpointMetadata GQLQueryWithText -> EndpointName
forall query. EndpointMetadata query -> EndpointName
_ceName (EndpointMetadata GQLQueryWithText -> Text)
-> EndpointMetadata GQLQueryWithText -> Text
forall a b. (a -> b) -> a -> b
$ EndpointMetadata GQLQueryWithText
d, EndpointDef GQLQueryWithText -> GQLQueryWithText
forall query. EndpointDef query -> query
_edQuery (EndpointDef GQLQueryWithText -> GQLQueryWithText)
-> (EndpointMetadata GQLQueryWithText
    -> EndpointDef GQLQueryWithText)
-> EndpointMetadata GQLQueryWithText
-> GQLQueryWithText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndpointMetadata GQLQueryWithText -> EndpointDef GQLQueryWithText
forall query. EndpointMetadata query -> EndpointDef query
_ceDefinition (EndpointMetadata GQLQueryWithText -> GQLQueryWithText)
-> EndpointMetadata GQLQueryWithText -> GQLQueryWithText
forall a b. (a -> b) -> a -> b
$ EndpointMetadata GQLQueryWithText
d)) [EndpointMetadata GQLQueryWithText]
endpoints

        queryIsFaulty :: (Text, GQLQueryWithText) -> Bool
        queryIsFaulty :: (Text, GQLQueryWithText) -> Bool
queryIsFaulty (Text
_, GQLQueryWithText
gqlQ) = (ListedQuery -> GQLQueryWithText
_lqQuery ListedQuery
lq) GQLQueryWithText -> GQLQueryWithText -> Bool
forall a. Eq a => a -> a -> Bool
== GQLQueryWithText
gqlQ

    lqLst :: [((CollectionName, ListedQuery), [ExecutableDefinition Name])]
lqLst = ((CollectionName, CreateCollection)
 -> [((CollectionName, ListedQuery), [ExecutableDefinition Name])])
-> [(CollectionName, CreateCollection)]
-> [((CollectionName, ListedQuery), [ExecutableDefinition Name])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CollectionName, CreateCollection)
-> [((CollectionName, ListedQuery), [ExecutableDefinition Name])]
zipLQwithDef (QueryCollections -> [(CollectionName, CreateCollection)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList QueryCollections
qcs)

    formatError :: (CollectionName, ListedQuery) -> [Text] -> Text
    formatError :: (CollectionName, ListedQuery) -> [Text] -> Text
formatError (CollectionName
cName, ListedQuery
lq) [Text]
allErrs = Text
msgInit Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
lToTxt [Text]
allErrs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
faultyEndpoints Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
isInAllowList
      where
        msgInit :: Text
msgInit = Text
"In query collection \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CollectionName -> Text
forall a. ToTxt a => a -> Text
toTxt CollectionName
cName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" the query \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (QueryName -> Text
forall a. ToTxt a => a -> Text
toTxt (QueryName -> Text)
-> (ListedQuery -> QueryName) -> ListedQuery -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListedQuery -> QueryName
_lqName) ListedQuery
lq Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" is invalid with the following error(s): "
        lToTxt :: [Text] -> Text
lToTxt = [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
dquoteList ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse
        faultyEndpoints :: Text
faultyEndpoints = case EndpointTrie GQLQueryWithText -> ListedQuery -> [Text]
inRESTEndpoints EndpointTrie GQLQueryWithText
restEndpoints ListedQuery
lq of
          [] -> Text
""
          [Text]
ePoints -> Text
". This query is being used in the following REST endpoint(s): " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
lToTxt [Text]
ePoints

        isInAllowList :: Text
isInAllowList = if [NormalizedQuery] -> ListedQuery -> Bool
inAllowList [NormalizedQuery]
allowLst ListedQuery
lq then Text
". This query is in allowlist." else Text
""

    validateQuery :: ((CollectionName, ListedQuery), [ExecutableDefinition Name])
-> Either (MetadataObject, Text) ()
validateQuery ((CollectionName, ListedQuery)
eMeta, [ExecutableDefinition Name]
eDefs) = do
      -- create the gql request object
      let gqlRequest :: GQLReq GQLExecDoc
gqlRequest = Maybe OperationName
-> GQLExecDoc -> Maybe VariableValues -> GQLReq GQLExecDoc
forall a.
Maybe OperationName -> a -> Maybe VariableValues -> GQLReq a
GQLReq Maybe OperationName
forall a. Maybe a
Nothing ([ExecutableDefinition Name] -> GQLExecDoc
GQLExecDoc [ExecutableDefinition Name]
eDefs) Maybe VariableValues
forall a. Maybe a
Nothing

      -- @getSingleOperation@ will do the fragment inlining
      SingleOperation
singleOperation <- case GQLReq GQLExecDoc -> Either QErr SingleOperation
forall (m :: * -> *).
MonadError QErr m =>
GQLReq GQLExecDoc -> m SingleOperation
getSingleOperation GQLReq GQLExecDoc
gqlRequest of
        Left QErr
err -> (MetadataObject, Text)
-> Either (MetadataObject, Text) SingleOperation
forall a. (MetadataObject, Text) -> Either (MetadataObject, Text) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ((CollectionName, ListedQuery) -> MetadataObject
lqToMetadataObj (CollectionName, ListedQuery)
eMeta, (CollectionName, ListedQuery) -> [Text] -> Text
formatError (CollectionName, ListedQuery)
eMeta [QErr -> Text
qeError QErr
err])
        Right SingleOperation
singleOp -> SingleOperation -> Either (MetadataObject, Text) SingleOperation
forall a b. b -> Either a b
Right SingleOperation
singleOp

      -- perform the validation
      Maybe [Text]
-> ([Text] -> Either (MetadataObject, Text) Any)
-> Either (MetadataObject, Text) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (SchemaIntrospection -> SingleOperation -> Maybe [Text]
diagnoseGraphQLQuery SchemaIntrospection
rs SingleOperation
singleOperation) \[Text]
errors ->
        (MetadataObject, Text) -> Either (MetadataObject, Text) Any
forall a. (MetadataObject, Text) -> Either (MetadataObject, Text) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ((CollectionName, ListedQuery) -> MetadataObject
lqToMetadataObj (CollectionName, ListedQuery)
eMeta, (CollectionName, ListedQuery) -> [Text] -> Text
formatError (CollectionName, ListedQuery)
eMeta [Text]
errors)

data StoredIntrospection = StoredIntrospection
  { -- Just catalog introspection - not including enums
    StoredIntrospection -> HashMap SourceName EncJSON
siBackendIntrospection :: HashMap SourceName EncJSON,
    StoredIntrospection -> HashMap RemoteSchemaName EncJSON
siRemotes :: HashMap RemoteSchemaName EncJSON
  }
  deriving stock ((forall x. StoredIntrospection -> Rep StoredIntrospection x)
-> (forall x. Rep StoredIntrospection x -> StoredIntrospection)
-> Generic StoredIntrospection
forall x. Rep StoredIntrospection x -> StoredIntrospection
forall x. StoredIntrospection -> Rep StoredIntrospection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StoredIntrospection -> Rep StoredIntrospection x
from :: forall x. StoredIntrospection -> Rep StoredIntrospection x
$cto :: forall x. Rep StoredIntrospection x -> StoredIntrospection
to :: forall x. Rep StoredIntrospection x -> StoredIntrospection
Generic)

-- Note that we don't want to introduce an `Eq EncJSON` instance, as this is a
-- bit of a footgun. But for Stored Introspection purposes, it's fine: the
-- worst-case effect of a semantically inaccurate `Eq` instance is that we
-- rebuild the Schema Cache too often.
--
-- However, this does mean that we have to spell out this instance a bit.
instance Eq StoredIntrospection where
  StoredIntrospection HashMap SourceName EncJSON
bs1 HashMap RemoteSchemaName EncJSON
rs1 == :: StoredIntrospection -> StoredIntrospection -> Bool
== StoredIntrospection HashMap SourceName EncJSON
bs2 HashMap RemoteSchemaName EncJSON
rs2 =
    (EncJSON -> ByteString
encJToLBS (EncJSON -> ByteString)
-> HashMap SourceName EncJSON -> HashMap SourceName ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap SourceName EncJSON
bs1) HashMap SourceName ByteString
-> HashMap SourceName ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== (EncJSON -> ByteString
encJToLBS (EncJSON -> ByteString)
-> HashMap SourceName EncJSON -> HashMap SourceName ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap SourceName EncJSON
bs2) Bool -> Bool -> Bool
&& (EncJSON -> ByteString
encJToLBS (EncJSON -> ByteString)
-> HashMap RemoteSchemaName EncJSON
-> HashMap RemoteSchemaName ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap RemoteSchemaName EncJSON
rs1) HashMap RemoteSchemaName ByteString
-> HashMap RemoteSchemaName ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== (EncJSON -> ByteString
encJToLBS (EncJSON -> ByteString)
-> HashMap RemoteSchemaName EncJSON
-> HashMap RemoteSchemaName ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap RemoteSchemaName EncJSON
rs2)

instance FromJSON StoredIntrospection where
  parseJSON :: Value -> Parser StoredIntrospection
parseJSON = Options -> Value -> Parser StoredIntrospection
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

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

-- | Represents remote schema or source introspection data to be persisted in a storage (database).
data StoredIntrospectionItem
  = SourceIntrospectionItem SourceName EncJSON
  | RemoteSchemaIntrospectionItem RemoteSchemaName EncJSON

-- The same comment as above for `Eq StoredIntrospection` applies here as well: our refusal to have an `Eq EncJSON` instance means that we can't `stock`-derive this instance.
instance Eq StoredIntrospectionItem where
  SourceIntrospectionItem SourceName
lSource EncJSON
lIntrospection == :: StoredIntrospectionItem -> StoredIntrospectionItem -> Bool
== SourceIntrospectionItem SourceName
rSource EncJSON
rIntrospection =
    (SourceName
lSource SourceName -> SourceName -> Bool
forall a. Eq a => a -> a -> Bool
== SourceName
rSource) Bool -> Bool -> Bool
&& (EncJSON -> ByteString
encJToLBS EncJSON
lIntrospection) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== (EncJSON -> ByteString
encJToLBS EncJSON
rIntrospection)
  RemoteSchemaIntrospectionItem RemoteSchemaName
lRemoteSchema EncJSON
lIntrospection == RemoteSchemaIntrospectionItem RemoteSchemaName
rRemoteSchema EncJSON
rIntrospection =
    (RemoteSchemaName
lRemoteSchema RemoteSchemaName -> RemoteSchemaName -> Bool
forall a. Eq a => a -> a -> Bool
== RemoteSchemaName
rRemoteSchema) Bool -> Bool -> Bool
&& (EncJSON -> ByteString
encJToLBS EncJSON
lIntrospection) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== (EncJSON -> ByteString
encJToLBS EncJSON
rIntrospection)
  StoredIntrospectionItem
_ == StoredIntrospectionItem
_ = Bool
False

instance Show StoredIntrospectionItem where
  show :: StoredIntrospectionItem -> String
show = \case
    SourceIntrospectionItem SourceName
sourceName EncJSON
_ -> String
"introspection data of source " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SourceName -> String
forall a. Show a => a -> String
show SourceName
sourceName
    RemoteSchemaIntrospectionItem RemoteSchemaName
remoteSchemaName EncJSON
_ -> String
"introspection data of source " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RemoteSchemaName -> String
forall a. Show a => a -> String
show RemoteSchemaName
remoteSchemaName

-- | Items to be collected while building schema cache
-- See @'buildSchemaCacheRule' for more details.
data CollectItem
  = CollectInconsistentMetadata InconsistentMetadata
  | CollectMetadataDependency MetadataDependency
  | CollectStoredIntrospection StoredIntrospectionItem
  deriving (Int -> CollectItem -> ShowS
[CollectItem] -> ShowS
CollectItem -> String
(Int -> CollectItem -> ShowS)
-> (CollectItem -> String)
-> ([CollectItem] -> ShowS)
-> Show CollectItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CollectItem -> ShowS
showsPrec :: Int -> CollectItem -> ShowS
$cshow :: CollectItem -> String
show :: CollectItem -> String
$cshowList :: [CollectItem] -> ShowS
showList :: [CollectItem] -> ShowS
Show, CollectItem -> CollectItem -> Bool
(CollectItem -> CollectItem -> Bool)
-> (CollectItem -> CollectItem -> Bool) -> Eq CollectItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CollectItem -> CollectItem -> Bool
== :: CollectItem -> CollectItem -> Bool
$c/= :: CollectItem -> CollectItem -> Bool
/= :: CollectItem -> CollectItem -> Bool
Eq)