{-# LANGUAGE UndecidableInstances #-}

module Hasura.RQL.DDL.RemoteRelationship
  ( CreateFromSourceRelationship (..),
    runCreateRemoteRelationship,
    execDeleteRemoteRelationship,
    runDeleteRemoteRelationship,
    runUpdateRemoteRelationship,
    DeleteFromSourceRelationship (..),
    dropRemoteRelationshipInMetadata,
    PartiallyResolvedSource (..),
    buildRemoteFieldInfo,
    CreateRemoteSchemaRemoteRelationship (..),
    runCreateRemoteSchemaRemoteRelationship,
    runUpdateRemoteSchemaRemoteRelationship,
    DeleteRemoteSchemaRemoteRelationship (..),
    runDeleteRemoteSchemaRemoteRelationship,
    getRemoteSchemaEntityJoinColumns,
  )
where

import Control.Lens (at, non, to, (^?))
import Data.Aeson (FromJSON (..), ToJSON (..), (.!=), (.:), (.:?), (.=))
import Data.Aeson qualified as J
import Data.Aeson.KeyMap qualified as KM
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.Sequence qualified as Seq
import Data.Text.Extended ((<<>), (<>>))
import Hasura.Base.Error
  ( Code (NotExists, NotFound, NotSupported, RemoteSchemaError),
    QErr,
    QErrM,
    runAesonParser,
    throw400,
    throw500,
  )
import Hasura.EncJSON (EncJSON)
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.Relationships.Remote
import Hasura.RQL.Types.Relationships.ToSource
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.RQL.Types.Source
import Hasura.RemoteSchema.Metadata
import Hasura.RemoteSchema.SchemaCache
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.Table.Cache
import Hasura.Table.Metadata (tmRemoteRelationships)
import Language.GraphQL.Draft.Syntax qualified as G

--------------------------------------------------------------------------------
-- Create or update relationship from source

-- | Argument to the @_create_remote_relationship@ and
-- @_update_remote_relationship@ families of metadata commands.
--
-- For historical reason, this type is also used to represent a db-to-rs schema
-- in the metadata.
data CreateFromSourceRelationship (b :: BackendType) = CreateFromSourceRelationship
  { forall (b :: BackendType).
CreateFromSourceRelationship b -> SourceName
_crrSource :: SourceName,
    forall (b :: BackendType).
CreateFromSourceRelationship b -> TableName b
_crrTable :: TableName b,
    forall (b :: BackendType).
CreateFromSourceRelationship b -> RelName
_crrName :: RelName,
    forall (b :: BackendType).
CreateFromSourceRelationship b -> RemoteRelationshipDefinition
_crrDefinition :: RemoteRelationshipDefinition
  }

deriving stock instance (Eq (TableName b)) => Eq (CreateFromSourceRelationship b)

deriving stock instance (Show (TableName b)) => Show (CreateFromSourceRelationship b)

instance (Backend b) => FromJSON (CreateFromSourceRelationship b) where
  parseJSON :: Value -> Parser (CreateFromSourceRelationship b)
parseJSON = String
-> (Object -> Parser (CreateFromSourceRelationship b))
-> Value
-> Parser (CreateFromSourceRelationship b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"CreateFromSourceRelationship" ((Object -> Parser (CreateFromSourceRelationship b))
 -> Value -> Parser (CreateFromSourceRelationship b))
-> (Object -> Parser (CreateFromSourceRelationship b))
-> Value
-> Parser (CreateFromSourceRelationship b)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    SourceName
_crrSource <- Object
o Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source" Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
    TableName b
_crrTable <- Object
o Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
    RelName
_crrName <- Object
o Object -> Key -> Parser RelName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    -- In the old format, the definition is inlined; in the new format, the
    -- definition is in the "definition" object, and we don't allow legacy
    -- fields to appear under it.
    Maybe Value
remoteSchema :: Maybe J.Value <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"remote_schema"
    Maybe Value
definition <- Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"definition"
    RemoteRelationshipDefinition
_crrDefinition <- case (Maybe Value
remoteSchema, Maybe Value
definition) of
      -- old format
      (Just {}, Maybe Value
Nothing) -> RRParseMode -> Value -> Parser RemoteRelationshipDefinition
parseRemoteRelationshipDefinition RRParseMode
RRPLegacy (Value -> Parser RemoteRelationshipDefinition)
-> Value -> Parser RemoteRelationshipDefinition
forall a b. (a -> b) -> a -> b
$ Object -> Value
J.Object Object
o
      -- new format
      (Maybe Value
Nothing, Just Value
def) -> RRParseMode -> Value -> Parser RemoteRelationshipDefinition
parseRemoteRelationshipDefinition RRParseMode
RRPStrict Value
def
      -- both or neither
      (Maybe Value, Maybe Value)
_ -> String -> Parser RemoteRelationshipDefinition
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"create_remote_relationship expects exactly one of: remote_schema, definition"
    CreateFromSourceRelationship b
-> Parser (CreateFromSourceRelationship b)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CreateFromSourceRelationship b
 -> Parser (CreateFromSourceRelationship b))
-> CreateFromSourceRelationship b
-> Parser (CreateFromSourceRelationship b)
forall a b. (a -> b) -> a -> b
$ CreateFromSourceRelationship {SourceName
RelName
TableName b
RemoteRelationshipDefinition
_crrSource :: SourceName
_crrTable :: TableName b
_crrName :: RelName
_crrDefinition :: RemoteRelationshipDefinition
_crrSource :: SourceName
_crrTable :: TableName b
_crrName :: RelName
_crrDefinition :: RemoteRelationshipDefinition
..}

instance (Backend b) => ToJSON (CreateFromSourceRelationship b) where
  toJSON :: CreateFromSourceRelationship b -> Value
toJSON CreateFromSourceRelationship {SourceName
RelName
TableName b
RemoteRelationshipDefinition
_crrSource :: forall (b :: BackendType).
CreateFromSourceRelationship b -> SourceName
_crrTable :: forall (b :: BackendType).
CreateFromSourceRelationship b -> TableName b
_crrName :: forall (b :: BackendType).
CreateFromSourceRelationship b -> RelName
_crrDefinition :: forall (b :: BackendType).
CreateFromSourceRelationship b -> RemoteRelationshipDefinition
_crrSource :: SourceName
_crrTable :: TableName b
_crrName :: RelName
_crrDefinition :: RemoteRelationshipDefinition
..} =
    -- We need to introspect the definition, to know whether we need to inline
    -- it, or if it needs to be in a distinct "definition" object.
    [Pair] -> Value
J.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ case RemoteRelationshipDefinition
_crrDefinition of
      -- old format
      RelationshipToSchema RRFormat
RRFOldDBToRemoteSchema ToSchemaRelationshipDef
_ ->
        case RemoteRelationshipDefinition -> Value
forall a. ToJSON a => a -> Value
J.toJSON RemoteRelationshipDefinition
_crrDefinition of
          -- The result of this serialization will be an empty list if this
          -- conversion fails (which it should _never_ do), in which case those
          -- fields will be omitted from the serialized JSON. This could only
          -- happen if the ToJSON instance of RemoteRelationshipDefinition were
          -- changed to return something that isn't an object.
          J.Object Object
obj -> [Pair]
commonFields [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
obj
          Value
_ -> []
      -- new format
      RemoteRelationshipDefinition
_ -> (Key
"definition" Key -> RemoteRelationshipDefinition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= RemoteRelationshipDefinition
_crrDefinition) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
commonFields
    where
      commonFields :: [Pair]
commonFields =
        [ Key
"source" Key -> SourceName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= SourceName
_crrSource,
          Key
"table" Key -> TableName b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TableName b
_crrTable,
          Key
"name" Key -> RelName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= RelName
_crrName
        ]

runCreateRemoteRelationship ::
  forall b m.
  (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
  CreateFromSourceRelationship b ->
  m EncJSON
runCreateRemoteRelationship :: forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
CreateFromSourceRelationship b -> m EncJSON
runCreateRemoteRelationship CreateFromSourceRelationship {SourceName
RelName
TableName b
RemoteRelationshipDefinition
_crrSource :: forall (b :: BackendType).
CreateFromSourceRelationship b -> SourceName
_crrTable :: forall (b :: BackendType).
CreateFromSourceRelationship b -> TableName b
_crrName :: forall (b :: BackendType).
CreateFromSourceRelationship b -> RelName
_crrDefinition :: forall (b :: BackendType).
CreateFromSourceRelationship b -> RemoteRelationshipDefinition
_crrSource :: SourceName
_crrTable :: TableName b
_crrName :: RelName
_crrDefinition :: RemoteRelationshipDefinition
..} = do
  m (TableInfo b) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (TableInfo b) -> m ()) -> m (TableInfo b) -> m ()
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableInfo b)
askTableInfo @b SourceName
_crrSource TableName b
_crrTable
  let metadataObj :: MetadataObjId
metadataObj =
        SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
_crrSource
          (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
          (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableMetadataObjId -> SourceMetadataObjId b
SMOTableObj @b TableName b
_crrTable
          (TableMetadataObjId -> SourceMetadataObjId b)
-> TableMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$ RelName -> TableMetadataObjId
MTORemoteRelationship RelName
_crrName
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor MetadataObjId
metadataObj
    (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
$ forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @b SourceName
_crrSource TableName b
_crrTable
    ASetter' Metadata (TableMetadata b)
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> TableMetadata b -> Identity (TableMetadata b))
-> (RemoteRelationships -> Identity RemoteRelationships)
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteRelationships -> Identity RemoteRelationships)
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(RemoteRelationships -> f RemoteRelationships)
-> TableMetadata b -> f (TableMetadata b)
tmRemoteRelationships
    ((RemoteRelationships -> Identity RemoteRelationships)
 -> Metadata -> Identity Metadata)
-> (RemoteRelationships -> RemoteRelationships)
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RelName
-> RemoteRelationship -> RemoteRelationships -> RemoteRelationships
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert RelName
_crrName (RelName -> RemoteRelationshipDefinition -> RemoteRelationship
forall definition.
RelName -> definition -> RemoteRelationshipG definition
RemoteRelationship RelName
_crrName RemoteRelationshipDefinition
_crrDefinition)
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

runUpdateRemoteRelationship ::
  forall b m.
  (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
  CreateFromSourceRelationship b ->
  m EncJSON
runUpdateRemoteRelationship :: forall (b :: BackendType) (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
CreateFromSourceRelationship b -> m EncJSON
runUpdateRemoteRelationship CreateFromSourceRelationship {SourceName
RelName
TableName b
RemoteRelationshipDefinition
_crrSource :: forall (b :: BackendType).
CreateFromSourceRelationship b -> SourceName
_crrTable :: forall (b :: BackendType).
CreateFromSourceRelationship b -> TableName b
_crrName :: forall (b :: BackendType).
CreateFromSourceRelationship b -> RelName
_crrDefinition :: forall (b :: BackendType).
CreateFromSourceRelationship b -> RemoteRelationshipDefinition
_crrSource :: SourceName
_crrTable :: TableName b
_crrName :: RelName
_crrDefinition :: RemoteRelationshipDefinition
..} = do
  FieldInfoMap (FieldInfo b)
fieldInfoMap <- forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (FieldInfoMap (FieldInfo b))
askTableFieldInfoMap @b SourceName
_crrSource TableName b
_crrTable
  let metadataObj :: MetadataObjId
metadataObj =
        SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
_crrSource
          (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
          (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableMetadataObjId -> SourceMetadataObjId b
SMOTableObj @b TableName b
_crrTable
          (TableMetadataObjId -> SourceMetadataObjId b)
-> TableMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$ RelName -> TableMetadataObjId
MTORemoteRelationship RelName
_crrName
  m (RemoteFieldInfo (DBJoinField b)) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (RemoteFieldInfo (DBJoinField b)) -> m ())
-> m (RemoteFieldInfo (DBJoinField b)) -> m ()
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo b)
-> RelName -> m (RemoteFieldInfo (DBJoinField b))
forall (m :: * -> *) (backend :: BackendType).
MonadError QErr m =>
FieldInfoMap (FieldInfo backend)
-> RelName -> m (RemoteFieldInfo (DBJoinField backend))
askRemoteRel FieldInfoMap (FieldInfo b)
fieldInfoMap RelName
_crrName
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor MetadataObjId
metadataObj
    (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
$ forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @b SourceName
_crrSource TableName b
_crrTable
    ASetter' Metadata (TableMetadata b)
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> TableMetadata b -> Identity (TableMetadata b))
-> (RemoteRelationships -> Identity RemoteRelationships)
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteRelationships -> Identity RemoteRelationships)
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(RemoteRelationships -> f RemoteRelationships)
-> TableMetadata b -> f (TableMetadata b)
tmRemoteRelationships
    ((RemoteRelationships -> Identity RemoteRelationships)
 -> Metadata -> Identity Metadata)
-> (RemoteRelationships -> RemoteRelationships)
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RelName
-> RemoteRelationship -> RemoteRelationships -> RemoteRelationships
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert RelName
_crrName (RelName -> RemoteRelationshipDefinition -> RemoteRelationship
forall definition.
RelName -> definition -> RemoteRelationshipG definition
RemoteRelationship RelName
_crrName RemoteRelationshipDefinition
_crrDefinition)
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

--------------------------------------------------------------------------------
-- Drop relationship from source

-- | Argument to the @_drop_remote_relationship@ family of metadata commands.
data DeleteFromSourceRelationship (b :: BackendType) = DeleteFromSourceRelationship
  { forall (b :: BackendType).
DeleteFromSourceRelationship b -> SourceName
_drrSource :: SourceName,
    forall (b :: BackendType).
DeleteFromSourceRelationship b -> TableName b
_drrTable :: TableName b,
    forall (b :: BackendType).
DeleteFromSourceRelationship b -> RelName
_drrName :: RelName
  }

instance (Backend b) => FromJSON (DeleteFromSourceRelationship b) where
  parseJSON :: Value -> Parser (DeleteFromSourceRelationship b)
parseJSON = String
-> (Object -> Parser (DeleteFromSourceRelationship b))
-> Value
-> Parser (DeleteFromSourceRelationship b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"DeleteFromSourceRelationship" ((Object -> Parser (DeleteFromSourceRelationship b))
 -> Value -> Parser (DeleteFromSourceRelationship b))
-> (Object -> Parser (DeleteFromSourceRelationship b))
-> Value
-> Parser (DeleteFromSourceRelationship b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SourceName
-> TableName b -> RelName -> DeleteFromSourceRelationship b
forall (b :: BackendType).
SourceName
-> TableName b -> RelName -> DeleteFromSourceRelationship b
DeleteFromSourceRelationship
      (SourceName
 -> TableName b -> RelName -> DeleteFromSourceRelationship b)
-> Parser SourceName
-> Parser
     (TableName b -> RelName -> DeleteFromSourceRelationship b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source"
      Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser (TableName b -> RelName -> DeleteFromSourceRelationship b)
-> Parser (TableName b)
-> Parser (RelName -> DeleteFromSourceRelationship b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table"
      Parser (RelName -> DeleteFromSourceRelationship b)
-> Parser RelName -> Parser (DeleteFromSourceRelationship b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser RelName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"

execDeleteRemoteRelationship ::
  forall b m.
  (BackendMetadata b, MonadError QErr m, CacheRWM m) =>
  DeleteFromSourceRelationship b ->
  m (MetadataObjId, MetadataModifier)
execDeleteRemoteRelationship :: forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadError QErr m, CacheRWM m) =>
DeleteFromSourceRelationship b
-> m (MetadataObjId, MetadataModifier)
execDeleteRemoteRelationship (DeleteFromSourceRelationship SourceName
source TableName b
table RelName
relName) = do
  FieldInfoMap (FieldInfo b)
fieldInfoMap <- forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (FieldInfoMap (FieldInfo b))
askTableFieldInfoMap @b SourceName
source TableName b
table
  m (RemoteFieldInfo (DBJoinField b)) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (RemoteFieldInfo (DBJoinField b)) -> m ())
-> m (RemoteFieldInfo (DBJoinField b)) -> m ()
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo b)
-> RelName -> m (RemoteFieldInfo (DBJoinField b))
forall (m :: * -> *) (backend :: BackendType).
MonadError QErr m =>
FieldInfoMap (FieldInfo backend)
-> RelName -> m (RemoteFieldInfo (DBJoinField backend))
askRemoteRel FieldInfoMap (FieldInfo b)
fieldInfoMap RelName
relName

  let metadataObjId :: MetadataObjId
      metadataObjId :: MetadataObjId
metadataObjId =
        SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source
          (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
          (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableMetadataObjId -> SourceMetadataObjId b
SMOTableObj @b TableName b
table
          (TableMetadataObjId -> SourceMetadataObjId b)
-> TableMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$ RelName -> TableMetadataObjId
MTORemoteRelationship RelName
relName

      metadataModifier :: MetadataModifier
      metadataModifier :: MetadataModifier
metadataModifier =
        (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
          ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @b SourceName
source TableName b
table
          ASetter' Metadata (TableMetadata b)
-> (TableMetadata b -> TableMetadata b) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RelName -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
RelName -> TableMetadata b -> TableMetadata b
dropRemoteRelationshipInMetadata RelName
relName

  (MetadataObjId, MetadataModifier)
-> m (MetadataObjId, MetadataModifier)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MetadataObjId
metadataObjId, MetadataModifier
metadataModifier)

runDeleteRemoteRelationship ::
  forall b m.
  (BackendMetadata b, MonadError QErr m, CacheRWM m, MetadataM m) =>
  DeleteFromSourceRelationship b ->
  m EncJSON
runDeleteRemoteRelationship :: forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadError QErr m, CacheRWM m, MetadataM m) =>
DeleteFromSourceRelationship b -> m EncJSON
runDeleteRemoteRelationship DeleteFromSourceRelationship b
command = do
  (MetadataObjId
metadataObj, MetadataModifier
metadataModifier) <- DeleteFromSourceRelationship b
-> m (MetadataObjId, MetadataModifier)
forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadError QErr m, CacheRWM m) =>
DeleteFromSourceRelationship b
-> m (MetadataObjId, MetadataModifier)
execDeleteRemoteRelationship DeleteFromSourceRelationship b
command

  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor MetadataObjId
metadataObj MetadataModifier
metadataModifier
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

--------------------------------------------------------------------------------
-- Create relationship from remote schema

data CreateRemoteSchemaRemoteRelationship = CreateRemoteSchemaRemoteRelationship
  { CreateRemoteSchemaRemoteRelationship -> RemoteSchemaName
_crsrrRemoteSchema :: RemoteSchemaName,
    CreateRemoteSchemaRemoteRelationship -> Name
_crsrrType :: G.Name,
    CreateRemoteSchemaRemoteRelationship -> RelName
_crsrrName :: RelName,
    CreateRemoteSchemaRemoteRelationship
-> RemoteRelationshipDefinition
_crsrrDefinition :: RemoteRelationshipDefinition
  }
  deriving ((forall x.
 CreateRemoteSchemaRemoteRelationship
 -> Rep CreateRemoteSchemaRemoteRelationship x)
-> (forall x.
    Rep CreateRemoteSchemaRemoteRelationship x
    -> CreateRemoteSchemaRemoteRelationship)
-> Generic CreateRemoteSchemaRemoteRelationship
forall x.
Rep CreateRemoteSchemaRemoteRelationship x
-> CreateRemoteSchemaRemoteRelationship
forall x.
CreateRemoteSchemaRemoteRelationship
-> Rep CreateRemoteSchemaRemoteRelationship x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateRemoteSchemaRemoteRelationship
-> Rep CreateRemoteSchemaRemoteRelationship x
from :: forall x.
CreateRemoteSchemaRemoteRelationship
-> Rep CreateRemoteSchemaRemoteRelationship x
$cto :: forall x.
Rep CreateRemoteSchemaRemoteRelationship x
-> CreateRemoteSchemaRemoteRelationship
to :: forall x.
Rep CreateRemoteSchemaRemoteRelationship x
-> CreateRemoteSchemaRemoteRelationship
Generic)

instance FromJSON CreateRemoteSchemaRemoteRelationship where
  parseJSON :: Value -> Parser CreateRemoteSchemaRemoteRelationship
parseJSON = String
-> (Object -> Parser CreateRemoteSchemaRemoteRelationship)
-> Value
-> Parser CreateRemoteSchemaRemoteRelationship
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"CreateRemoteSchemaRemoteRelationship" ((Object -> Parser CreateRemoteSchemaRemoteRelationship)
 -> Value -> Parser CreateRemoteSchemaRemoteRelationship)
-> (Object -> Parser CreateRemoteSchemaRemoteRelationship)
-> Value
-> Parser CreateRemoteSchemaRemoteRelationship
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    RemoteSchemaName
-> Name
-> RelName
-> RemoteRelationshipDefinition
-> CreateRemoteSchemaRemoteRelationship
CreateRemoteSchemaRemoteRelationship
      (RemoteSchemaName
 -> Name
 -> RelName
 -> RemoteRelationshipDefinition
 -> CreateRemoteSchemaRemoteRelationship)
-> Parser RemoteSchemaName
-> Parser
     (Name
      -> RelName
      -> RemoteRelationshipDefinition
      -> CreateRemoteSchemaRemoteRelationship)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser RemoteSchemaName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"remote_schema"
      Parser
  (Name
   -> RelName
   -> RemoteRelationshipDefinition
   -> CreateRemoteSchemaRemoteRelationship)
-> Parser Name
-> Parser
     (RelName
      -> RemoteRelationshipDefinition
      -> CreateRemoteSchemaRemoteRelationship)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser Name
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type_name"
      Parser
  (RelName
   -> RemoteRelationshipDefinition
   -> CreateRemoteSchemaRemoteRelationship)
-> Parser RelName
-> Parser
     (RemoteRelationshipDefinition
      -> CreateRemoteSchemaRemoteRelationship)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser RelName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser
  (RemoteRelationshipDefinition
   -> CreateRemoteSchemaRemoteRelationship)
-> Parser RemoteRelationshipDefinition
-> Parser CreateRemoteSchemaRemoteRelationship
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"definition" Parser Value
-> (Value -> Parser RemoteRelationshipDefinition)
-> Parser RemoteRelationshipDefinition
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RRParseMode -> Value -> Parser RemoteRelationshipDefinition
parseRemoteRelationshipDefinition RRParseMode
RRPStrict)

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

runCreateRemoteSchemaRemoteRelationship ::
  forall m.
  (MonadError QErr m, CacheRWM m, MetadataM m) =>
  CreateRemoteSchemaRemoteRelationship ->
  m EncJSON
runCreateRemoteSchemaRemoteRelationship :: forall (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m) =>
CreateRemoteSchemaRemoteRelationship -> m EncJSON
runCreateRemoteSchemaRemoteRelationship CreateRemoteSchemaRemoteRelationship {Name
RelName
RemoteSchemaName
RemoteRelationshipDefinition
_crsrrRemoteSchema :: CreateRemoteSchemaRemoteRelationship -> RemoteSchemaName
_crsrrType :: CreateRemoteSchemaRemoteRelationship -> Name
_crsrrName :: CreateRemoteSchemaRemoteRelationship -> RelName
_crsrrDefinition :: CreateRemoteSchemaRemoteRelationship
-> RemoteRelationshipDefinition
_crsrrRemoteSchema :: RemoteSchemaName
_crsrrType :: Name
_crsrrName :: RelName
_crsrrDefinition :: RemoteRelationshipDefinition
..} = do
  let metadataObj :: MetadataObjId
metadataObj =
        RemoteSchemaName -> Name -> RelName -> MetadataObjId
MORemoteSchemaRemoteRelationship RemoteSchemaName
_crsrrRemoteSchema Name
_crsrrType RelName
_crsrrName
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor MetadataObjId
metadataObj
    (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)
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> RemoteSchemas -> Identity RemoteSchemas)
-> (RemoteRelationships -> Identity RemoteRelationships)
-> 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
_crsrrRemoteSchema
    ((RemoteSchemaMetadataG RemoteRelationshipDefinition
  -> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition))
 -> RemoteSchemas -> Identity RemoteSchemas)
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> RemoteSchemaMetadataG RemoteRelationshipDefinition
    -> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition))
