module Hasura.RQL.DDL.RemoteSchema
  ( runAddRemoteSchema,
    runRemoveRemoteSchema,
    dropRemoteSchemaInMetadata,
    runReloadRemoteSchema,
    addRemoteSchemaP1,
    addRemoteSchemaP2Setup,
    runIntrospectRemoteSchema,
    dropRemoteSchemaPermissionInMetadata,
    dropRemoteSchemaRemoteRelationshipInMetadata,
    runAddRemoteSchemaPermissions,
    runDropRemoteSchemaPermissions,
    runUpdateRemoteSchema,
  )
where

import Control.Lens ((^.))
import Data.Environment qualified as Env
import Data.HashMap.Strict qualified as Map
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.HashSet qualified as S
import Data.Text.Extended
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.GraphQL.RemoteServer
import Hasura.GraphQL.Schema.Options qualified as Options
import Hasura.Prelude
import Hasura.RQL.DDL.RemoteSchema.Permission
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.RemoteSchema
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.Server.Types
import Hasura.Session
import Hasura.Tracing qualified as Tracing
import Network.HTTP.Client.Manager (HasHttpManagerM (..))

runAddRemoteSchema ::
  ( QErrM m,
    CacheRWM m,
    MonadIO m,
    HasHttpManagerM m,
    MetadataM m,
    Tracing.MonadTrace m
  ) =>
  Env.Environment ->
  AddRemoteSchemaQuery ->
  m EncJSON
runAddRemoteSchema :: Environment -> AddRemoteSchemaQuery -> m EncJSON
runAddRemoteSchema Environment
env q :: AddRemoteSchemaQuery
q@(AddRemoteSchemaQuery RemoteSchemaName
name RemoteSchemaDef
defn Maybe Text
comment) = do
  RemoteSchemaName -> m ()
forall (m :: * -> *).
(QErrM m, CacheRM m) =>
RemoteSchemaName -> m ()
addRemoteSchemaP1 RemoteSchemaName
name
  -- addRemoteSchemaP2 env q
  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
$ Environment -> AddRemoteSchemaQuery -> m RemoteSchemaCtx
forall (m :: * -> *).
(QErrM m, MonadIO m, HasHttpManagerM m, MonadTrace m) =>
Environment -> AddRemoteSchemaQuery -> m RemoteSchemaCtx
addRemoteSchemaP2Setup Environment
env AddRemoteSchemaQuery
q
  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
OMap.insert RemoteSchemaName
name RemoteSchemaMetadata
remoteSchemaMeta
  EncJSON -> m EncJSON
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
-> RemoteSchemaMetadata
RemoteSchemaMetadata RemoteSchemaName
name RemoteSchemaDef
defn Maybe Text
comment [RemoteSchemaPermissionMetadata]
forall a. Monoid a => a
mempty SchemaRemoteRelationships
forall a. Monoid a => a
mempty

doesRemoteSchemaPermissionExist :: Metadata -> RemoteSchemaName -> RoleName -> Bool
doesRemoteSchemaPermissionExist :: Metadata -> RemoteSchemaName -> RoleName -> Bool
doesRemoteSchemaPermissionExist Metadata
metadata RemoteSchemaName
remoteSchemaName RoleName
roleName =
  (RemoteSchemaPermissionMetadata -> Bool)
-> [RemoteSchemaPermissionMetadata] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
roleName) (RoleName -> Bool)
-> (RemoteSchemaPermissionMetadata -> RoleName)
-> RemoteSchemaPermissionMetadata
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteSchemaPermissionMetadata -> RoleName
_rspmRole) ([RemoteSchemaPermissionMetadata] -> Bool)
-> [RemoteSchemaPermissionMetadata] -> Bool
forall a b. (a -> b) -> a -> b
$ Metadata
metadata Metadata
-> Getting
     [RemoteSchemaPermissionMetadata]
     Metadata
     [RemoteSchemaPermissionMetadata]
