module Hasura.RemoteSchema.MetadataAPI.Core
  ( AddRemoteSchemaQuery (..),
    RemoteSchemaNameQuery (..),
    runAddRemoteSchema,
    runRemoveRemoteSchema,
    dropRemoteSchemaInMetadata,
    runReloadRemoteSchema,
    runIntrospectRemoteSchema,
    dropRemoteSchemaPermissionInMetadata,
    dropRemoteSchemaRemoteRelationshipInMetadata,
    runUpdateRemoteSchema,
  )
where

import Data.Aeson qualified as J
import Data.Environment qualified as Env
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.HashSet qualified as S
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.RemoteServer
import Hasura.Prelude
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.Roles (RoleName)
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.RemoteSchema.Metadata
import Hasura.RemoteSchema.SchemaCache.Build (addRemoteSchemaP2Setup)
import Hasura.RemoteSchema.SchemaCache.Types
import Hasura.Services
import Hasura.Session (UserInfoM)
import Hasura.Tracing qualified as Tracing

-- | The payload for 'add_remote_schema', and a component of 'Metadata'.
data AddRemoteSchemaQuery = AddRemoteSchemaQuery
  { -- | An internal identifier for this remote schema.
    AddRemoteSchemaQuery -> RemoteSchemaName
_arsqName :: RemoteSchemaName,
    AddRemoteSchemaQuery -> RemoteSchemaDef
_arsqDefinition :: RemoteSchemaDef,
    -- | An opaque description or comment. We might display this in the UI, for instance.
    AddRemoteSchemaQuery -> Maybe Text
_arsqComment :: Maybe Text
  }
  deriving (Int -> AddRemoteSchemaQuery -> ShowS
[AddRemoteSchemaQuery] -> ShowS
AddRemoteSchemaQuery -> String
(Int -> AddRemoteSchemaQuery -> ShowS)
-> (AddRemoteSchemaQuery -> String)
-> ([AddRemoteSchemaQuery] -> ShowS)
-> Show AddRemoteSchemaQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddRemoteSchemaQuery -> ShowS
showsPrec :: Int -> AddRemoteSchemaQuery -> ShowS
$cshow :: AddRemoteSchemaQuery -> String
show :: AddRemoteSchemaQuery -> String
$cshowList :: [AddRemoteSchemaQuery] -> ShowS
showList :: [AddRemoteSchemaQuery] -> ShowS
Show, AddRemoteSchemaQuery -> AddRemoteSchemaQuery -> Bool
(AddRemoteSchemaQuery -> AddRemoteSchemaQuery -> Bool)
-> (AddRemoteSchemaQuery -> AddRemoteSchemaQuery -> Bool)
-> Eq AddRemoteSchemaQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddRemoteSchemaQuery -> AddRemoteSchemaQuery -> Bool
== :: AddRemoteSchemaQuery -> AddRemoteSchemaQuery -> Bool
$c/= :: AddRemoteSchemaQuery -> AddRemoteSchemaQuery -> Bool
/= :: AddRemoteSchemaQuery -> AddRemoteSchemaQuery -> Bool
Eq, (forall x. AddRemoteSchemaQuery -> Rep AddRemoteSchemaQuery x)
-> (forall x. Rep AddRemoteSchemaQuery x -> AddRemoteSchemaQuery)
-> Generic AddRemoteSchemaQuery
forall x. Rep AddRemoteSchemaQuery x -> AddRemoteSchemaQuery
forall x. AddRemoteSchemaQuery -> Rep AddRemoteSchemaQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AddRemoteSchemaQuery -> Rep AddRemoteSchemaQuery x
from :: forall x. AddRemoteSchemaQuery -> Rep AddRemoteSchemaQuery x
$cto :: forall x. Rep AddRemoteSchemaQuery x -> AddRemoteSchemaQuery
to :: forall x. Rep AddRemoteSchemaQuery x -> AddRemoteSchemaQuery
Generic)

instance NFData AddRemoteSchemaQuery

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

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