-> (RemoteRelationships -> Identity RemoteRelationships)
-> RemoteSchemas
-> Identity RemoteSchemas
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SchemaRemoteRelationships RemoteRelationshipDefinition
 -> Identity
      (SchemaRemoteRelationships RemoteRelationshipDefinition))
-> RemoteSchemaMetadataG RemoteRelationshipDefinition
-> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition)
forall r1 r2 (f :: * -> *).
Functor f =>
(SchemaRemoteRelationships r1 -> f (SchemaRemoteRelationships r2))
-> RemoteSchemaMetadataG r1 -> f (RemoteSchemaMetadataG r2)
rsmRemoteRelationships
    ((SchemaRemoteRelationships RemoteRelationshipDefinition
  -> Identity
       (SchemaRemoteRelationships RemoteRelationshipDefinition))
 -> RemoteSchemaMetadataG RemoteRelationshipDefinition
 -> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition))
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> SchemaRemoteRelationships RemoteRelationshipDefinition
    -> Identity
         (SchemaRemoteRelationships RemoteRelationshipDefinition))
-> (RemoteRelationships -> Identity RemoteRelationships)
-> RemoteSchemaMetadataG RemoteRelationshipDefinition
-> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SchemaRemoteRelationships RemoteRelationshipDefinition)
-> Lens'
     (SchemaRemoteRelationships RemoteRelationshipDefinition)
     (Maybe
        (IxValue (SchemaRemoteRelationships RemoteRelationshipDefinition)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Name
Index (SchemaRemoteRelationships RemoteRelationshipDefinition)
_crsrrType
    ((Maybe
    (RemoteSchemaTypeRelationships RemoteRelationshipDefinition)
  -> Identity
       (Maybe
          (RemoteSchemaTypeRelationships RemoteRelationshipDefinition)))
 -> SchemaRemoteRelationships RemoteRelationshipDefinition
 -> Identity
      (SchemaRemoteRelationships RemoteRelationshipDefinition))
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> Maybe
         (RemoteSchemaTypeRelationships RemoteRelationshipDefinition)
    -> Identity
         (Maybe
            (RemoteSchemaTypeRelationships RemoteRelationshipDefinition)))
-> (RemoteRelationships -> Identity RemoteRelationships)
-> SchemaRemoteRelationships RemoteRelationshipDefinition
-> Identity
     (SchemaRemoteRelationships RemoteRelationshipDefinition)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteSchemaTypeRelationships RemoteRelationshipDefinition
-> Iso'
     (Maybe
        (RemoteSchemaTypeRelationships RemoteRelationshipDefinition))
     (RemoteSchemaTypeRelationships RemoteRelationshipDefinition)
forall a. Eq a => a -> Iso' (Maybe a) a
non (Name
-> RemoteRelationships
-> RemoteSchemaTypeRelationships RemoteRelationshipDefinition
forall r.
Name -> RemoteRelationships r -> RemoteSchemaTypeRelationships r
RemoteSchemaTypeRelationships Name
_crsrrType RemoteRelationships
forall a. Monoid a => a
mempty)
    ((RemoteSchemaTypeRelationships RemoteRelationshipDefinition
  -> Identity
       (RemoteSchemaTypeRelationships RemoteRelationshipDefinition))
 -> Maybe
      (RemoteSchemaTypeRelationships RemoteRelationshipDefinition)
 -> Identity
      (Maybe
         (RemoteSchemaTypeRelationships RemoteRelationshipDefinition)))
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> RemoteSchemaTypeRelationships RemoteRelationshipDefinition
    -> Identity
         (RemoteSchemaTypeRelationships RemoteRelationshipDefinition))