-> [RemoteSchemaPermissionMetadata]
forall s a. s -> Getting a s a -> a
^. ((RemoteSchemas
 -> Const [RemoteSchemaPermissionMetadata] RemoteSchemas)
-> Metadata -> Const [RemoteSchemaPermissionMetadata] Metadata
Lens' Metadata RemoteSchemas
metaRemoteSchemas ((RemoteSchemas
  -> Const [RemoteSchemaPermissionMetadata] RemoteSchemas)
 -> Metadata -> Const [RemoteSchemaPermissionMetadata] Metadata)
-> (([RemoteSchemaPermissionMetadata]
     -> Const
          [RemoteSchemaPermissionMetadata] [RemoteSchemaPermissionMetadata])
    -> RemoteSchemas
    -> Const [RemoteSchemaPermissionMetadata] RemoteSchemas)
-> Getting
     [RemoteSchemaPermissionMetadata]
     Metadata
     [RemoteSchemaPermissionMetadata]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index RemoteSchemas
-> Traversal' RemoteSchemas (IxValue RemoteSchemas)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index RemoteSchemas
RemoteSchemaName
remoteSchemaName ((RemoteSchemaMetadata
  -> Const [RemoteSchemaPermissionMetadata] RemoteSchemaMetadata)
 -> RemoteSchemas
 -> Const [RemoteSchemaPermissionMetadata] RemoteSchemas)
-> (([RemoteSchemaPermissionMetadata]
     -> Const
          [RemoteSchemaPermissionMetadata] [RemoteSchemaPermissionMetadata])
    -> RemoteSchemaMetadata
    -> Const [RemoteSchemaPermissionMetadata] RemoteSchemaMetadata)
-> ([RemoteSchemaPermissionMetadata]
    -> Const
         [RemoteSchemaPermissionMetadata] [RemoteSchemaPermissionMetadata])
-> RemoteSchemas
-> Const [RemoteSchemaPermissionMetadata] RemoteSchemas
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([RemoteSchemaPermissionMetadata]
 -> Const
      [RemoteSchemaPermissionMetadata] [RemoteSchemaPermissionMetadata])
-> RemoteSchemaMetadata
-> Const [RemoteSchemaPermissionMetadata] RemoteSchemaMetadata
Lens' RemoteSchemaMetadata [RemoteSchemaPermissionMetadata]
rsmPermissions)

runAddRemoteSchemaPermissions ::
  ( QErrM m,
    CacheRWM m,
    HasServerConfigCtx m,
    MetadataM m
  ) =>
  AddRemoteSchemaPermission ->
  m EncJSON
runAddRemoteSchemaPermissions :: AddRemoteSchemaPermission -> m EncJSON
runAddRemoteSchemaPermissions AddRemoteSchemaPermission
q = do
  Metadata
metadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  RemoteSchemaPermissions
remoteSchemaPermsCtx <- ServerConfigCtx -> RemoteSchemaPermissions
_sccRemoteSchemaPermsCtx (ServerConfigCtx -> RemoteSchemaPermissions)
-> m ServerConfigCtx -> m RemoteSchemaPermissions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ServerConfigCtx
forall (m :: * -> *). HasServerConfigCtx m => m ServerConfigCtx
askServerConfigCtx
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RemoteSchemaPermissions
remoteSchemaPermsCtx RemoteSchemaPermissions -> RemoteSchemaPermissions -> Bool
forall a. Eq a => a -> a -> Bool
== RemoteSchemaPermissions
Options.EnableRemoteSchemaPermissions) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ConstraintViolation (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
      Text
"remote schema permissions can only be added when "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"remote schema permissions are enabled in the graphql-engine"
  RemoteSchemaMap
remoteSchemaMap <- SchemaCache -> RemoteSchemaMap
scRemoteSchemas (SchemaCache -> RemoteSchemaMap)
-> m SchemaCache -> m RemoteSchemaMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  RemoteSchemaCtx
remoteSchemaCtx <-
    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
Map.lookup RemoteSchemaName
name RemoteSchemaMap
remoteSchemaMap) (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 -> m RemoteSchemaCtx) -> Text -> m RemoteSchemaCtx
forall a b. (a -> b) -> a -> b
$ Text
"remote schema " 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"
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Metadata -> RemoteSchemaName -> RoleName -> Bool
doesRemoteSchemaPermissionExist Metadata
metadata RemoteSchemaName
name RoleName
role) (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
"permissions for role: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName
role RoleName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" for remote schema:"
        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"
  m (IntrospectionResult, [SchemaDependency]) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (IntrospectionResult, [SchemaDependency]) -> m ())
-> m (IntrospectionResult, [SchemaDependency]) -> m ()
forall a b. (a -> b) -> a -> b
$ SchemaDocument
-> RemoteSchemaCtx -> m (IntrospectionResult, [SchemaDependency])
forall (m :: * -> *).
MonadError QErr m =>
SchemaDocument
-> RemoteSchemaCtx -> m (IntrospectionResult, [SchemaDependency])
resolveRoleBasedRemoteSchema SchemaDocument
providedSchemaDoc RemoteSchemaCtx
remoteSchemaCtx
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor (RemoteSchemaName -> RoleName -> MetadataObjId
MORemoteSchemaPermissions RemoteSchemaName
name RoleName
role) (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)
-> (([RemoteSchemaPermissionMetadata]
     -> Identity [RemoteSchemaPermissionMetadata])
    -> RemoteSchemas -> Identity RemoteSchemas)