newtype RemoteSchemaNameQuery = RemoteSchemaNameQuery
  { RemoteSchemaNameQuery -> RemoteSchemaName
_rsnqName :: RemoteSchemaName
  }
  deriving (Int -> RemoteSchemaNameQuery -> ShowS
[RemoteSchemaNameQuery] -> ShowS
RemoteSchemaNameQuery -> String
(Int -> RemoteSchemaNameQuery -> ShowS)
-> (RemoteSchemaNameQuery -> String)
-> ([RemoteSchemaNameQuery] -> ShowS)
-> Show RemoteSchemaNameQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteSchemaNameQuery -> ShowS
showsPrec :: Int -> RemoteSchemaNameQuery -> ShowS
$cshow :: RemoteSchemaNameQuery -> String
show :: RemoteSchemaNameQuery -> String
$cshowList :: [RemoteSchemaNameQuery] -> ShowS
showList :: [RemoteSchemaNameQuery] -> ShowS
Show, RemoteSchemaNameQuery -> RemoteSchemaNameQuery -> Bool
(RemoteSchemaNameQuery -> RemoteSchemaNameQuery -> Bool)
-> (RemoteSchemaNameQuery -> RemoteSchemaNameQuery -> Bool)
-> Eq RemoteSchemaNameQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RemoteSchemaNameQuery -> RemoteSchemaNameQuery -> Bool
== :: RemoteSchemaNameQuery -> RemoteSchemaNameQuery -> Bool
$c/= :: RemoteSchemaNameQuery -> RemoteSchemaNameQuery -> Bool
/= :: RemoteSchemaNameQuery -> RemoteSchemaNameQuery -> Bool
Eq, (forall x. RemoteSchemaNameQuery -> Rep RemoteSchemaNameQuery x)
-> (forall x. Rep RemoteSchemaNameQuery x -> RemoteSchemaNameQuery)
-> Generic RemoteSchemaNameQuery
forall x. Rep RemoteSchemaNameQuery x -> RemoteSchemaNameQuery
forall x. RemoteSchemaNameQuery -> Rep RemoteSchemaNameQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoteSchemaNameQuery -> Rep RemoteSchemaNameQuery x
from :: forall x. RemoteSchemaNameQuery -> Rep RemoteSchemaNameQuery x
$cto :: forall x. Rep RemoteSchemaNameQuery x -> RemoteSchemaNameQuery
to :: forall x. Rep RemoteSchemaNameQuery x -> RemoteSchemaNameQuery
Generic)

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

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

runAddRemoteSchema ::
  ( QErrM m,
    CacheRWM m,
    MonadIO m,
    ProvidesNetwork m,
    MetadataM m,
    Tracing.MonadTrace m
  ) =>
  Env.Environment ->
  AddRemoteSchemaQuery ->
  m EncJSON
runAddRemoteSchema :: forall (m :: * -> *).
(QErrM m, CacheRWM m, MonadIO m, ProvidesNetwork m, MetadataM m,
 MonadTrace m) =>
Environment -> AddRemoteSchemaQuery -> m EncJSON
runAddRemoteSchema Environment
env (AddRemoteSchemaQuery RemoteSchemaName
name RemoteSchemaDef
defn Maybe Text
comment) = do
  RemoteSchemaName -> m ()
forall (m :: * -> *).
(QErrM m, CacheRM m) =>
RemoteSchemaName -> m ()
addRemoteSchemaP1 RemoteSchemaName
name
  m (IntrospectionResult, ByteString, RemoteSchemaInfo) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (IntrospectionResult, ByteString, RemoteSchemaInfo) -> m ())
-> m (IntrospectionResult, ByteString, RemoteSchemaInfo) -> m ()
forall a b. (a -> b) -> a -> b
$ Environment
-> RemoteSchemaDef
-> m (IntrospectionResult, ByteString, RemoteSchemaInfo)
forall (m :: * -> *).
(QErrM m, MonadIO m, ProvidesNetwork m, MonadTrace m) =>
Environment
-> RemoteSchemaDef
-> m (IntrospectionResult, ByteString, RemoteSchemaInfo)
addRemoteSchemaP2Setup Environment
env RemoteSchemaDef
defn
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor (RemoteSchemaName -> MetadataObjId
MORemoteSchema RemoteSchemaName
name)
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (RemoteSchemas -> Identity RemoteSchemas)
-> Metadata -> Identity Metadata
Lens' Metadata RemoteSchemas
metaRemoteSchemas
    ((RemoteSchemas -> Identity RemoteSchemas)
 -> Metadata -> Identity Metadata)
-> (RemoteSchemas -> RemoteSchemas) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RemoteSchemaName
-> RemoteSchemaMetadata -> RemoteSchemas -> RemoteSchemas
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert RemoteSchemaName
name RemoteSchemaMetadata
remoteSchemaMeta
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg
  where
    -- NOTE: permissions here are empty, manipulated via a separate API with
    -- runAddRemoteSchemaPermissions below
    remoteSchemaMeta :: RemoteSchemaMetadata