-> (RemoteRelationships -> Identity RemoteRelationships)
-> Maybe
     (RemoteSchemaTypeRelationships RemoteRelationshipDefinition)
-> Identity
     (Maybe
        (RemoteSchemaTypeRelationships RemoteRelationshipDefinition))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteRelationships -> Identity RemoteRelationships)
-> RemoteSchemaTypeRelationships RemoteRelationshipDefinition
-> Identity
     (RemoteSchemaTypeRelationships RemoteRelationshipDefinition)
forall r1 r2 (f :: * -> *).
Functor f =>
(RemoteRelationships r1 -> f (RemoteRelationships r2))
-> RemoteSchemaTypeRelationships r1
-> f (RemoteSchemaTypeRelationships r2)
rstrsRelationships
    ((RemoteRelationships -> Identity RemoteRelationships)
 -> Metadata -> Identity Metadata)
-> (RemoteRelationships -> RemoteRelationships)
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RelName
-> RemoteRelationship -> RemoteRelationships -> RemoteRelationships
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert RelName
_crsrrName (RelName -> RemoteRelationshipDefinition -> RemoteRelationship
forall definition.
RelName -> definition -> RemoteRelationshipG definition
RemoteRelationship RelName
_crsrrName RemoteRelationshipDefinition
_crsrrDefinition)
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