-> ([RemoteSchemaPermissionMetadata]
    -> Identity [RemoteSchemaPermissionMetadata])
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index RemoteSchemas
-> Traversal' RemoteSchemas (IxValue RemoteSchemas)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index RemoteSchemas
RemoteSchemaName
name ((RemoteSchemaMetadata -> Identity RemoteSchemaMetadata)
 -> RemoteSchemas -> Identity RemoteSchemas)
-> (([RemoteSchemaPermissionMetadata]
     -> Identity [RemoteSchemaPermissionMetadata])
    -> RemoteSchemaMetadata -> Identity RemoteSchemaMetadata)
-> ([RemoteSchemaPermissionMetadata]
    -> Identity [RemoteSchemaPermissionMetadata])
-> RemoteSchemas
-> Identity RemoteSchemas
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([RemoteSchemaPermissionMetadata]
 -> Identity [RemoteSchemaPermissionMetadata])
-> RemoteSchemaMetadata -> Identity RemoteSchemaMetadata
Lens' RemoteSchemaMetadata [RemoteSchemaPermissionMetadata]
rsmPermissions (([RemoteSchemaPermissionMetadata]
  -> Identity [RemoteSchemaPermissionMetadata])
 -> Metadata -> Identity Metadata)
-> ([RemoteSchemaPermissionMetadata]
    -> [RemoteSchemaPermissionMetadata])
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (:) RemoteSchemaPermissionMetadata
remoteSchemaPermMeta
  EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg
  where
    AddRemoteSchemaPermission RemoteSchemaName
name RoleName
role RemoteSchemaPermissionDefinition
defn Maybe Text
comment = AddRemoteSchemaPermission
q

    remoteSchemaPermMeta :: RemoteSchemaPermissionMetadata
remoteSchemaPermMeta = RoleName
-> RemoteSchemaPermissionDefinition
-> Maybe Text
-> RemoteSchemaPermissionMetadata
RemoteSchemaPermissionMetadata RoleName
role RemoteSchemaPermissionDefinition
defn Maybe Text
comment

    providedSchemaDoc :: SchemaDocument
providedSchemaDoc = RemoteSchemaPermissionDefinition -> SchemaDocument
_rspdSchema RemoteSchemaPermissionDefinition
defn

runDropRemoteSchemaPermissions ::
  ( QErrM m,
    CacheRWM m,
    MetadataM m
  ) =>
  DropRemoteSchemaPermissions ->
  m EncJSON
runDropRemoteSchemaPermissions :: DropRemoteSchemaPermissions -> m EncJSON
runDropRemoteSchemaPermissions (DropRemoteSchemaPermissions RemoteSchemaName
name RoleName
roleName) = do
  Metadata
metadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  RemoteSchemaMap
remoteSchemaMap <- SchemaCache -> RemoteSchemaMap
scRemoteSchemas (SchemaCache -> RemoteSchemaMap)
-> m SchemaCache -> m RemoteSchemaMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  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
Map.lookup RemoteSchemaName
name RemoteSchemaMap
remoteSchemaMap) (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 -> m RemoteSchemaCtx) -> Text -> m RemoteSchemaCtx
forall a b. (a -> b) -> a -> b
$ Text
"remote schema " 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"
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Metadata -> RemoteSchemaName -> RoleName -> Bool
doesRemoteSchemaPermissionExist Metadata
metadata RemoteSchemaName
name RoleName
roleName) (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
"permissions for role: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName
roleName RoleName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" for remote schema:"
        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"
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor (RemoteSchemaName -> RoleName -> MetadataObjId
MORemoteSchemaPermissions RemoteSchemaName
name RoleName
roleName) (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$
    RemoteSchemaName -> RoleName -> MetadataModifier
dropRemoteSchemaPermissionInMetadata RemoteSchemaName
name RoleName
roleName
  EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

addRemoteSchemaP1 ::
  (QErrM m, CacheRM m) =>
  RemoteSchemaName ->
  m ()
addRemoteSchemaP1 :: 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 (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"

addRemoteSchemaP2Setup ::
  (QErrM m, MonadIO m, HasHttpManagerM m, Tracing.MonadTrace m) =>
  Env.Environment ->
  AddRemoteSchemaQuery ->
  m RemoteSchemaCtx
addRemoteSchemaP2Setup :: Environment -> AddRemoteSchemaQuery -> m RemoteSchemaCtx
addRemoteSchemaP2Setup Environment
env (AddRemoteSchemaQuery RemoteSchemaName
name RemoteSchemaDef
def Maybe Text
_) = do
  Manager
httpMgr <- m Manager
forall (m :: * -> *). HasHttpManagerM m => m Manager
askHttpManager
  ValidatedRemoteSchemaDef
rsi <- Environment -> RemoteSchemaDef -> m ValidatedRemoteSchemaDef
forall (m :: * -> *).
(MonadError QErr m, MonadIO m) =>
Environment -> RemoteSchemaDef -> m ValidatedRemoteSchemaDef
validateRemoteSchemaDef Environment
env RemoteSchemaDef
def
  Environment
-> Manager
-> RemoteSchemaName
-> ValidatedRemoteSchemaDef
-> m RemoteSchemaCtx
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadTrace m) =>
Environment
-> Manager
-> RemoteSchemaName
-> ValidatedRemoteSchemaDef
-> m RemoteSchemaCtx
fetchRemoteSchema Environment
env Manager
httpMgr RemoteSchemaName
name ValidatedRemoteSchemaDef
rsi

runRemoveRemoteSchema ::
  (QErrM m, UserInfoM m, CacheRWM m, MetadataM m) =>
  RemoteSchemaNameQuery ->
  m EncJSON
runRemoveRemoteSchema :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

removeRemoteSchemaP1 ::
  (UserInfoM m, QErrM m, CacheRM m) =>
  RemoteSchemaName ->
  m [RoleName]
removeRemoteSchemaP1 :: 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
Map.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 (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 (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 (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 :: 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 (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 -> m ()
forall (m :: * -> *).
CacheRWM m =>
BuildReason -> CacheInvalidations -> Metadata -> m ()
buildSchemaCacheWithOptions (Maybe (HashSet SourceName) -> BuildReason
CatalogUpdate Maybe (HashSet SourceName)
forall a. Maybe a
Nothing) CacheInvalidations
invalidations Metadata
metadata
  EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

runIntrospectRemoteSchema ::
  (CacheRM m, QErrM m) => RemoteSchemaNameQuery -> m EncJSON
runIntrospectRemoteSchema :: RemoteSchemaNameQuery -> m EncJSON
runIntrospectRemoteSchema (RemoteSchemaNameQuery RemoteSchemaName
rsName) = do
  SchemaCache
sc <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  RemoteSchemaCtx {ByteString
HashMap RoleName IntrospectionResult
RemoteSchemaRelationships
RemoteSchemaName
RemoteSchemaInfo
IntrospectionResult
_rscRemoteRelationships :: RemoteSchemaCtx -> RemoteSchemaRelationships
_rscPermissions :: RemoteSchemaCtx -> HashMap RoleName IntrospectionResult
_rscRawIntrospectionResult :: RemoteSchemaCtx -> ByteString
_rscInfo :: RemoteSchemaCtx -> RemoteSchemaInfo
_rscIntroOriginal :: RemoteSchemaCtx -> IntrospectionResult
_rscName :: RemoteSchemaCtx -> RemoteSchemaName
_rscRemoteRelationships :: RemoteSchemaRelationships
_rscPermissions :: HashMap RoleName IntrospectionResult
_rscRawIntrospectionResult :: ByteString
_rscInfo :: RemoteSchemaInfo
_rscIntroOriginal :: IntrospectionResult
_rscName :: RemoteSchemaName
..} <-
    RemoteSchemaName -> RemoteSchemaMap -> Maybe RemoteSchemaCtx
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.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 (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,
    HasHttpManagerM m,
    MetadataM m,
    Tracing.MonadTrace m
  ) =>
  Env.Environment ->
  AddRemoteSchemaQuery ->
  m EncJSON
runUpdateRemoteSchema :: 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
OMap.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]
_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
_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
_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 (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, MonadIO 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
$ do
      Manager
httpMgr <- m Manager
forall (m :: * -> *). HasHttpManagerM m => m Manager
askHttpManager
      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
$ Environment
-> Manager
-> RemoteSchemaName
-> ValidatedRemoteSchemaDef
-> m RemoteSchemaCtx
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadTrace m) =>
Environment
-> Manager
-> RemoteSchemaName
-> ValidatedRemoteSchemaDef
-> m RemoteSchemaCtx
fetchRemoteSchema Environment
env Manager
httpMgr RemoteSchemaName
name 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
OMap.insert RemoteSchemaName
name ([RemoteSchemaPermissionMetadata] -> RemoteSchemaMetadata
remoteSchemaMeta [RemoteSchemaPermissionMetadata]
metadataRMSchemaPerms)

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