remoteSchemaMeta = RemoteSchemaName
-> RemoteSchemaDef
-> Maybe Text
-> [RemoteSchemaPermissionMetadata]
-> SchemaRemoteRelationships RemoteRelationshipDefinition
-> RemoteSchemaMetadata
forall r.
RemoteSchemaName
-> RemoteSchemaDef
-> Maybe Text
-> [RemoteSchemaPermissionMetadata]
-> SchemaRemoteRelationships r
-> RemoteSchemaMetadataG r
RemoteSchemaMetadata RemoteSchemaName
name RemoteSchemaDef
defn Maybe Text
comment [RemoteSchemaPermissionMetadata]
forall a. Monoid a => a
mempty SchemaRemoteRelationships RemoteRelationshipDefinition
forall a. Monoid a => a
mempty

addRemoteSchemaP1 ::
  (QErrM m, CacheRM m) =>
  RemoteSchemaName ->
  m ()
addRemoteSchemaP1 :: forall (m :: * -> *).
(QErrM m, CacheRM m) =>
RemoteSchemaName -> m ()
addRemoteSchemaP1 RemoteSchemaName
name = do
  [RemoteSchemaName]
remoteSchemaNames <- SchemaCache -> [RemoteSchemaName]
getAllRemoteSchemas (SchemaCache -> [RemoteSchemaName])
-> m SchemaCache -> m [RemoteSchemaName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RemoteSchemaName
name RemoteSchemaName -> [RemoteSchemaName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RemoteSchemaName]
remoteSchemaNames)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
AlreadyExists
    (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"remote schema with name "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoteSchemaName
name
    RemoteSchemaName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" already exists"

runRemoveRemoteSchema ::
  (QErrM m, UserInfoM m, CacheRWM m, MetadataM m) =>
  RemoteSchemaNameQuery ->
  m EncJSON
runRemoveRemoteSchema :: forall (m :: * -> *).
(QErrM m, UserInfoM m, CacheRWM m, MetadataM m) =>
RemoteSchemaNameQuery -> m EncJSON
runRemoveRemoteSchema (RemoteSchemaNameQuery RemoteSchemaName
rsn) = do
  m [RoleName] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [RoleName] -> m ()) -> m [RoleName] -> m ()
forall a b. (a -> b) -> a -> b
$ RemoteSchemaName -> m [RoleName]
forall (m :: * -> *).
(UserInfoM m, QErrM m, CacheRM m) =>
RemoteSchemaName -> m [RoleName]
removeRemoteSchemaP1 RemoteSchemaName
rsn
  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ RemoteSchemaName -> MetadataModifier
dropRemoteSchemaInMetadata RemoteSchemaName
rsn
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

removeRemoteSchemaP1 ::
  (UserInfoM m, QErrM m, CacheRM m) =>
  RemoteSchemaName ->
  m [RoleName]
removeRemoteSchemaP1 :: forall (m :: * -> *).
(UserInfoM m, QErrM m, CacheRM m) =>
RemoteSchemaName -> m [RoleName]
removeRemoteSchemaP1 RemoteSchemaName
rsn = do
  SchemaCache
sc <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  let rmSchemas :: RemoteSchemaMap
rmSchemas = SchemaCache -> RemoteSchemaMap
scRemoteSchemas SchemaCache
sc
  m RemoteSchemaCtx -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    (m RemoteSchemaCtx -> m ()) -> m RemoteSchemaCtx -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe RemoteSchemaCtx -> m RemoteSchemaCtx -> m RemoteSchemaCtx
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (RemoteSchemaName -> RemoteSchemaMap -> Maybe RemoteSchemaCtx
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup RemoteSchemaName
rsn RemoteSchemaMap
rmSchemas)
    (m RemoteSchemaCtx -> m RemoteSchemaCtx)
-> m RemoteSchemaCtx -> m RemoteSchemaCtx
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m RemoteSchemaCtx
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists Text
"no such remote schema"
  let depObjs :: [SchemaObjId]
depObjs = SchemaCache -> SchemaObjId -> [SchemaObjId]
getDependentObjs SchemaCache
sc SchemaObjId
remoteSchemaDepId
      roles :: [RoleName]
roles = (SchemaObjId -> Maybe RoleName) -> [SchemaObjId] -> [RoleName]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe SchemaObjId -> Maybe RoleName
getRole [SchemaObjId]
depObjs
      nonPermDependentObjs :: [SchemaObjId]