runUpdateRemoteSchemaRemoteRelationship ::
  forall m.
  (MonadError QErr m, CacheRWM m, MetadataM m) =>
  CreateRemoteSchemaRemoteRelationship ->
  m EncJSON
runUpdateRemoteSchemaRemoteRelationship :: forall (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m) =>
CreateRemoteSchemaRemoteRelationship -> m EncJSON
runUpdateRemoteSchemaRemoteRelationship crss :: CreateRemoteSchemaRemoteRelationship
crss@CreateRemoteSchemaRemoteRelationship {Name
RelName
RemoteSchemaName
RemoteRelationshipDefinition
_crsrrRemoteSchema :: CreateRemoteSchemaRemoteRelationship -> RemoteSchemaName
_crsrrType :: CreateRemoteSchemaRemoteRelationship -> Name
_crsrrName :: CreateRemoteSchemaRemoteRelationship -> RelName
_crsrrDefinition :: CreateRemoteSchemaRemoteRelationship
-> RemoteRelationshipDefinition
_crsrrRemoteSchema :: RemoteSchemaName
_crsrrType :: Name
_crsrrName :: RelName
_crsrrDefinition :: RemoteRelationshipDefinition
..} = do
  SchemaCache
schemaCache <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  let remoteRelationship :: Maybe (RemoteFieldInfo Name)
remoteRelationship =
        SchemaCache
schemaCache
          SchemaCache
-> Getting
     (First (RemoteFieldInfo Name)) SchemaCache (RemoteFieldInfo Name)
-> Maybe (RemoteFieldInfo Name)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (SchemaCache -> RemoteSchemaMap)
-> (RemoteSchemaMap
    -> Const (First (RemoteFieldInfo Name)) RemoteSchemaMap)
-> SchemaCache
-> Const (First (RemoteFieldInfo Name)) SchemaCache
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SchemaCache -> RemoteSchemaMap
scRemoteSchemas
            ((RemoteSchemaMap
  -> Const (First (RemoteFieldInfo Name)) RemoteSchemaMap)
 -> SchemaCache -> Const (First (RemoteFieldInfo Name)) SchemaCache)
-> ((RemoteFieldInfo Name
     -> Const (First (RemoteFieldInfo Name)) (RemoteFieldInfo Name))
    -> RemoteSchemaMap
    -> Const (First (RemoteFieldInfo Name)) RemoteSchemaMap)
-> Getting
     (First (RemoteFieldInfo Name)) SchemaCache (RemoteFieldInfo Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index RemoteSchemaMap
-> Traversal' RemoteSchemaMap (IxValue RemoteSchemaMap)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index RemoteSchemaMap
RemoteSchemaName
_crsrrRemoteSchema
            ((RemoteSchemaCtxG (RemoteFieldInfo Name)
  -> Const
       (First (RemoteFieldInfo Name))
       (RemoteSchemaCtxG (RemoteFieldInfo Name)))
 -> RemoteSchemaMap
 -> Const (First (RemoteFieldInfo Name)) RemoteSchemaMap)
-> ((RemoteFieldInfo Name
     -> Const (First (RemoteFieldInfo Name)) (RemoteFieldInfo Name))
    -> RemoteSchemaCtxG (RemoteFieldInfo Name)
    -> Const
         (First (RemoteFieldInfo Name))
         (RemoteSchemaCtxG (RemoteFieldInfo Name)))
-> (RemoteFieldInfo Name
    -> Const (First (RemoteFieldInfo Name)) (RemoteFieldInfo Name))
-> RemoteSchemaMap
-> Const (First (RemoteFieldInfo Name)) RemoteSchemaMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteSchemaRelationshipsG (RemoteFieldInfo Name)
 -> Const
      (First (RemoteFieldInfo Name))
      (RemoteSchemaRelationshipsG (RemoteFieldInfo Name)))
-> RemoteSchemaCtxG (RemoteFieldInfo Name)
-> Const
     (First (RemoteFieldInfo Name))
     (RemoteSchemaCtxG (RemoteFieldInfo Name))
forall remoteFieldInfo1 remoteFieldInfo2 (f :: * -> *).
Functor f =>
(RemoteSchemaRelationshipsG remoteFieldInfo1
 -> f (RemoteSchemaRelationshipsG remoteFieldInfo2))
-> RemoteSchemaCtxG remoteFieldInfo1
-> f (RemoteSchemaCtxG remoteFieldInfo2)
rscRemoteRelationships
            ((RemoteSchemaRelationshipsG (RemoteFieldInfo Name)
  -> Const
       (First (RemoteFieldInfo Name))
       (RemoteSchemaRelationshipsG (RemoteFieldInfo Name)))
 -> RemoteSchemaCtxG (RemoteFieldInfo Name)
 -> Const
      (First (RemoteFieldInfo Name))
      (RemoteSchemaCtxG (RemoteFieldInfo Name)))
-> ((RemoteFieldInfo Name
     -> Const (First (RemoteFieldInfo Name)) (RemoteFieldInfo Name))
    -> RemoteSchemaRelationshipsG (RemoteFieldInfo Name)
    -> Const
         (First (RemoteFieldInfo Name))
         (RemoteSchemaRelationshipsG (RemoteFieldInfo Name)))
-> (RemoteFieldInfo Name
    -> Const (First (RemoteFieldInfo Name)) (RemoteFieldInfo Name))
-> RemoteSchemaCtxG (RemoteFieldInfo Name)
-> Const
     (First (RemoteFieldInfo Name))
     (RemoteSchemaCtxG (RemoteFieldInfo Name))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (RemoteSchemaRelationshipsG (RemoteFieldInfo Name))
