{-# LANGUAGE Arrows #-}
{-# LANGUAGE TemplateHaskell #-}
{-# 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
  ( CollectedInfo (..),
    partitionCollectedInfo,
    recordInconsistency,
    recordInconsistencyM,
    recordInconsistencies,
    recordDependencies,
    recordDependenciesM,
    withRecordInconsistency,
    withRecordInconsistencyM,
    CacheRWM (..),
    BuildReason (..),
    CacheInvalidations (..),
    MetadataM (..),
    MetadataT (..),
    runMetadataT,
    buildSchemaCacheWithInvalidations,
    buildSchemaCache,
    buildSchemaCacheFor,
    buildSchemaCacheStrict,
    withNewInconsistentObjsCheck,
    getInconsistentQueryCollections,
  )
where

import Control.Arrow.Extended
import Control.Lens
import Control.Monad.Morph
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson (Value, toJSON)
import Data.Aeson.TH
import Data.HashMap.Strict.Extended qualified as Map
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.HashMap.Strict.Multi qualified as MultiMap
import Data.List 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 Q
import Hasura.Backends.Postgres.Connection
import Hasura.Base.Error
import Hasura.GraphQL.Analyse
import Hasura.GraphQL.Transport.HTTP.Protocol
import Hasura.Prelude
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.RemoteSchema (RemoteSchemaName)
import Hasura.RQL.Types.SchemaCache
import Hasura.Server.Types
import Hasura.Session
import Hasura.Tracing (TraceT)
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Syntax qualified as G
import Network.HTTP.Client.Manager (HasHttpManagerM (..))

-- ----------------------------------------------------------------------------
-- types used during schema cache construction

data CollectedInfo
  = CIInconsistency InconsistentMetadata
  | CIDependency
      MetadataObject
      -- ^ for error reporting on missing dependencies
      SchemaObjId
      SchemaDependency
  deriving (CollectedInfo -> CollectedInfo -> Bool
(CollectedInfo -> CollectedInfo -> Bool)
-> (CollectedInfo -> CollectedInfo -> Bool) -> Eq CollectedInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollectedInfo -> CollectedInfo -> Bool
$c/= :: CollectedInfo -> CollectedInfo -> Bool
== :: CollectedInfo -> CollectedInfo -> Bool
$c== :: CollectedInfo -> CollectedInfo -> Bool
Eq)

$(makePrisms ''CollectedInfo)

class AsInconsistentMetadata s where
  _InconsistentMetadata :: Prism' s InconsistentMetadata

instance AsInconsistentMetadata InconsistentMetadata where
  _InconsistentMetadata :: p InconsistentMetadata (f InconsistentMetadata)
-> p InconsistentMetadata (f InconsistentMetadata)
_InconsistentMetadata = p InconsistentMetadata (f InconsistentMetadata)
-> p InconsistentMetadata (f InconsistentMetadata)
forall a. a -> a
id

instance AsInconsistentMetadata CollectedInfo where
  _InconsistentMetadata :: p InconsistentMetadata (f InconsistentMetadata)
-> p CollectedInfo (f CollectedInfo)
_InconsistentMetadata = p InconsistentMetadata (f InconsistentMetadata)
-> p CollectedInfo (f CollectedInfo)
Prism' CollectedInfo InconsistentMetadata
_CIInconsistency

partitionCollectedInfo ::
  Seq CollectedInfo ->
  ([InconsistentMetadata], [(MetadataObject, SchemaObjId, SchemaDependency)])
partitionCollectedInfo :: Seq CollectedInfo
-> ([InconsistentMetadata],
    [(MetadataObject, SchemaObjId, SchemaDependency)])
partitionCollectedInfo =
  ((CollectedInfo
  -> ([InconsistentMetadata],
      [(MetadataObject, SchemaObjId, SchemaDependency)])
  -> ([InconsistentMetadata],
      [(MetadataObject, SchemaObjId, SchemaDependency)]))
 -> ([InconsistentMetadata],
     [(MetadataObject, SchemaObjId, SchemaDependency)])
 -> Seq CollectedInfo
 -> ([InconsistentMetadata],
     [(MetadataObject, SchemaObjId, SchemaDependency)]))
-> ([InconsistentMetadata],
    [(MetadataObject, SchemaObjId, SchemaDependency)])
-> (CollectedInfo
    -> ([InconsistentMetadata],
        [(MetadataObject, SchemaObjId, SchemaDependency)])
    -> ([InconsistentMetadata],
        [(MetadataObject, SchemaObjId, SchemaDependency)]))
-> Seq CollectedInfo
-> ([InconsistentMetadata],
    [(MetadataObject, SchemaObjId, SchemaDependency)])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (CollectedInfo
 -> ([InconsistentMetadata],
     [(MetadataObject, SchemaObjId, SchemaDependency)])
 -> ([InconsistentMetadata],
     [(MetadataObject, SchemaObjId, SchemaDependency)]))
-> ([InconsistentMetadata],
    [(MetadataObject, SchemaObjId, SchemaDependency)])
-> Seq CollectedInfo
-> ([InconsistentMetadata],
    [(MetadataObject, SchemaObjId, SchemaDependency)])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([], []) \CollectedInfo
info ([InconsistentMetadata]
inconsistencies, [(MetadataObject, SchemaObjId, SchemaDependency)]
dependencies) -> case CollectedInfo
info of
    CIInconsistency InconsistentMetadata
inconsistency -> (InconsistentMetadata
inconsistency InconsistentMetadata
-> [InconsistentMetadata] -> [InconsistentMetadata]
forall a. a -> [a] -> [a]
: [InconsistentMetadata]
inconsistencies, [(MetadataObject, SchemaObjId, SchemaDependency)]
dependencies)
    CIDependency MetadataObject
metadataObject SchemaObjId
objectId SchemaDependency
schemaDependency ->
      let dependency :: (MetadataObject, SchemaObjId, SchemaDependency)
dependency = (MetadataObject
metadataObject, SchemaObjId
objectId, SchemaDependency
schemaDependency)
       in ([InconsistentMetadata]
inconsistencies, (MetadataObject, SchemaObjId, SchemaDependency)
dependency (MetadataObject, SchemaObjId, SchemaDependency)
-> [(MetadataObject, SchemaObjId, SchemaDependency)]
-> [(MetadataObject, SchemaObjId, SchemaDependency)]
forall a. a -> [a] -> [a]
: [(MetadataObject, SchemaObjId, SchemaDependency)]
dependencies)

recordInconsistency ::
  (ArrowWriter (Seq w) arr, AsInconsistentMetadata w) => ((Maybe Value, MetadataObject), Text) `arr` ()
recordInconsistency :: arr ((Maybe Value, MetadataObject), Text) ()
recordInconsistency = arr (Maybe Value, MetadataObject) [(Maybe Value, MetadataObject)]
-> arr
     ((Maybe Value, MetadataObject), Text)
     ([(Maybe Value, MetadataObject)], Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (((Maybe Value, MetadataObject) -> [(Maybe Value, MetadataObject)])
-> arr
     (Maybe Value, MetadataObject) [(Maybe Value, MetadataObject)]
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((Maybe Value, MetadataObject)
-> [(Maybe Value, MetadataObject)]
-> [(Maybe Value, MetadataObject)]
forall a. a -> [a] -> [a]
: [])) arr
  ((Maybe Value, MetadataObject), Text)
  ([(Maybe Value, MetadataObject)], Text)
-> arr ([(Maybe Value, MetadataObject)], Text) ()
-> arr ((Maybe Value, MetadataObject), Text) ()
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> arr ([(Maybe Value, MetadataObject)], Text) ()
forall w (arr :: * -> * -> *).
(ArrowWriter (Seq w) arr, AsInconsistentMetadata w) =>
arr ([(Maybe Value, MetadataObject)], Text) ()
recordInconsistencies'

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

recordInconsistencies ::
  (ArrowWriter (Seq w) arr, AsInconsistentMetadata w) => ([MetadataObject], Text) `arr` ()
recordInconsistencies :: arr ([MetadataObject], Text) ()
recordInconsistencies = arr [MetadataObject] [(Maybe Value, MetadataObject)]
-> arr
     ([MetadataObject], Text) ([(Maybe Value, MetadataObject)], Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (([MetadataObject] -> [(Maybe Value, MetadataObject)])
-> arr [MetadataObject] [(Maybe Value, MetadataObject)]
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((MetadataObject -> (Maybe Value, MetadataObject))
-> [MetadataObject] -> [(Maybe Value, MetadataObject)]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Value
forall a. Maybe a
Nothing,))) arr
  ([MetadataObject], Text) ([(Maybe Value, MetadataObject)], Text)
-> arr ([(Maybe Value, MetadataObject)], Text) ()
-> arr ([MetadataObject], Text) ()
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> arr ([(Maybe Value, MetadataObject)], Text) ()
forall w (arr :: * -> * -> *).
(ArrowWriter (Seq w) arr, AsInconsistentMetadata w) =>
arr ([(Maybe Value, MetadataObject)], Text) ()
recordInconsistencies'

recordInconsistenciesM' ::
  (MonadWriter (Seq w) m, AsInconsistentMetadata w) => [(Maybe Value, MetadataObject)] -> Text -> m ()
recordInconsistenciesM' :: [(Maybe Value, MetadataObject)] -> Text -> m ()
recordInconsistenciesM' [(Maybe Value, MetadataObject)]
metadataObjects Text
reason =
  Seq w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Seq w -> m ()) -> Seq w -> m ()
forall a b. (a -> b) -> a -> b
$ [w] -> Seq w
forall a. [a] -> Seq a
Seq.fromList ([w] -> Seq w) -> [w] -> Seq w
forall a b. (a -> b) -> a -> b
$ ((Maybe Value, MetadataObject) -> w)
-> [(Maybe Value, MetadataObject)] -> [w]
forall a b. (a -> b) -> [a] -> [b]
map (AReview w InconsistentMetadata -> InconsistentMetadata -> w
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview w InconsistentMetadata
forall s. AsInconsistentMetadata s => Prism' s InconsistentMetadata
_InconsistentMetadata (InconsistentMetadata -> w)
-> ((Maybe Value, MetadataObject) -> InconsistentMetadata)
-> (Maybe Value, MetadataObject)
-> w
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

recordInconsistencies' ::
  (ArrowWriter (Seq w) arr, AsInconsistentMetadata w) => ([(Maybe Value, MetadataObject)], Text) `arr` ()
recordInconsistencies' :: arr ([(Maybe Value, MetadataObject)], Text) ()
recordInconsistencies' = proc ([(Maybe Value, MetadataObject)]
metadataObjects, Text
reason) ->
  arr (Seq w) ()
forall w (arr :: * -> * -> *). ArrowWriter w arr => arr w ()
tellA -< [w] -> Seq w
forall a. [a] -> Seq a
Seq.fromList ([w] -> Seq w) -> [w] -> Seq w
forall a b. (a -> b) -> a -> b
$ ((Maybe Value, MetadataObject) -> w)
-> [(Maybe Value, MetadataObject)] -> [w]
forall a b. (a -> b) -> [a] -> [b]
map (AReview w InconsistentMetadata -> InconsistentMetadata -> w
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview w InconsistentMetadata
forall s. AsInconsistentMetadata s => Prism' s InconsistentMetadata
_InconsistentMetadata (InconsistentMetadata -> w)
-> ((Maybe Value, MetadataObject) -> InconsistentMetadata)
-> (Maybe Value, MetadataObject)
-> w
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

recordDependencies ::
  (ArrowWriter (Seq CollectedInfo) arr) =>
  (MetadataObject, SchemaObjId, [SchemaDependency]) `arr` ()
recordDependencies :: arr (MetadataObject, SchemaObjId, [SchemaDependency]) ()
recordDependencies = proc (MetadataObject
metadataObject, SchemaObjId
schemaObjectId, [SchemaDependency]
dependencies) ->
  arr (Seq CollectedInfo) ()
forall w (arr :: * -> * -> *). ArrowWriter w arr => arr w ()
tellA -< [CollectedInfo] -> Seq CollectedInfo
forall a. [a] -> Seq a
Seq.fromList ([CollectedInfo] -> Seq CollectedInfo)
-> [CollectedInfo] -> Seq CollectedInfo
forall a b. (a -> b) -> a -> b
$ (SchemaDependency -> CollectedInfo)
-> [SchemaDependency] -> [CollectedInfo]
forall a b. (a -> b) -> [a] -> [b]
map (MetadataObject -> SchemaObjId -> SchemaDependency -> CollectedInfo
CIDependency MetadataObject
metadataObject SchemaObjId
schemaObjectId) [SchemaDependency]
dependencies

recordDependenciesM ::
  (MonadWriter (Seq CollectedInfo) m) =>
  MetadataObject ->
  SchemaObjId ->
  [SchemaDependency] ->
  m ()
recordDependenciesM :: MetadataObject -> SchemaObjId -> [SchemaDependency] -> m ()
recordDependenciesM MetadataObject
metadataObject SchemaObjId
schemaObjectId [SchemaDependency]
dependencies = do
  Seq CollectedInfo -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Seq CollectedInfo -> m ()) -> Seq CollectedInfo -> m ()
forall a b. (a -> b) -> a -> b
$ [CollectedInfo] -> Seq CollectedInfo
forall a. [a] -> Seq a
Seq.fromList ([CollectedInfo] -> Seq CollectedInfo)
-> [CollectedInfo] -> Seq CollectedInfo
forall a b. (a -> b) -> a -> b
$ (SchemaDependency -> CollectedInfo)
-> [SchemaDependency] -> [CollectedInfo]
forall a b. (a -> b) -> [a] -> [b]
map (MetadataObject -> SchemaObjId -> SchemaDependency -> CollectedInfo
CIDependency MetadataObject
metadataObject SchemaObjId
schemaObjectId) [SchemaDependency]
dependencies

-- | Monadic version of 'withRecordInconsistency'
withRecordInconsistencyM ::
  (MonadWriter (Seq w) m, AsInconsistentMetadata w) =>
  MetadataObject ->
  ExceptT QErr m a ->
  m (Maybe a)
withRecordInconsistencyM :: 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 w (m :: * -> *).
(MonadWriter (Seq w) m, AsInconsistentMetadata w) =>
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 w (m :: * -> *).
(MonadWriter (Seq w) m, AsInconsistentMetadata w) =>
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 w (m :: * -> *).
(MonadWriter (Seq w) m, AsInconsistentMetadata w) =>
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Right a
v -> Maybe a -> m (Maybe 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

-- | Record any errors resulting from a computation as inconsistencies
withRecordInconsistency ::
  (ArrowChoice arr, ArrowWriter (Seq w) arr, AsInconsistentMetadata w) =>
  ErrorA QErr arr (e, s) a ->
  arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency :: ErrorA QErr arr (e, s) a -> arr (e, (MetadataObject, s)) (Maybe a)
withRecordInconsistency ErrorA QErr arr (e, s) a
f = proc (e
e, (MetadataObject
metadataObject, s
s)) -> do
  Either QErr a
result <- ErrorA QErr arr (e, s) a -> arr (e, s) (Either QErr a)
forall e (arr :: * -> * -> *) a 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, MetadataObject), Text) ()
forall w (arr :: * -> * -> *).
(ArrowWriter (Seq w) arr, AsInconsistentMetadata w) =>
arr ((Maybe Value, MetadataObject), Text) ()
recordInconsistency -< ((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) ->
          arr ((Maybe Value, MetadataObject), Text) ()
forall w (arr :: * -> * -> *).
(ArrowWriter (Seq w) arr, AsInconsistentMetadata w) =>
arr ((Maybe Value, MetadataObject), Text) ()
recordInconsistency -< ((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 ->
          arr ((Maybe Value, MetadataObject), Text) ()
forall w (arr :: * -> * -> *).
(ArrowWriter (Seq w) arr, AsInconsistentMetadata w) =>
arr ((Maybe Value, MetadataObject), Text) ()
recordInconsistency -< ((Maybe Value
forall a. Maybe a
Nothing, MetadataObject
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 withRecordInconsistency #-}

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

class (CacheRM m) => CacheRWM m where
  buildSchemaCacheWithOptions ::
    BuildReason -> CacheInvalidations -> Metadata -> m ()
  setMetadataResourceVersionInSchemaCache :: MetadataResourceVersion -> m ()

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
/= :: BuildReason -> BuildReason -> Bool
$c/= :: BuildReason -> BuildReason -> Bool
== :: BuildReason -> BuildReason -> Bool
$c== :: 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
showList :: [BuildReason] -> ShowS
$cshowList :: [BuildReason] -> ShowS
show :: BuildReason -> String
$cshow :: BuildReason -> String
showsPrec :: Int -> BuildReason -> ShowS
$cshowsPrec :: Int -> 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
  }

$(deriveJSON hasuraJSON ''CacheInvalidations)

instance Semigroup CacheInvalidations where
  CacheInvalidations Bool
a1 HashSet RemoteSchemaName
b1 HashSet SourceName
c1 <> :: CacheInvalidations -> CacheInvalidations -> CacheInvalidations
<> CacheInvalidations Bool
a2 HashSet RemoteSchemaName
b2 HashSet SourceName
c2 =
    Bool
-> HashSet RemoteSchemaName
-> HashSet SourceName
-> 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)

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

instance (CacheRWM m) => CacheRWM (ReaderT r m) where
  buildSchemaCacheWithOptions :: BuildReason -> CacheInvalidations -> Metadata -> ReaderT r m ()
buildSchemaCacheWithOptions BuildReason
a CacheInvalidations
b Metadata
c = m () -> ReaderT r m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ()) -> m () -> ReaderT r m ()
forall a b. (a -> b) -> a -> b
$ BuildReason -> CacheInvalidations -> Metadata -> m ()
forall (m :: * -> *).
CacheRWM m =>
BuildReason -> CacheInvalidations -> Metadata -> m ()
buildSchemaCacheWithOptions BuildReason
a CacheInvalidations
b Metadata
c
  setMetadataResourceVersionInSchemaCache :: MetadataResourceVersion -> ReaderT r m ()
setMetadataResourceVersionInSchemaCache = m () -> ReaderT r m ()
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
  buildSchemaCacheWithOptions :: BuildReason -> CacheInvalidations -> Metadata -> StateT s m ()
buildSchemaCacheWithOptions BuildReason
a CacheInvalidations
b Metadata
c = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ()) -> m () -> StateT s m ()
forall a b. (a -> b) -> a -> b
$ BuildReason -> CacheInvalidations -> Metadata -> m ()
forall (m :: * -> *).
CacheRWM m =>
BuildReason -> CacheInvalidations -> Metadata -> m ()
buildSchemaCacheWithOptions BuildReason
a CacheInvalidations
b Metadata
c
  setMetadataResourceVersionInSchemaCache :: MetadataResourceVersion -> StateT s m ()
setMetadataResourceVersionInSchemaCache = m () -> StateT s m ()
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
  buildSchemaCacheWithOptions :: BuildReason -> CacheInvalidations -> Metadata -> TraceT m ()
buildSchemaCacheWithOptions BuildReason
a CacheInvalidations
b Metadata
c = m () -> TraceT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> TraceT m ()) -> m () -> TraceT m ()
forall a b. (a -> b) -> a -> b
$ BuildReason -> CacheInvalidations -> Metadata -> m ()
forall (m :: * -> *).
CacheRWM m =>
BuildReason -> CacheInvalidations -> Metadata -> m ()
buildSchemaCacheWithOptions BuildReason
a CacheInvalidations
b Metadata
c
  setMetadataResourceVersionInSchemaCache :: MetadataResourceVersion -> TraceT m ()
setMetadataResourceVersionInSchemaCache = m () -> TraceT m ()
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 (Q.TxET QErr m) where
  buildSchemaCacheWithOptions :: BuildReason -> CacheInvalidations -> Metadata -> TxET QErr m ()
buildSchemaCacheWithOptions BuildReason
a CacheInvalidations
b Metadata
c = m () -> TxET QErr m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> TxET QErr m ()) -> m () -> TxET QErr m ()
forall a b. (a -> b) -> a -> b
$ BuildReason -> CacheInvalidations -> Metadata -> m ()
forall (m :: * -> *).
CacheRWM m =>
BuildReason -> CacheInvalidations -> Metadata -> m ()
buildSchemaCacheWithOptions BuildReason
a CacheInvalidations
b Metadata
c
  setMetadataResourceVersionInSchemaCache :: MetadataResourceVersion -> TxET QErr m ()
setMetadataResourceVersionInSchemaCache = m () -> TxET QErr m ()
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 {MetadataT m a -> StateT Metadata m a
unMetadataT :: StateT Metadata m a}
  deriving
    ( a -> MetadataT m b -> MetadataT m a
(a -> b) -> MetadataT m a -> MetadataT m b
(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
<$ :: a -> MetadataT m b -> MetadataT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> MetadataT m b -> MetadataT m a
fmap :: (a -> b) -> MetadataT m a -> MetadataT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MetadataT m a -> MetadataT m b
Functor,
      Functor (MetadataT m)
a -> MetadataT m a
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)
MetadataT m a -> MetadataT m b -> MetadataT m b
MetadataT m a -> MetadataT m b -> MetadataT m a
MetadataT m (a -> b) -> MetadataT m a -> MetadataT m b
(a -> b -> c) -> MetadataT m a -> MetadataT m b -> MetadataT m c
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
<* :: MetadataT m a -> MetadataT m b -> MetadataT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
MetadataT m a -> MetadataT m b -> MetadataT m a
*> :: MetadataT m a -> MetadataT m b -> MetadataT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
MetadataT m a -> MetadataT m b -> MetadataT m b
liftA2 :: (a -> b -> c) -> MetadataT m a -> MetadataT m b -> MetadataT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> MetadataT m a -> MetadataT m b -> MetadataT m c
<*> :: MetadataT m (a -> b) -> MetadataT m a -> MetadataT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
MetadataT m (a -> b) -> MetadataT m a -> MetadataT m b
pure :: a -> MetadataT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> MetadataT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (MetadataT m)
Applicative,
      Applicative (MetadataT m)
a -> MetadataT m a
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)
MetadataT m a -> (a -> MetadataT m b) -> MetadataT m b
MetadataT m a -> MetadataT m b -> MetadataT m b
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
return :: a -> MetadataT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> MetadataT m a
>> :: MetadataT m a -> MetadataT m b -> MetadataT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
MetadataT m a -> MetadataT m b -> MetadataT m b
>>= :: MetadataT m a -> (a -> MetadataT m b) -> MetadataT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
MetadataT m a -> (a -> MetadataT m b) -> MetadataT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (MetadataT m)
Monad,
      m a -> MetadataT m a
(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
lift :: m a -> MetadataT m a
$clift :: 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)
IO a -> MetadataT m a
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
liftIO :: IO a -> MetadataT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> MetadataT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (MetadataT m)
MonadIO,
      MonadReader r,
      MonadError e,
      MonadError QErr (MetadataT m)
MonadError QErr (MetadataT m)
-> (forall a. TxE QErr a -> MetadataT m a) -> MonadTx (MetadataT m)
TxE QErr a -> MetadataT m a
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
liftTx :: TxE QErr a -> MetadataT m a
$cliftTx :: forall (m :: * -> *) a. MonadTx m => TxE QErr a -> MetadataT m a
$cp1MonadTx :: forall (m :: * -> *). MonadTx m => MonadError QErr (MetadataT m)
MonadTx,
      Monad (MetadataT m)
MetadataT m SourceName
Monad (MetadataT m)
-> MetadataT m SourceName -> SourceM (MetadataT m)
forall (m :: * -> *). Monad m -> m SourceName -> SourceM m
forall (m :: * -> *). SourceM m => Monad (MetadataT m)
forall (m :: * -> *). SourceM m => MetadataT m SourceName
askCurrentSource :: MetadataT m SourceName
$caskCurrentSource :: forall (m :: * -> *). SourceM m => MetadataT m SourceName
$cp1SourceM :: forall (m :: * -> *). SourceM m => Monad (MetadataT m)
SourceM,
      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
askSchemaCache :: MetadataT m SchemaCache
$caskSchemaCache :: forall (m :: * -> *). CacheRM m => MetadataT m SchemaCache
$cp1CacheRM :: forall (m :: * -> *). CacheRM m => Monad (MetadataT m)
CacheRM,
      CacheRM (MetadataT m)
MetadataResourceVersion -> MetadataT m ()
CacheRM (MetadataT m)
-> (BuildReason
    -> CacheInvalidations -> Metadata -> MetadataT m ())
-> (MetadataResourceVersion -> MetadataT m ())
-> CacheRWM (MetadataT m)
BuildReason -> CacheInvalidations -> Metadata -> MetadataT m ()
forall (m :: * -> *).
CacheRM m
-> (BuildReason -> CacheInvalidations -> Metadata -> m ())
-> (MetadataResourceVersion -> m ())
-> CacheRWM m
forall (m :: * -> *). CacheRWM m => CacheRM (MetadataT m)
forall (m :: * -> *).
CacheRWM m =>
MetadataResourceVersion -> MetadataT m ()
forall (m :: * -> *).
CacheRWM m =>
BuildReason -> CacheInvalidations -> Metadata -> MetadataT m ()
setMetadataResourceVersionInSchemaCache :: MetadataResourceVersion -> MetadataT m ()
$csetMetadataResourceVersionInSchemaCache :: forall (m :: * -> *).
CacheRWM m =>
MetadataResourceVersion -> MetadataT m ()
buildSchemaCacheWithOptions :: BuildReason -> CacheInvalidations -> Metadata -> MetadataT m ()
$cbuildSchemaCacheWithOptions :: forall (m :: * -> *).
CacheRWM m =>
BuildReason -> CacheInvalidations -> Metadata -> MetadataT m ()
$cp1CacheRWM :: forall (m :: * -> *). CacheRWM m => CacheRM (MetadataT m)
CacheRWM,
      (forall a. m a -> n a) -> MetadataT m b -> MetadataT n b
(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
hoist :: (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
MFunctor,
      Monad (MetadataT m)
MetadataT m TraceContext
MetadataT m Reporter
Monad (MetadataT m)
-> (forall a. Text -> MetadataT m a -> MetadataT m a)
-> MetadataT m TraceContext
-> MetadataT m Reporter
-> (TracingMetadata -> MetadataT m ())
-> MonadTrace (MetadataT m)
TracingMetadata -> MetadataT m ()
Text -> MetadataT m a -> MetadataT m a
forall a. Text -> MetadataT m a -> MetadataT m a
forall (m :: * -> *).
Monad m
-> (forall a. Text -> m a -> m a)
-> m TraceContext
-> m Reporter
-> (TracingMetadata -> m ())
-> MonadTrace m
forall (m :: * -> *). MonadTrace m => Monad (MetadataT m)
forall (m :: * -> *). MonadTrace m => MetadataT m TraceContext
forall (m :: * -> *). MonadTrace m => MetadataT m Reporter
forall (m :: * -> *).
MonadTrace m =>
TracingMetadata -> MetadataT m ()
forall (m :: * -> *) a.
MonadTrace m =>
Text -> MetadataT m a -> MetadataT m a
attachMetadata :: TracingMetadata -> MetadataT m ()
$cattachMetadata :: forall (m :: * -> *).
MonadTrace m =>
TracingMetadata -> MetadataT m ()
currentReporter :: MetadataT m Reporter
$ccurrentReporter :: forall (m :: * -> *). MonadTrace m => MetadataT m Reporter
currentContext :: MetadataT m TraceContext
$ccurrentContext :: forall (m :: * -> *). MonadTrace m => MetadataT m TraceContext
trace :: Text -> MetadataT m a -> MetadataT m a
$ctrace :: forall (m :: * -> *) a.
MonadTrace m =>
Text -> MetadataT m a -> MetadataT m a
$cp1MonadTrace :: forall (m :: * -> *). MonadTrace m => Monad (MetadataT m)
Tracing.MonadTrace,
      MonadBase b,
      MonadBaseControl b
    )

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 (HasHttpManagerM m) => HasHttpManagerM (MetadataT m) where
  askHttpManager :: MetadataT m Manager
askHttpManager = m Manager -> MetadataT m Manager
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Manager
forall (m :: * -> *). HasHttpManagerM m => m Manager
askHttpManager

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

instance HasServerConfigCtx m => HasServerConfigCtx (MetadataT m) where
  askServerConfigCtx :: MetadataT m ServerConfigCtx
askServerConfigCtx = m ServerConfigCtx -> MetadataT m ServerConfigCtx
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ServerConfigCtx
forall (m :: * -> *). HasServerConfigCtx m => m ServerConfigCtx
askServerConfigCtx

runMetadataT :: Metadata -> MetadataT m a -> m (a, Metadata)
runMetadataT :: Metadata -> MetadataT m a -> m (a, Metadata)
runMetadataT Metadata
metadata (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

buildSchemaCacheWithInvalidations :: (MetadataM m, CacheRWM m) => CacheInvalidations -> MetadataModifier -> m ()
buildSchemaCacheWithInvalidations :: CacheInvalidations -> MetadataModifier -> m ()
buildSchemaCacheWithInvalidations CacheInvalidations
cacheInvalidations MetadataModifier {Metadata -> Metadata
runMetadataModifier :: MetadataModifier -> Metadata -> Metadata
runMetadataModifier :: 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 -> m ()
forall (m :: * -> *).
CacheRWM m =>
BuildReason -> CacheInvalidations -> Metadata -> m ()
buildSchemaCacheWithOptions (Maybe (HashSet SourceName) -> BuildReason
CatalogUpdate Maybe (HashSet SourceName)
forall a. Monoid a => a
mempty) CacheInvalidations
cacheInvalidations Metadata
modifiedMetadata
  Metadata -> m ()
forall (m :: * -> *). MetadataM m => Metadata -> m ()
putMetadata Metadata
modifiedMetadata

buildSchemaCache :: (MetadataM m, CacheRWM m) => MetadataModifier -> m ()
buildSchemaCache :: 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. 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 :: MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor MetadataObjId
objectId MetadataModifier
metadataModifier = do
  SchemaCache
oldSchemaCache <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache MetadataModifier
metadataModifier
  SchemaCache
newSchemaCache <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache

  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
Map.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

  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
Map.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 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 (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 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 (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]
Map.elems HashMap MetadataObjId (NonEmpty InconsistentMetadata)
newInconsistentObjects)
        }

-- | Like 'buildSchemaCache', but fails if there is any inconsistent metadata.
buildSchemaCacheStrict :: (QErrM m, CacheRWM m, MetadataM m) => m ()
buildSchemaCacheStrict :: m ()
buildSchemaCacheStrict = do
  MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache MetadataModifier
forall a. Monoid a => a
mempty
  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 (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 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 :: 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
Map.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. (Hashable a, Eq a) => [a] -> [a]
hashNub ([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 (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]
Map.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 (t :: * -> *) a. Foldable t => t a -> Bool
null [InconsistentMetadata]
newInconsistentObjects) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    QErr -> m ()
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 (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 ::
  (MonadError QErr m) =>
  G.SchemaIntrospection ->
  QueryCollections ->
  ((CollectionName, ListedQuery) -> MetadataObject) ->
  EndpointTrie GQLQueryWithText ->
  [NormalizedQuery] ->
  m [InconsistentMetadata]
getInconsistentQueryCollections :: SchemaIntrospection
-> QueryCollections
-> ((CollectionName, ListedQuery) -> MetadataObject)
-> EndpointTrie GQLQueryWithText
-> [NormalizedQuery]
-> m [InconsistentMetadata]
getInconsistentQueryCollections SchemaIntrospection
rs QueryCollections
qcs (CollectionName, ListedQuery) -> MetadataObject
lqToMetadataObj EndpointTrie GQLQueryWithText
restEndpoints [NormalizedQuery]
allowLst = do
  [(MetadataObject, Text)]
inconsistentMetaObjs <- [Either (MetadataObject, Text) ()] -> [(MetadataObject, Text)]
forall a b. [Either a b] -> [a]
lefts ([Either (MetadataObject, Text) ()] -> [(MetadataObject, Text)])
-> m [Either (MetadataObject, Text) ()]
-> m [(MetadataObject, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((CollectionName, ListedQuery), [ExecutableDefinition Name])
 -> m (Either (MetadataObject, Text) ()))
-> [((CollectionName, ListedQuery), [ExecutableDefinition Name])]
-> m [Either (MetadataObject, Text) ()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (SchemaIntrospection
-> ((CollectionName, ListedQuery) -> MetadataObject)
-> ((CollectionName, ListedQuery) -> [Text] -> Text)
-> ((CollectionName, ListedQuery), [ExecutableDefinition Name])
-> m (Either (MetadataObject, Text) ())
forall (m :: * -> *) a.
MonadError QErr m =>
SchemaIntrospection
-> (a -> MetadataObject)
-> (a -> [Text] -> Text)
-> (a, [ExecutableDefinition Name])
-> m (Either (MetadataObject, Text) ())
validateQuery SchemaIntrospection
rs ((CollectionName, ListedQuery) -> MetadataObject
lqToMetadataObj) (CollectionName, ListedQuery) -> [Text] -> Text
formatError) [((CollectionName, ListedQuery), [ExecutableDefinition Name])]
lqLst
  [InconsistentMetadata] -> m [InconsistentMetadata]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([InconsistentMetadata] -> m [InconsistentMetadata])
-> [InconsistentMetadata] -> m [InconsistentMetadata]
forall a b. (a -> b) -> a -> b
$ ((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
    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]
nqList (ListedQuery {GQLQueryWithText
QueryName
_lqName :: ListedQuery -> QueryName
_lqQuery :: GQLQueryWithText
_lqName :: QueryName
_lqQuery :: ListedQuery -> GQLQueryWithText
..}) = (NormalizedQuery -> Bool) -> [NormalizedQuery] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\NormalizedQuery
nq -> NormalizedQuery -> ExecutableDocument Name
unNormalizedQuery NormalizedQuery
nq 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]
nqList

    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)]
OMap.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 ::
  (MonadError QErr m) =>
  G.SchemaIntrospection ->
  (a -> MetadataObject) ->
  (a -> [Text] -> Text) ->
  (a, [G.ExecutableDefinition G.Name]) ->
  m (Either (MetadataObject, Text) ())
validateQuery :: SchemaIntrospection
-> (a -> MetadataObject)
-> (a -> [Text] -> Text)
-> (a, [ExecutableDefinition Name])
-> m (Either (MetadataObject, Text) ())
validateQuery SchemaIntrospection
rSchema a -> MetadataObject
getMetaObj a -> [Text] -> Text
formatError (a
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 <- GQLReq GQLExecDoc -> m SingleOperation
forall (m :: * -> *).
MonadError QErr m =>
GQLReq GQLExecDoc -> m SingleOperation
getSingleOperation GQLReq GQLExecDoc
gqlRequest

  -- perform the validation
  Either (MetadataObject, Text) ()
-> m (Either (MetadataObject, Text) ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (MetadataObject, Text) ()
 -> m (Either (MetadataObject, Text) ()))
-> Either (MetadataObject, Text) ()
-> m (Either (MetadataObject, Text) ())
forall a b. (a -> b) -> a -> b
$ case SchemaIntrospection -> SingleOperation -> Maybe [Text]
diagnoseGraphQLQuery SchemaIntrospection
rSchema SingleOperation
singleOperation of
    Maybe [Text]
Nothing -> () -> Either (MetadataObject, Text) ()
forall a b. b -> Either a b
Right ()
    Just [Text]
errors -> (MetadataObject, Text) -> Either (MetadataObject, Text) ()
forall a b. a -> Either a b
Left (a -> MetadataObject
getMetaObj a
eMeta, a -> [Text] -> Text
formatError a
eMeta [Text]
errors)