nonPermDependentObjs = (SchemaObjId -> Bool) -> [SchemaObjId] -> [SchemaObjId]
forall a. (a -> Bool) -> [a] -> [a]
filter SchemaObjId -> Bool
nonPermDependentObjPredicate [SchemaObjId]
depObjs
  -- report non permission dependencies (if any), this happens
  -- mostly when a remote relationship is defined with
  -- the current remote schema

  -- we only report the non permission dependencies because we
  -- drop the related permissions
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SchemaObjId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SchemaObjId]
nonPermDependentObjs) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [SchemaObjId] -> m ()
forall (m :: * -> *). MonadError QErr m => [SchemaObjId] -> m ()
reportDependentObjectsExist [SchemaObjId]
nonPermDependentObjs
  [RoleName] -> m [RoleName]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [RoleName]
roles
  where
    remoteSchemaDepId :: SchemaObjId
remoteSchemaDepId = RemoteSchemaName -> SchemaObjId
SORemoteSchema RemoteSchemaName
rsn

    getRole :: SchemaObjId -> Maybe RoleName
getRole SchemaObjId
depObj =
      case SchemaObjId
depObj of
        SORemoteSchemaPermission RemoteSchemaName
_ RoleName
role -> RoleName -> Maybe RoleName
forall a. a -> Maybe a
Just RoleName
role
        SchemaObjId
_ -> Maybe RoleName
forall a. Maybe a
Nothing

    nonPermDependentObjPredicate :: SchemaObjId -> Bool
nonPermDependentObjPredicate (SORemoteSchemaPermission RemoteSchemaName
_ RoleName
_) = Bool
False
    nonPermDependentObjPredicate SchemaObjId
_ = Bool
True

runReloadRemoteSchema ::
  (QErrM m, CacheRWM m, MetadataM m) =>
  RemoteSchemaNameQuery ->
  m EncJSON
runReloadRemoteSchema :: forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
RemoteSchemaNameQuery -> m EncJSON
runReloadRemoteSchema (RemoteSchemaNameQuery RemoteSchemaName
name) = do
  [RemoteSchemaName]
remoteSchemas <- SchemaCache -> [RemoteSchemaName]
getAllRemoteSchemas (SchemaCache -> [RemoteSchemaName])
-> m SchemaCache -> m [RemoteSchemaName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RemoteSchemaName
name RemoteSchemaName -> [RemoteSchemaName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RemoteSchemaName]
remoteSchemas)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
    (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"remote schema with name "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoteSchemaName
name
    RemoteSchemaName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist"

  let invalidations :: CacheInvalidations
invalidations = CacheInvalidations
forall a. Monoid a => a
mempty {ciRemoteSchemas :: HashSet RemoteSchemaName
ciRemoteSchemas = RemoteSchemaName -> HashSet RemoteSchemaName
forall a. Hashable a => a -> HashSet a
S.singleton RemoteSchemaName
name}
  Metadata
metadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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. Maybe a
Nothing) CacheInvalidations
invalidations Metadata
metadata Maybe MetadataResourceVersion
forall a. Maybe a
Nothing
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

runIntrospectRemoteSchema ::
  (CacheRM m, QErrM m) => RemoteSchemaNameQuery -> m EncJSON
runIntrospectRemoteSchema :: forall (m :: * -> *).
(CacheRM m, QErrM m) =>
RemoteSchemaNameQuery -> m EncJSON
runIntrospectRemoteSchema (RemoteSchemaNameQuery RemoteSchemaName
rsName) = do
  SchemaCache
sc <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  RemoteSchemaCtx {HashMap RoleName IntrospectionResult
ByteString
RemoteSchemaRelationshipsG (RemoteFieldInfo Name)
RemoteSchemaName
RemoteSchemaInfo
IntrospectionResult
_rscName :: RemoteSchemaName
_rscIntroOriginal :: IntrospectionResult
_rscInfo :: RemoteSchemaInfo
_rscRawIntrospectionResult :: ByteString
_rscPermissions :: HashMap RoleName IntrospectionResult
_rscRemoteRelationships :: RemoteSchemaRelationshipsG (RemoteFieldInfo Name)
_rscName :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> RemoteSchemaName
_rscIntroOriginal :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> IntrospectionResult
_rscInfo :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> RemoteSchemaInfo
_rscRawIntrospectionResult :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo -> ByteString
_rscPermissions :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo
-> HashMap RoleName IntrospectionResult
_rscRemoteRelationships :: forall remoteFieldInfo.
RemoteSchemaCtxG remoteFieldInfo
-> RemoteSchemaRelationshipsG remoteFieldInfo
..} <-
    RemoteSchemaName -> RemoteSchemaMap -> Maybe RemoteSchemaCtx
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup RemoteSchemaName
rsName (SchemaCache -> RemoteSchemaMap
scRemoteSchemas SchemaCache
sc) Maybe RemoteSchemaCtx -> m RemoteSchemaCtx -> m RemoteSchemaCtx
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m RemoteSchemaCtx
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists (Text
"remote schema: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoteSchemaName
rsName RemoteSchemaName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" not found")
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ ByteString -> EncJSON
encJFromLBS ByteString
_rscRawIntrospectionResult