-> Traversal'
     (RemoteSchemaRelationshipsG (RemoteFieldInfo Name))
     (IxValue (RemoteSchemaRelationshipsG (RemoteFieldInfo Name)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Name
Index (RemoteSchemaRelationshipsG (RemoteFieldInfo Name))
_crsrrType
            ((InsOrdHashMap RelName (RemoteFieldInfo Name)
  -> Const
       (First (RemoteFieldInfo Name))
       (InsOrdHashMap RelName (RemoteFieldInfo Name)))
 -> RemoteSchemaRelationshipsG (RemoteFieldInfo Name)
 -> Const
      (First (RemoteFieldInfo Name))
      (RemoteSchemaRelationshipsG (RemoteFieldInfo Name)))
-> ((RemoteFieldInfo Name
     -> Const (First (RemoteFieldInfo Name)) (RemoteFieldInfo Name))
    -> InsOrdHashMap RelName (RemoteFieldInfo Name)
    -> Const
         (First (RemoteFieldInfo Name))
         (InsOrdHashMap RelName (RemoteFieldInfo Name)))
-> (RemoteFieldInfo Name
    -> Const (First (RemoteFieldInfo Name)) (RemoteFieldInfo Name))
-> RemoteSchemaRelationshipsG (RemoteFieldInfo Name)
-> Const
     (First (RemoteFieldInfo Name))
     (RemoteSchemaRelationshipsG (RemoteFieldInfo Name))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap RelName (RemoteFieldInfo Name))
-> Traversal'
     (InsOrdHashMap RelName (RemoteFieldInfo Name))
     (IxValue (InsOrdHashMap RelName (RemoteFieldInfo Name)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (InsOrdHashMap RelName (RemoteFieldInfo Name))
RelName
_crsrrName
  m (RemoteFieldInfo Name) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    (m (RemoteFieldInfo Name) -> m ())
-> m (RemoteFieldInfo Name) -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe (RemoteFieldInfo Name)
-> m (RemoteFieldInfo Name) -> m (RemoteFieldInfo Name)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing Maybe (RemoteFieldInfo Name)
remoteRelationship
    (m (RemoteFieldInfo Name) -> m (RemoteFieldInfo Name))
-> m (RemoteFieldInfo Name) -> m (RemoteFieldInfo Name)
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m (RemoteFieldInfo Name)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
    (Text -> m (RemoteFieldInfo Name))
-> Text -> m (RemoteFieldInfo Name)
forall a b. (a -> b) -> a -> b
$ Text
"no relationship defined on remote schema "
    Text -> Text -> Text
forall t. ToTxt t => Text -> t -> Text
<>> RemoteSchemaName
_crsrrRemoteSchema
    RemoteSchemaName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" with name "
    Text -> RelName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> RelName
_crsrrName
  CreateRemoteSchemaRemoteRelationship -> m EncJSON
forall (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m) =>
CreateRemoteSchemaRemoteRelationship -> m EncJSON
runCreateRemoteSchemaRemoteRelationship CreateRemoteSchemaRemoteRelationship
crss

--------------------------------------------------------------------------------
-- Drop relationship from remote schema

-- | Argument to the @_drop_remote_relationship@ family of metadata commands.
data DeleteRemoteSchemaRemoteRelationship = DeleteRemoteSchemaRemoteRelationship
  { DeleteRemoteSchemaRemoteRelationship -> RemoteSchemaName
_drsrrRemoteSchema :: RemoteSchemaName,
    DeleteRemoteSchemaRemoteRelationship -> Name
_drsrrTypeName :: G.Name,
    DeleteRemoteSchemaRemoteRelationship -> RelName
_drsrrName :: RelName
  }

instance FromJSON DeleteRemoteSchemaRemoteRelationship where
  parseJSON :: Value -> Parser DeleteRemoteSchemaRemoteRelationship
parseJSON = String
-> (Object -> Parser DeleteRemoteSchemaRemoteRelationship)
-> Value
-> Parser DeleteRemoteSchemaRemoteRelationship
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"DeleteRemoteSchemaRemoteRelationship" ((Object -> Parser DeleteRemoteSchemaRemoteRelationship)
 -> Value -> Parser DeleteRemoteSchemaRemoteRelationship)
-> (Object -> Parser DeleteRemoteSchemaRemoteRelationship)
-> Value
-> Parser DeleteRemoteSchemaRemoteRelationship
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    RemoteSchemaName
-> Name -> RelName -> DeleteRemoteSchemaRemoteRelationship
DeleteRemoteSchemaRemoteRelationship
      (RemoteSchemaName
 -> Name -> RelName -> DeleteRemoteSchemaRemoteRelationship)
-> Parser RemoteSchemaName
-> Parser (Name -> RelName -> DeleteRemoteSchemaRemoteRelationship)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser RemoteSchemaName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"remote_schema"
      Parser (Name -> RelName -> DeleteRemoteSchemaRemoteRelationship)
-> Parser Name
-> Parser (RelName -> DeleteRemoteSchemaRemoteRelationship)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser Name
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type_name"
      Parser (RelName -> DeleteRemoteSchemaRemoteRelationship)
-> Parser RelName -> Parser DeleteRemoteSchemaRemoteRelationship
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser RelName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"

runDeleteRemoteSchemaRemoteRelationship ::
  forall m.
  (MonadError QErr m, CacheRWM m, MetadataM m) =>
  DeleteRemoteSchemaRemoteRelationship ->
  m EncJSON
runDeleteRemoteSchemaRemoteRelationship :: forall (m :: * -> *).
(MonadError QErr m, CacheRWM m, MetadataM m) =>
DeleteRemoteSchemaRemoteRelationship -> m EncJSON
runDeleteRemoteSchemaRemoteRelationship DeleteRemoteSchemaRemoteRelationship {Name
RelName
RemoteSchemaName
_drsrrRemoteSchema :: DeleteRemoteSchemaRemoteRelationship -> RemoteSchemaName
_drsrrTypeName :: DeleteRemoteSchemaRemoteRelationship -> Name
_drsrrName :: DeleteRemoteSchemaRemoteRelationship -> RelName
_drsrrRemoteSchema :: RemoteSchemaName
_drsrrTypeName :: Name
_drsrrName :: RelName
..} = do
  let relName :: RelName
relName = RelName
_drsrrName
      metadataObj :: MetadataObjId
metadataObj =
        RemoteSchemaName -> Name -> RelName -> MetadataObjId
MORemoteSchemaRemoteRelationship RemoteSchemaName
_drsrrRemoteSchema Name
_drsrrTypeName RelName
relName
  MetadataObjId -> MetadataModifier -> m ()
forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
MetadataObjId -> MetadataModifier -> m ()
buildSchemaCacheFor MetadataObjId
metadataObj
    (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)
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> RemoteSchemas -> Identity RemoteSchemas)
-> (RemoteRelationships -> Identity RemoteRelationships)
-> 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
_drsrrRemoteSchema
    ((RemoteSchemaMetadataG RemoteRelationshipDefinition
  -> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition))
 -> RemoteSchemas -> Identity RemoteSchemas)
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> RemoteSchemaMetadataG RemoteRelationshipDefinition
    -> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition))
-> (RemoteRelationships -> Identity RemoteRelationships)
-> RemoteSchemas
-> Identity RemoteSchemas
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SchemaRemoteRelationships RemoteRelationshipDefinition
 -> Identity
      (SchemaRemoteRelationships RemoteRelationshipDefinition))
-> RemoteSchemaMetadataG RemoteRelationshipDefinition
-> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition)
forall r1 r2 (f :: * -> *).
Functor f =>
(SchemaRemoteRelationships r1 -> f (SchemaRemoteRelationships r2))
-> RemoteSchemaMetadataG r1 -> f (RemoteSchemaMetadataG r2)
rsmRemoteRelationships
    ((SchemaRemoteRelationships RemoteRelationshipDefinition
  -> Identity
       (SchemaRemoteRelationships RemoteRelationshipDefinition))
 -> RemoteSchemaMetadataG RemoteRelationshipDefinition
 -> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition))
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> SchemaRemoteRelationships RemoteRelationshipDefinition
    -> Identity
         (SchemaRemoteRelationships RemoteRelationshipDefinition))
-> (RemoteRelationships -> Identity RemoteRelationships)
-> RemoteSchemaMetadataG RemoteRelationshipDefinition
-> Identity (RemoteSchemaMetadataG RemoteRelationshipDefinition)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (SchemaRemoteRelationships RemoteRelationshipDefinition)
-> Traversal'
     (SchemaRemoteRelationships RemoteRelationshipDefinition)
     (IxValue (SchemaRemoteRelationships RemoteRelationshipDefinition))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Name
Index (SchemaRemoteRelationships RemoteRelationshipDefinition)
_drsrrTypeName
    ((RemoteSchemaTypeRelationships RemoteRelationshipDefinition
  -> Identity
       (RemoteSchemaTypeRelationships RemoteRelationshipDefinition))
 -> SchemaRemoteRelationships RemoteRelationshipDefinition
 -> Identity
      (SchemaRemoteRelationships RemoteRelationshipDefinition))
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> RemoteSchemaTypeRelationships RemoteRelationshipDefinition
    -> Identity
         (RemoteSchemaTypeRelationships RemoteRelationshipDefinition))
-> (RemoteRelationships -> Identity RemoteRelationships)
-> SchemaRemoteRelationships RemoteRelationshipDefinition
-> Identity
     (SchemaRemoteRelationships RemoteRelationshipDefinition)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteRelationships -> Identity RemoteRelationships)
-> RemoteSchemaTypeRelationships RemoteRelationshipDefinition
-> Identity
     (RemoteSchemaTypeRelationships RemoteRelationshipDefinition)
forall r1 r2 (f :: * -> *).
Functor f =>
(RemoteRelationships r1 -> f (RemoteRelationships r2))
-> RemoteSchemaTypeRelationships r1
-> f (RemoteSchemaTypeRelationships r2)
rstrsRelationships
    ((RemoteRelationships -> Identity RemoteRelationships)
 -> Metadata -> Identity Metadata)
-> (RemoteRelationships -> RemoteRelationships)
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RelName -> RemoteRelationships -> RemoteRelationships
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete RelName
relName
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

--------------------------------------------------------------------------------
-- Schema cache building (TODO: move this elsewere!)