runUpdateRemoteSchema ::
  ( QErrM m,
    CacheRWM m,
    MonadIO m,
    ProvidesNetwork m,
    MetadataM m,
    Tracing.MonadTrace m
  ) =>
  Env.Environment ->
  AddRemoteSchemaQuery ->
  m EncJSON
runUpdateRemoteSchema :: forall (m :: * -> *).
(QErrM m, CacheRWM m, MonadIO m, ProvidesNetwork m, MetadataM m,
 MonadTrace m) =>
Environment -> AddRemoteSchemaQuery -> m EncJSON
runUpdateRemoteSchema Environment
env (AddRemoteSchemaQuery RemoteSchemaName
name RemoteSchemaDef
defn Maybe Text
comment) = do
  [RemoteSchemaName]
remoteSchemaNames <- SchemaCache -> [RemoteSchemaName]
getAllRemoteSchemas (SchemaCache -> [RemoteSchemaName])
-> m SchemaCache -> m [RemoteSchemaName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  RemoteSchemas
remoteSchemaMap <- Metadata -> RemoteSchemas
_metaRemoteSchemas (Metadata -> RemoteSchemas) -> m Metadata -> m RemoteSchemas
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata

  let metadataRMSchema :: Maybe RemoteSchemaMetadata
metadataRMSchema = RemoteSchemaName -> RemoteSchemas -> Maybe RemoteSchemaMetadata
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup RemoteSchemaName
name RemoteSchemas
remoteSchemaMap
      metadataRMSchemaPerms :: [RemoteSchemaPermissionMetadata]
metadataRMSchemaPerms = [RemoteSchemaPermissionMetadata]
-> (RemoteSchemaMetadata -> [RemoteSchemaPermissionMetadata])
-> Maybe RemoteSchemaMetadata
-> [RemoteSchemaPermissionMetadata]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [RemoteSchemaPermissionMetadata]
forall a. Monoid a => a
mempty RemoteSchemaMetadata -> [RemoteSchemaPermissionMetadata]
forall r.
RemoteSchemaMetadataG r -> [RemoteSchemaPermissionMetadata]
_rsmPermissions Maybe RemoteSchemaMetadata
metadataRMSchema
      -- `metadataRMSchemaURL` and `metadataRMSchemaURLFromEnv` represent
      -- details that were stored within the metadata
      metadataRMSchemaURL :: Maybe InputWebhook
metadataRMSchemaURL = (RemoteSchemaDef -> Maybe InputWebhook
_rsdUrl (RemoteSchemaDef -> Maybe InputWebhook)
-> (RemoteSchemaMetadata -> RemoteSchemaDef)
-> RemoteSchemaMetadata
-> Maybe InputWebhook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteSchemaMetadata -> RemoteSchemaDef
forall r. RemoteSchemaMetadataG r -> RemoteSchemaDef
_rsmDefinition) (RemoteSchemaMetadata -> Maybe InputWebhook)
-> Maybe RemoteSchemaMetadata -> Maybe InputWebhook
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe RemoteSchemaMetadata
metadataRMSchema
      metadataRMSchemaURLFromEnv :: Maybe Text
metadataRMSchemaURLFromEnv = (RemoteSchemaDef -> Maybe Text
_rsdUrlFromEnv (RemoteSchemaDef -> Maybe Text)
-> (RemoteSchemaMetadata -> RemoteSchemaDef)
-> RemoteSchemaMetadata
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteSchemaMetadata -> RemoteSchemaDef
forall r. RemoteSchemaMetadataG r -> RemoteSchemaDef
_rsmDefinition) (RemoteSchemaMetadata -> Maybe Text)
-> Maybe RemoteSchemaMetadata -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe RemoteSchemaMetadata
metadataRMSchema
      -- `currentRMSchemaURL` and `currentRMSchemaURLFromEnv` represent
      -- the details that were provided in the request
      currentRMSchemaURL :: Maybe InputWebhook
currentRMSchemaURL = RemoteSchemaDef -> Maybe InputWebhook
_rsdUrl RemoteSchemaDef
defn
      currentRMSchemaURLFromEnv :: Maybe Text
currentRMSchemaURLFromEnv = RemoteSchemaDef -> Maybe Text
_rsdUrlFromEnv RemoteSchemaDef
defn

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RemoteSchemaName
name RemoteSchemaName -> [RemoteSchemaName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [RemoteSchemaName]
remoteSchemaNames)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
    (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"remote schema with name "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoteSchemaName
name
    RemoteSchemaName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" doesn't exist"

  ValidatedRemoteSchemaDef
rsi <- Environment -> RemoteSchemaDef -> m ValidatedRemoteSchemaDef
forall (m :: * -> *).
MonadError QErr m =>
Environment -> RemoteSchemaDef -> m ValidatedRemoteSchemaDef
validateRemoteSchemaDef Environment
env RemoteSchemaDef
defn

  -- we only proceed to fetch the remote schema if the url has been updated
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    ( (Maybe InputWebhook -> Bool
forall a. Maybe a -> Bool
isJust Maybe InputWebhook
metadataRMSchemaURL Bool -> Bool -> Bool
&& Maybe InputWebhook -> Bool
forall a. Maybe a -> Bool
isJust Maybe InputWebhook
currentRMSchemaURL Bool -> Bool -> Bool
&& Maybe InputWebhook
metadataRMSchemaURL Maybe InputWebhook -> Maybe InputWebhook -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe InputWebhook
currentRMSchemaURL)
        Bool -> Bool -> Bool
|| (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
metadataRMSchemaURLFromEnv Bool -> Bool -> Bool
&& Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
currentRMSchemaURLFromEnv Bool -> Bool -> Bool
&& Maybe Text
metadataRMSchemaURLFromEnv Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
currentRMSchemaURLFromEnv)
    )
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m (IntrospectionResult, ByteString, RemoteSchemaInfo) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    (m (IntrospectionResult, ByteString, RemoteSchemaInfo) -> m ())
-> m (IntrospectionResult, ByteString, RemoteSchemaInfo) -> m ()
forall a b. (a -> b) -> a -> b
$ Environment
-> ValidatedRemoteSchemaDef
-> m (IntrospectionResult, ByteString, RemoteSchemaInfo)
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadTrace m, ProvidesNetwork m) =>
Environment
-> ValidatedRemoteSchemaDef
-> m (IntrospectionResult, ByteString, RemoteSchemaInfo)
fetchRemoteSchema Environment
env ValidatedRemoteSchemaDef
rsi

  -- This will throw an error if the new schema fetched in incompatible
  -- with the existing permissions and relations
  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor (RemoteSchemaName -> MetadataObjId
MORemoteSchema RemoteSchemaName
name)
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (RemoteSchemas -> Identity RemoteSchemas)
-> Metadata -> Identity Metadata
Lens' Metadata RemoteSchemas
metaRemoteSchemas
    ((RemoteSchemas -> Identity RemoteSchemas)
 -> Metadata -> Identity Metadata)
-> (RemoteSchemas -> RemoteSchemas) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RemoteSchemaName
-> RemoteSchemaMetadata -> RemoteSchemas -> RemoteSchemas
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert RemoteSchemaName
name ([RemoteSchemaPermissionMetadata] -> RemoteSchemaMetadata
remoteSchemaMeta [RemoteSchemaPermissionMetadata]
metadataRMSchemaPerms)

  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg
  where
    remoteSchemaMeta :: [RemoteSchemaPermissionMetadata] -> RemoteSchemaMetadata
remoteSchemaMeta [RemoteSchemaPermissionMetadata]
perms = RemoteSchemaName
-> RemoteSchemaDef
-> Maybe Text
-> [RemoteSchemaPermissionMetadata]
-> SchemaRemoteRelationships RemoteRelationshipDefinition
-> RemoteSchemaMetadata
forall r.
RemoteSchemaName
-> RemoteSchemaDef
-> Maybe Text
-> [RemoteSchemaPermissionMetadata]
-> SchemaRemoteRelationships r
-> RemoteSchemaMetadataG r
RemoteSchemaMetadata RemoteSchemaName
name RemoteSchemaDef
defn Maybe Text
comment [RemoteSchemaPermissionMetadata]
perms SchemaRemoteRelationships RemoteRelationshipDefinition
forall a. Monoid a => a
mempty