-- | Internal intermediary step.
--
-- We build the output of sources in two steps:
--   1. we first resolve sources, and collect the core info of their tables
--   2. we then build the entire output from the collection of partially resolved sources
--
-- We need this split to be able to resolve cross-source relationships: to process one source's
-- remote relationship, we need to know about the target source's tables core info.
--
-- This data structure is used as an argument to @AnyBackend@ in the backend-agnostic intermediary
-- collection, and used here to build remote field info.
data PartiallyResolvedSource b = PartiallyResolvedSource
  { forall (b :: BackendType).
PartiallyResolvedSource b -> SourceMetadata b
_prsSourceMetadata :: SourceMetadata b,
    forall (b :: BackendType).
PartiallyResolvedSource b -> SourceConfig b
_prsConfig :: SourceConfig b,
    forall (b :: BackendType).
PartiallyResolvedSource b -> DBObjectsIntrospection b
_prsIntrospection :: DBObjectsIntrospection b,
    forall (b :: BackendType).
PartiallyResolvedSource b
-> HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
_tableCoreInfoMap :: HashMap (TableName b) (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)),
    forall (b :: BackendType).
PartiallyResolvedSource b
-> HashMap (TableName b) (EventTriggerInfoMap b)
_eventTriggerInfoMap :: HashMap (TableName b) (EventTriggerInfoMap b)
  }
  deriving (PartiallyResolvedSource b -> PartiallyResolvedSource b -> Bool
(PartiallyResolvedSource b -> PartiallyResolvedSource b -> Bool)
-> (PartiallyResolvedSource b -> PartiallyResolvedSource b -> Bool)
-> Eq (PartiallyResolvedSource b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType).
Backend b =>
PartiallyResolvedSource b -> PartiallyResolvedSource b -> Bool
$c== :: forall (b :: BackendType).
Backend b =>
PartiallyResolvedSource b -> PartiallyResolvedSource b -> Bool
== :: PartiallyResolvedSource b -> PartiallyResolvedSource b -> Bool
$c/= :: forall (b :: BackendType).
Backend b =>
PartiallyResolvedSource b -> PartiallyResolvedSource b -> Bool
/= :: PartiallyResolvedSource b -> PartiallyResolvedSource b -> Bool
Eq)

-- | Builds the schema cache representation of a remote relationship
-- TODO: this is not actually called by the remote relationship DDL API and is only used as part of
-- the schema cache process. Should this be moved elsewhere?
buildRemoteFieldInfo ::
  (QErrM m) =>
  -- | The entity on which the remote relationship is defined
  LHSIdentifier ->
  -- | join fields provided by the LHS entity
  HashMap.HashMap FieldName lhsJoinField ->
  -- | definition of remote relationship
  RemoteRelationship ->
  -- | Required context to process cross boundary relationships
  HashMap SourceName (AB.AnyBackend PartiallyResolvedSource) ->
  -- | Required context to process cross boundary relationships
  PartiallyResolvedRemoteSchemaMap ->
  -- | returns
  --   1. schema cache representation of the remote relationships
  --   2. the dependencies on the RHS of the join. The dependencies
  --      on the LHS entities has to be handled by the calling function
  m (RemoteFieldInfo lhsJoinField, Seq SchemaDependency)
buildRemoteFieldInfo :: forall (m :: * -> *) lhsJoinField.
QErrM m =>
LHSIdentifier
-> HashMap FieldName lhsJoinField
-> RemoteRelationship
-> HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> PartiallyResolvedRemoteSchemaMap
-> m (RemoteFieldInfo lhsJoinField, Seq SchemaDependency)
buildRemoteFieldInfo LHSIdentifier
lhsIdentifier HashMap FieldName lhsJoinField
lhsJoinFields RemoteRelationship {RelName
RemoteRelationshipDefinition
_rrName :: RelName
_rrDefinition :: RemoteRelationshipDefinition
_rrName :: forall definition. RemoteRelationshipG definition -> RelName
_rrDefinition :: forall definition. RemoteRelationshipG definition -> definition
..} HashMap SourceName (AnyBackend PartiallyResolvedSource)
allSources PartiallyResolvedRemoteSchemaMap
remoteSchemaMap =
  case RemoteRelationshipDefinition
_rrDefinition of
    RelationshipToSource ToSourceRelationshipDef {Value
HashMap FieldName FieldName
SourceName
RelType
_tsrdRelationshipType :: RelType
_tsrdFieldMapping :: HashMap FieldName FieldName
_tsrdSource :: SourceName
_tsrdTable :: Value
_tsrdRelationshipType :: ToSourceRelationshipDef -> RelType
_tsrdFieldMapping :: ToSourceRelationshipDef -> HashMap FieldName FieldName
_tsrdSource :: ToSourceRelationshipDef -> SourceName
_tsrdTable :: ToSourceRelationshipDef -> Value
..} -> do
      AnyBackend PartiallyResolvedSource
targetTables <-
        SourceName
-> HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> Maybe (AnyBackend PartiallyResolvedSource)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup SourceName
_tsrdSource HashMap SourceName (AnyBackend PartiallyResolvedSource)
allSources
          Maybe (AnyBackend PartiallyResolvedSource)
-> m (AnyBackend PartiallyResolvedSource)
-> m (AnyBackend PartiallyResolvedSource)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m (AnyBackend PartiallyResolvedSource)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound (Text
"source not found: " Text -> SourceName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> SourceName
_tsrdSource)
      forall (c1 :: BackendType -> Constraint)
       (c2 :: BackendType -> Constraint) (i :: BackendType -> *) r.
(AllBackendsSatisfy c1, AllBackendsSatisfy c2) =>
AnyBackend i
-> (forall (b :: BackendType). (c1 b, c2 b) => i b -> r) -> r
AB.dispatchAnyBackendWithTwoConstraints @Backend @BackendMetadata AnyBackend PartiallyResolvedSource
targetTables \(PartiallyResolvedSource b
partiallyResolvedSource :: PartiallyResolvedSource b') -> do
        let PartiallyResolvedSource SourceMetadata b
_ SourceConfig b
sourceConfig DBObjectsIntrospection b
_ HashMap
  (TableName b)
  (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
targetTablesInfo HashMap (TableName b) (EventTriggerInfoMap b)
_ = PartiallyResolvedSource b
partiallyResolvedSource
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (b :: BackendType).
BackendMetadata b =>
SourceConfig b -> Bool
supportsBeingRemoteRelationshipTarget @b' SourceConfig b
sourceConfig)
          (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
NotSupported (Text
"source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
sourceNameToText SourceName
_tsrdSource Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" does not support being used as the target of a remote relationship")

        (TableName b
targetTable :: TableName b') <- (Value -> Parser (TableName b)) -> Value -> m (TableName b)
forall (m :: * -> *) v a. QErrM m => (v -> Parser a) -> v -> m a
runAesonParser Value -> Parser (TableName b)
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
_tsrdTable
        FieldInfoMap (StructuredColumnInfo b)
targetColumns <-
          (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
 -> FieldInfoMap (StructuredColumnInfo b))
-> m (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
-> m (FieldInfoMap (StructuredColumnInfo b))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)
-> FieldInfoMap (StructuredColumnInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap
            (m (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
 -> m (FieldInfoMap (StructuredColumnInfo b)))
-> m (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
-> m (FieldInfoMap (StructuredColumnInfo b))
forall a b. (a -> b) -> a -> b
$ Maybe (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
-> m (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
-> m (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (TableName b
-> HashMap
     (TableName b)
     (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
-> Maybe (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup TableName b
targetTable HashMap
  (TableName b)
  (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
targetTablesInfo)
            (m (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
 -> m (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)))
-> m (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
-> m (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
forall a b. (a -> b) -> a -> b
$ Code
-> Text
-> m (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
            (Text
 -> m (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b)))
-> Text
-> m (TableCoreInfoG b (StructuredColumnInfo b) (ColumnInfo b))
forall a b. (a -> b) -> a -> b
$ Text
"table "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b
targetTable
            TableName b -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist in source: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
sourceNameToText SourceName
_tsrdSource
        -- TODO: rhs fields should also ideally be DBJoinFields
        [(FieldName, lhsJoinField, ColumnInfo b)]
columnPairs <- [(FieldName, FieldName)]
-> ((FieldName, FieldName)
    -> m (FieldName, lhsJoinField, ColumnInfo b))
-> m [(FieldName, lhsJoinField, ColumnInfo b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (HashMap FieldName FieldName -> [(FieldName, FieldName)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap FieldName FieldName
_tsrdFieldMapping) \(FieldName
srcFieldName, FieldName
tgtFieldName) -> do
          lhsJoinField
lhsJoinField <- HashMap FieldName lhsJoinField -> FieldName -> m lhsJoinField
forall (m :: * -> *) fieldInfo.
MonadError QErr m =>
FieldInfoMap fieldInfo -> FieldName -> m fieldInfo
askFieldInfo HashMap FieldName lhsJoinField
lhsJoinFields FieldName
srcFieldName
          Maybe (ColumnInfo b)
tgtField <- StructuredColumnInfo b -> Maybe (ColumnInfo b)
forall (b :: BackendType).
StructuredColumnInfo b -> Maybe (ColumnInfo b)
toScalarColumnInfo (StructuredColumnInfo b -> Maybe (ColumnInfo b))
-> m (StructuredColumnInfo b) -> m (Maybe (ColumnInfo b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldInfoMap (StructuredColumnInfo b)
-> FieldName -> m (StructuredColumnInfo b)
forall (m :: * -> *) fieldInfo.
MonadError QErr m =>
FieldInfoMap fieldInfo -> FieldName -> m fieldInfo
askFieldInfo FieldInfoMap (StructuredColumnInfo b)
targetColumns FieldName
tgtFieldName
          ColumnInfo b
tgtFieldScalarColumn <- Maybe (ColumnInfo b)
tgtField Maybe (ColumnInfo b) -> m (ColumnInfo b) -> m (ColumnInfo b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> m (ColumnInfo b)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text
"Target field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldName
tgtFieldName FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
"is not a scalar column")
          (FieldName, lhsJoinField, ColumnInfo b)
-> m (FieldName, lhsJoinField, ColumnInfo b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldName
srcFieldName, lhsJoinField
lhsJoinField, ColumnInfo b
tgtFieldScalarColumn)
        [(FieldName, (lhsJoinField, ScalarType b, Column b))]
columnMapping <- [(FieldName, lhsJoinField, ColumnInfo b)]
-> ((FieldName, lhsJoinField, ColumnInfo b)
    -> m (FieldName, (lhsJoinField, ScalarType b, Column b)))
-> m [(FieldName, (lhsJoinField, ScalarType b, Column b))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(FieldName, lhsJoinField, ColumnInfo b)]
columnPairs \(FieldName
srcFieldName, lhsJoinField
srcColumn, ColumnInfo b
tgtColumn) -> do
          ScalarType b
tgtScalar <- case ColumnInfo b -> ColumnType b
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType ColumnInfo b
tgtColumn of
            ColumnScalar ScalarType b
scalarType -> ScalarType b -> m (ScalarType b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarType b
scalarType
            ColumnEnumReference EnumReference b
_ -> Code -> Text -> m (ScalarType b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"relationships to enum fields are not supported yet"
          (FieldName, (lhsJoinField, ScalarType b, Column b))
-> m (FieldName, (lhsJoinField, ScalarType b, Column b))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldName
srcFieldName, (lhsJoinField
srcColumn, ScalarType b
tgtScalar, ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo b
tgtColumn))
        let rsri :: RemoteSourceFieldInfo b
rsri =
              RelName
-> RelType
-> SourceName
-> SourceConfig b
-> TableName b
-> HashMap FieldName (ScalarType b, Column b)
-> RemoteSourceFieldInfo b
forall (tgt :: BackendType).
RelName
-> RelType
-> SourceName
-> SourceConfig tgt
-> TableName tgt
-> HashMap FieldName (ScalarType tgt, Column tgt)
-> RemoteSourceFieldInfo tgt
RemoteSourceFieldInfo RelName
_rrName RelType
_tsrdRelationshipType SourceName
_tsrdSource SourceConfig b
sourceConfig TableName b
targetTable
                (HashMap FieldName (ScalarType b, Column b)
 -> RemoteSourceFieldInfo b)
-> HashMap FieldName (ScalarType b, Column b)
-> RemoteSourceFieldInfo b
forall a b. (a -> b) -> a -> b
$ ((lhsJoinField, ScalarType b, Column b)
 -> (ScalarType b, Column b))
-> HashMap FieldName (lhsJoinField, ScalarType b, Column b)
-> HashMap FieldName (ScalarType b, Column b)
forall a b. (a -> b) -> HashMap FieldName a -> HashMap FieldName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(lhsJoinField
_, ScalarType b
tgtType, Column b
tgtColumn) -> (ScalarType b
tgtType, Column b
tgtColumn))
                (HashMap FieldName (lhsJoinField, ScalarType b, Column b)
 -> HashMap FieldName (ScalarType b, Column b))
-> HashMap FieldName (lhsJoinField, ScalarType b, Column b)
-> HashMap FieldName (ScalarType b, Column b)
forall a b. (a -> b) -> a -> b
$ [(FieldName, (lhsJoinField, ScalarType b, Column b))]
-> HashMap FieldName (lhsJoinField, ScalarType b, Column b)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(FieldName, (lhsJoinField, ScalarType b, Column b))]
columnMapping
            rhsDependencies :: [SchemaDependency]
rhsDependencies =
              SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency (SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
_tsrdSource (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). TableName b -> SourceObjId b
SOITable @b' TableName b
targetTable) DependencyReason
DRTable
                SchemaDependency -> [SchemaDependency] -> [SchemaDependency]
forall a. a -> [a] -> [a]
: (((FieldName, lhsJoinField, ColumnInfo b) -> SchemaDependency)
 -> [(FieldName, lhsJoinField, ColumnInfo b)] -> [SchemaDependency])
-> [(FieldName, lhsJoinField, ColumnInfo b)]
-> ((FieldName, lhsJoinField, ColumnInfo b) -> SchemaDependency)
-> [SchemaDependency]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((FieldName, lhsJoinField, ColumnInfo b) -> SchemaDependency)
-> [(FieldName, lhsJoinField, ColumnInfo b)] -> [SchemaDependency]
forall a b. (a -> b) -> [a] -> [b]
map [(FieldName, lhsJoinField, ColumnInfo b)]
columnPairs \(FieldName
_, lhsJoinField
_srcColumn, ColumnInfo b
tgtColumn) ->
                  SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
                    ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
_tsrdSource
                        (AnyBackend SourceObjId -> SchemaObjId)
-> AnyBackend SourceObjId -> SchemaObjId
forall a b. (a -> b) -> a -> b
$ SourceObjId b -> AnyBackend SourceObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                        (SourceObjId b -> AnyBackend SourceObjId)
-> SourceObjId b -> AnyBackend SourceObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
TableName b -> TableObjId b -> SourceObjId b
SOITableObj @b' TableName b
targetTable
                        (TableObjId b -> SourceObjId b) -> TableObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). Column b -> TableObjId b
TOCol @b'
                        (Column b -> TableObjId b) -> Column b -> TableObjId b
forall a b. (a -> b) -> a -> b
$ ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ColumnInfo b
tgtColumn
                    )
                    DependencyReason
DRRemoteRelationship
            requiredLHSJoinFields :: HashMap FieldName lhsJoinField
requiredLHSJoinFields = ((lhsJoinField, ScalarType b, Column b) -> lhsJoinField)
-> HashMap FieldName (lhsJoinField, ScalarType b, Column b)
-> HashMap FieldName lhsJoinField
forall a b. (a -> b) -> HashMap FieldName a -> HashMap FieldName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(lhsJoinField
srcField, ScalarType b
_, Column b
_) -> lhsJoinField
srcField) (HashMap FieldName (lhsJoinField, ScalarType b, Column b)
 -> HashMap FieldName lhsJoinField)
-> HashMap FieldName (lhsJoinField, ScalarType b, Column b)
-> HashMap FieldName lhsJoinField
forall a b. (a -> b) -> a -> b
$ [(FieldName, (lhsJoinField, ScalarType b, Column b))]
-> HashMap FieldName (lhsJoinField, ScalarType b, Column b)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(FieldName, (lhsJoinField, ScalarType b, Column b))]
columnMapping
        (RemoteFieldInfo lhsJoinField, Seq SchemaDependency)
-> m (RemoteFieldInfo lhsJoinField, Seq SchemaDependency)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap FieldName lhsJoinField
-> RemoteFieldInfoRHS -> RemoteFieldInfo lhsJoinField
forall lhsJoinField.
HashMap FieldName lhsJoinField
-> RemoteFieldInfoRHS -> RemoteFieldInfo lhsJoinField
RemoteFieldInfo HashMap FieldName lhsJoinField
requiredLHSJoinFields (RemoteFieldInfoRHS -> RemoteFieldInfo lhsJoinField)
-> RemoteFieldInfoRHS -> RemoteFieldInfo lhsJoinField
forall a b. (a -> b) -> a -> b
$ AnyBackend RemoteSourceFieldInfo -> RemoteFieldInfoRHS
RFISource (AnyBackend RemoteSourceFieldInfo -> RemoteFieldInfoRHS)
-> AnyBackend RemoteSourceFieldInfo -> RemoteFieldInfoRHS
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend @b' RemoteSourceFieldInfo b
rsri, [SchemaDependency] -> Seq SchemaDependency
forall a. [a] -> Seq a
Seq.fromList [SchemaDependency]
rhsDependencies)
    RelationshipToSchema RRFormat
_ remoteRelationship :: ToSchemaRelationshipDef
remoteRelationship@ToSchemaRelationshipDef {HashSet FieldName
RemoteSchemaName
RemoteFields
_trrdRemoteSchema :: RemoteSchemaName
_trrdLhsFields :: HashSet FieldName
_trrdRemoteField :: RemoteFields
_trrdRemoteSchema :: ToSchemaRelationshipDef -> RemoteSchemaName
_trrdLhsFields :: ToSchemaRelationshipDef -> HashSet FieldName
_trrdRemoteField :: ToSchemaRelationshipDef -> RemoteFields
..} -> do
      RemoteSchemaCtx {HashMap RoleName IntrospectionResult
ByteString
RemoteSchemaRelationshipsG
  (PartiallyResolvedRemoteRelationship RemoteRelationshipDefinition)
RemoteSchemaName
RemoteSchemaInfo
IntrospectionResult
_rscName :: RemoteSchemaName
_rscIntroOriginal :: IntrospectionResult
_rscInfo :: RemoteSchemaInfo
_rscRawIntrospectionResult :: ByteString
_rscPermissions :: HashMap RoleName IntrospectionResult
_rscRemoteRelationships :: RemoteSchemaRelationshipsG
  (PartiallyResolvedRemoteRelationship RemoteRelationshipDefinition)
_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
..} <-
        Maybe
  (RemoteSchemaCtxG
     (PartiallyResolvedRemoteRelationship RemoteRelationshipDefinition))
-> m (RemoteSchemaCtxG
        (PartiallyResolvedRemoteRelationship RemoteRelationshipDefinition))
-> m (RemoteSchemaCtxG
        (PartiallyResolvedRemoteRelationship RemoteRelationshipDefinition))
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (RemoteSchemaName
-> PartiallyResolvedRemoteSchemaMap
-> Maybe
     (RemoteSchemaCtxG
        (PartiallyResolvedRemoteRelationship RemoteRelationshipDefinition))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup RemoteSchemaName
_trrdRemoteSchema PartiallyResolvedRemoteSchemaMap
remoteSchemaMap)
          (m (RemoteSchemaCtxG
      (PartiallyResolvedRemoteRelationship RemoteRelationshipDefinition))
 -> m (RemoteSchemaCtxG
         (PartiallyResolvedRemoteRelationship
            RemoteRelationshipDefinition)))
-> m (RemoteSchemaCtxG
        (PartiallyResolvedRemoteRelationship RemoteRelationshipDefinition))
-> m (RemoteSchemaCtxG
        (PartiallyResolvedRemoteRelationship RemoteRelationshipDefinition))
forall a b. (a -> b) -> a -> b
$ Code
-> Text
-> m (RemoteSchemaCtxG
        (PartiallyResolvedRemoteRelationship RemoteRelationshipDefinition))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError
          (Text
 -> m (RemoteSchemaCtxG
         (PartiallyResolvedRemoteRelationship
            RemoteRelationshipDefinition)))
-> Text
-> m (RemoteSchemaCtxG
        (PartiallyResolvedRemoteRelationship RemoteRelationshipDefinition))
forall a b. (a -> b) -> a -> b
$ Text
"remote schema with name "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoteSchemaName
_trrdRemoteSchema
          RemoteSchemaName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" not found"
      (HashMap FieldName lhsJoinField
requiredLHSJoinFields, RemoteSchemaFieldInfo
remoteField) <-
        ToSchemaRelationshipDef
-> LHSIdentifier
-> RelName
-> (RemoteSchemaInfo, IntrospectionResult)
-> HashMap FieldName lhsJoinField
-> Either
     ValidationError
     (HashMap FieldName lhsJoinField, RemoteSchemaFieldInfo)
forall (m :: * -> *) joinField.
MonadError ValidationError m =>
ToSchemaRelationshipDef
-> LHSIdentifier
-> RelName
-> (RemoteSchemaInfo, IntrospectionResult)
-> HashMap FieldName joinField
-> m (HashMap FieldName joinField, RemoteSchemaFieldInfo)
validateToSchemaRelationship ToSchemaRelationshipDef
remoteRelationship LHSIdentifier
lhsIdentifier RelName
_rrName (RemoteSchemaInfo
_rscInfo, IntrospectionResult
_rscIntroOriginal) HashMap FieldName lhsJoinField
lhsJoinFields
          Either
  ValidationError
  (HashMap FieldName lhsJoinField, RemoteSchemaFieldInfo)
-> (ValidationError
    -> m (HashMap FieldName lhsJoinField, RemoteSchemaFieldInfo))
-> m (HashMap FieldName lhsJoinField, RemoteSchemaFieldInfo)
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` (Code
-> Text
-> m (HashMap FieldName lhsJoinField, RemoteSchemaFieldInfo)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
RemoteSchemaError (Text -> m (HashMap FieldName lhsJoinField, RemoteSchemaFieldInfo))
-> (ValidationError -> Text)
-> ValidationError
-> m (HashMap FieldName lhsJoinField, RemoteSchemaFieldInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidationError -> Text
errorToText)
      let rhsDependency :: SchemaDependency
rhsDependency = SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency (RemoteSchemaName -> SchemaObjId
SORemoteSchema RemoteSchemaName
_trrdRemoteSchema) DependencyReason
DRRemoteSchema
      (RemoteFieldInfo lhsJoinField, Seq SchemaDependency)
-> m (RemoteFieldInfo lhsJoinField, Seq SchemaDependency)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap FieldName lhsJoinField
-> RemoteFieldInfoRHS -> RemoteFieldInfo lhsJoinField
forall lhsJoinField.
HashMap FieldName lhsJoinField
-> RemoteFieldInfoRHS -> RemoteFieldInfo lhsJoinField
RemoteFieldInfo HashMap FieldName lhsJoinField
requiredLHSJoinFields (RemoteFieldInfoRHS -> RemoteFieldInfo lhsJoinField)
-> RemoteFieldInfoRHS -> RemoteFieldInfo lhsJoinField
forall a b. (a -> b) -> a -> b
$ RemoteSchemaFieldInfo -> RemoteFieldInfoRHS
RFISchema RemoteSchemaFieldInfo
remoteField, SchemaDependency -> Seq SchemaDependency
forall a. a -> Seq a
Seq.singleton (SchemaDependency -> Seq SchemaDependency)
-> SchemaDependency -> Seq SchemaDependency
forall a b. (a -> b) -> a -> b
$ SchemaDependency
rhsDependency)

getRemoteSchemaEntityJoinColumns ::
  (MonadError QErr m) =>
  RemoteSchemaName ->
  RemoteSchemaIntrospection ->
  G.Name ->
  m (HashMap FieldName G.Name)
getRemoteSchemaEntityJoinColumns :: forall (m :: * -> *).
MonadError QErr m =>
RemoteSchemaName
-> RemoteSchemaIntrospection -> Name -> m (HashMap FieldName Name)
getRemoteSchemaEntityJoinColumns RemoteSchemaName
remoteSchemaName RemoteSchemaIntrospection
introspection Name
typeName = do
  TypeDefinition [Name] RemoteSchemaInputValueDefinition
typeDefinition <-
    Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> m (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> m (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (RemoteSchemaIntrospection
-> Name
-> Maybe (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
lookupType RemoteSchemaIntrospection
introspection Name
typeName)
      (m (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
 -> m (TypeDefinition [Name] RemoteSchemaInputValueDefinition))
-> m (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
-> m (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall a b. (a -> b) -> a -> b
$ Code
-> Text
-> m (TypeDefinition [Name] RemoteSchemaInputValueDefinition)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound (Text
"no type named " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name
typeName Name -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" defined in remote schema " Text -> RemoteSchemaName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> RemoteSchemaName
remoteSchemaName)
  case TypeDefinition [Name] RemoteSchemaInputValueDefinition
typeDefinition of
    G.TypeDefinitionObject ObjectTypeDefinition RemoteSchemaInputValueDefinition
objectDefinition ->
      HashMap FieldName Name -> m (HashMap FieldName Name)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (HashMap FieldName Name -> m (HashMap FieldName Name))
-> HashMap FieldName Name -> m (HashMap FieldName Name)
forall a b. (a -> b) -> a -> b
$ [(FieldName, Name)] -> HashMap FieldName Name
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
        ([(FieldName, Name)] -> HashMap FieldName Name)
-> [(FieldName, Name)] -> HashMap FieldName Name
forall a b. (a -> b) -> a -> b
$ do
          FieldDefinition RemoteSchemaInputValueDefinition
fieldDefinition <- ObjectTypeDefinition RemoteSchemaInputValueDefinition
-> [FieldDefinition RemoteSchemaInputValueDefinition]
forall inputType.
ObjectTypeDefinition inputType -> [FieldDefinition inputType]
G._otdFieldsDefinition ObjectTypeDefinition RemoteSchemaInputValueDefinition
objectDefinition
          Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ [RemoteSchemaInputValueDefinition] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([RemoteSchemaInputValueDefinition] -> Bool)
-> [RemoteSchemaInputValueDefinition] -> Bool
forall a b. (a -> b) -> a -> b
$ FieldDefinition RemoteSchemaInputValueDefinition
-> [RemoteSchemaInputValueDefinition]
forall inputType.
FieldDefinition inputType -> ArgumentsDefinition inputType
G._fldArgumentsDefinition FieldDefinition RemoteSchemaInputValueDefinition
fieldDefinition
          (FieldName, Name) -> [(FieldName, Name)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> FieldName
FieldName (Text -> FieldName) -> Text -> FieldName
forall a b. (a -> b) -> a -> b
$ Name -> Text
G.unName (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ FieldDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName FieldDefinition RemoteSchemaInputValueDefinition
fieldDefinition, FieldDefinition RemoteSchemaInputValueDefinition -> Name
forall inputType. FieldDefinition inputType -> Name
G._fldName FieldDefinition RemoteSchemaInputValueDefinition
fieldDefinition)
    TypeDefinition [Name] RemoteSchemaInputValueDefinition
_ -> Code -> Text -> m (HashMap FieldName Name)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"remote relationships on a remote schema can only be defined on object types"