{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module Hasura.RQL.DDL.RemoteRelationship
  ( CreateFromSourceRelationship (..),
    runCreateRemoteRelationship,
    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.Aeson.TH qualified as J
import Data.HashMap.Strict qualified as Map
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.Text.Extended ((<<>), (<>>))
import Hasura.Base.Error
  ( Code (NotExists, NotFound, NotSupported, RemoteSchemaError),
    QErr,
    QErrM,
    runAesonParser,
    throw400,
  )
import Hasura.EncJSON (EncJSON)
import Hasura.Prelude
import Hasura.RQL.DDL.RemoteRelationship.Validate
  ( errorToText,
    validateToSchemaRelationship,
  )
import Hasura.RQL.Types.Backend
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.ToSchema
import Hasura.RQL.Types.Relationships.ToSource
import Hasura.RQL.Types.RemoteSchema
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.RQL.Types.Source
import Hasura.RQL.Types.Table
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.Backend
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
  { CreateFromSourceRelationship b -> SourceName
_crrSource :: SourceName,
    CreateFromSourceRelationship b -> TableName b
_crrTable :: TableName b,
    CreateFromSourceRelationship b -> RelName
_crrName :: RelName,
    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 (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 (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 :: forall (b :: BackendType).
SourceName
-> TableName b
-> RelName
-> RemoteRelationshipDefinition
-> CreateFromSourceRelationship b
CreateFromSourceRelationship {SourceName
RelName
TableName b
RemoteRelationshipDefinition
_crrDefinition :: RemoteRelationshipDefinition
_crrName :: RelName
_crrTable :: TableName b
_crrSource :: SourceName
_crrDefinition :: RemoteRelationshipDefinition
_crrName :: RelName
_crrTable :: TableName b
_crrSource :: SourceName
..}

instance (Backend b) => ToJSON (CreateFromSourceRelationship b) where
  toJSON :: CreateFromSourceRelationship b -> Value
toJSON CreateFromSourceRelationship {SourceName
RelName
TableName b
RemoteRelationshipDefinition
_crrDefinition :: RemoteRelationshipDefinition
_crrName :: RelName
_crrTable :: TableName b
_crrSource :: SourceName
_crrDefinition :: forall (b :: BackendType).
CreateFromSourceRelationship b -> RemoteRelationshipDefinition
_crrName :: forall (b :: BackendType).
CreateFromSourceRelationship b -> RelName
_crrTable :: forall (b :: BackendType).
CreateFromSourceRelationship b -> TableName b
_crrSource :: forall (b :: BackendType).
CreateFromSourceRelationship b -> SourceName
..} =
    -- 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
.= 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
.= SourceName
_crrSource,
          Key
"table" Key -> TableName b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TableName b
_crrTable,
          Key
"name" Key -> RelName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RelName
_crrName
        ]

runCreateRemoteRelationship ::
  forall b m.
  (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
  CreateFromSourceRelationship b ->
  m EncJSON
runCreateRemoteRelationship :: CreateFromSourceRelationship b -> m EncJSON
runCreateRemoteRelationship CreateFromSourceRelationship {SourceName
RelName
TableName b
RemoteRelationshipDefinition
_crrDefinition :: RemoteRelationshipDefinition
_crrName :: RelName
_crrTable :: TableName b
_crrSource :: SourceName
_crrDefinition :: forall (b :: BackendType).
CreateFromSourceRelationship b -> RemoteRelationshipDefinition
_crrName :: forall (b :: BackendType).
CreateFromSourceRelationship b -> RelName
_crrTable :: forall (b :: BackendType).
CreateFromSourceRelationship b -> TableName b
_crrSource :: forall (b :: BackendType).
CreateFromSourceRelationship b -> SourceName
..} = 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
$ SourceName -> TableName b -> m (TableInfo 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
$
            TableName b -> TableMetadataObjId -> SourceMetadataObjId 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
$
      SourceName -> TableName b -> ASetter' Metadata (TableMetadata 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).
Lens' (TableMetadata b) RemoteRelationships
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
OMap.insert RelName
_crrName (RelName -> RemoteRelationshipDefinition -> RemoteRelationship
RemoteRelationship RelName
_crrName RemoteRelationshipDefinition
_crrDefinition)
  EncJSON -> m EncJSON
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 :: CreateFromSourceRelationship b -> m EncJSON
runUpdateRemoteRelationship CreateFromSourceRelationship {SourceName
RelName
TableName b
RemoteRelationshipDefinition
_crrDefinition :: RemoteRelationshipDefinition
_crrName :: RelName
_crrTable :: TableName b
_crrSource :: SourceName
_crrDefinition :: forall (b :: BackendType).
CreateFromSourceRelationship b -> RemoteRelationshipDefinition
_crrName :: forall (b :: BackendType).
CreateFromSourceRelationship b -> RelName
_crrTable :: forall (b :: BackendType).
CreateFromSourceRelationship b -> TableName b
_crrSource :: forall (b :: BackendType).
CreateFromSourceRelationship b -> SourceName
..} = do
  FieldInfoMap (FieldInfo b)
fieldInfoMap <- SourceName -> TableName b -> m (FieldInfoMap (FieldInfo b))
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
$
            TableName b -> TableMetadataObjId -> SourceMetadataObjId 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
$
      SourceName -> TableName b -> ASetter' Metadata (TableMetadata 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).
Lens' (TableMetadata b) RemoteRelationships
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
OMap.insert RelName
_crrName (RelName -> RemoteRelationshipDefinition -> RemoteRelationship
RemoteRelationship RelName
_crrName RemoteRelationshipDefinition
_crrDefinition)
  EncJSON -> m EncJSON
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
  { DeleteFromSourceRelationship b -> SourceName
_drrSource :: SourceName,
    DeleteFromSourceRelationship b -> TableName b
_drrTable :: TableName b,
    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 (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 (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"

runDeleteRemoteRelationship ::
  forall b m.
  (BackendMetadata b, MonadError QErr m, CacheRWM m, MetadataM m) =>
  DeleteFromSourceRelationship b ->
  m EncJSON
runDeleteRemoteRelationship :: DeleteFromSourceRelationship b -> m EncJSON
runDeleteRemoteRelationship (DeleteFromSourceRelationship SourceName
source TableName b
table RelName
relName) = do
  FieldInfoMap (FieldInfo b)
fieldInfoMap <- SourceName -> TableName b -> m (FieldInfoMap (FieldInfo b))
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 metadataObj :: MetadataObjId
metadataObj =
        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
$
            TableName b -> TableMetadataObjId -> SourceMetadataObjId 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
  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
$
      SourceName -> TableName b -> ASetter' Metadata (TableMetadata 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
  EncJSON -> m EncJSON
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
$cto :: forall x.
Rep CreateRemoteSchemaRemoteRelationship x
-> CreateRemoteSchemaRemoteRelationship
$cfrom :: forall x.
CreateRemoteSchemaRemoteRelationship
-> Rep CreateRemoteSchemaRemoteRelationship x
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 (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 (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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RRParseMode -> Value -> Parser RemoteRelationshipDefinition
parseRemoteRelationshipDefinition RRParseMode
RRPStrict)

$(J.deriveToJSON hasuraJSON ''CreateRemoteSchemaRemoteRelationship)

runCreateRemoteSchemaRemoteRelationship ::
  forall m.
  (MonadError QErr m, CacheRWM m, MetadataM m) =>
  CreateRemoteSchemaRemoteRelationship ->
  m EncJSON
runCreateRemoteSchemaRemoteRelationship :: CreateRemoteSchemaRemoteRelationship -> m EncJSON
runCreateRemoteSchemaRemoteRelationship CreateRemoteSchemaRemoteRelationship {Name
RelName
RemoteSchemaName
RemoteRelationshipDefinition
_crsrrDefinition :: RemoteRelationshipDefinition
_crsrrName :: RelName
_crsrrType :: Name
_crsrrRemoteSchema :: RemoteSchemaName
_crsrrDefinition :: CreateRemoteSchemaRemoteRelationship
-> RemoteRelationshipDefinition
_crsrrName :: CreateRemoteSchemaRemoteRelationship -> RelName
_crsrrType :: CreateRemoteSchemaRemoteRelationship -> Name
_crsrrRemoteSchema :: CreateRemoteSchemaRemoteRelationship -> RemoteSchemaName
..} = 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 ((RemoteSchemaMetadata -> Identity RemoteSchemaMetadata)
 -> RemoteSchemas -> Identity RemoteSchemas)
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> RemoteSchemaMetadata -> Identity RemoteSchemaMetadata)
-> (RemoteRelationships -> Identity RemoteRelationships)
-> RemoteSchemas
-> Identity RemoteSchemas
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SchemaRemoteRelationships -> Identity SchemaRemoteRelationships)
-> RemoteSchemaMetadata -> Identity RemoteSchemaMetadata
Lens' RemoteSchemaMetadata SchemaRemoteRelationships
rsmRemoteRelationships
        ((SchemaRemoteRelationships -> Identity SchemaRemoteRelationships)
 -> RemoteSchemaMetadata -> Identity RemoteSchemaMetadata)
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> SchemaRemoteRelationships -> Identity SchemaRemoteRelationships)
-> (RemoteRelationships -> Identity RemoteRelationships)
-> RemoteSchemaMetadata
-> Identity RemoteSchemaMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index SchemaRemoteRelationships
-> Lens'
     SchemaRemoteRelationships
     (Maybe (IxValue SchemaRemoteRelationships))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index SchemaRemoteRelationships
Name
_crsrrType
        ((Maybe RemoteSchemaTypeRelationships
  -> Identity (Maybe RemoteSchemaTypeRelationships))
 -> SchemaRemoteRelationships -> Identity SchemaRemoteRelationships)
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> Maybe RemoteSchemaTypeRelationships
    -> Identity (Maybe RemoteSchemaTypeRelationships))
-> (RemoteRelationships -> Identity RemoteRelationships)
-> SchemaRemoteRelationships
-> Identity SchemaRemoteRelationships
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteSchemaTypeRelationships
-> Iso'
     (Maybe RemoteSchemaTypeRelationships) RemoteSchemaTypeRelationships
forall a. Eq a => a -> Iso' (Maybe a) a
non (Name -> RemoteRelationships -> RemoteSchemaTypeRelationships
RemoteSchemaTypeRelationships Name
_crsrrType RemoteRelationships
forall a. Monoid a => a
mempty)
        ((RemoteSchemaTypeRelationships
  -> Identity RemoteSchemaTypeRelationships)
 -> Maybe RemoteSchemaTypeRelationships
 -> Identity (Maybe RemoteSchemaTypeRelationships))
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> RemoteSchemaTypeRelationships
    -> Identity RemoteSchemaTypeRelationships)
-> (RemoteRelationships -> Identity RemoteRelationships)
-> Maybe RemoteSchemaTypeRelationships
-> Identity (Maybe RemoteSchemaTypeRelationships)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteRelationships -> Identity RemoteRelationships)
-> RemoteSchemaTypeRelationships
-> Identity RemoteSchemaTypeRelationships
Lens' RemoteSchemaTypeRelationships RemoteRelationships
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
OMap.insert RelName
_crsrrName (RelName -> RemoteRelationshipDefinition -> RemoteRelationship
RemoteRelationship RelName
_crsrrName RemoteRelationshipDefinition
_crsrrDefinition)
  EncJSON -> m EncJSON
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 :: CreateRemoteSchemaRemoteRelationship -> m EncJSON
runUpdateRemoteSchemaRemoteRelationship crss :: CreateRemoteSchemaRemoteRelationship
crss@CreateRemoteSchemaRemoteRelationship {Name
RelName
RemoteSchemaName
RemoteRelationshipDefinition
_crsrrDefinition :: RemoteRelationshipDefinition
_crsrrName :: RelName
_crsrrType :: Name
_crsrrRemoteSchema :: RemoteSchemaName
_crsrrDefinition :: CreateRemoteSchemaRemoteRelationship
-> RemoteRelationshipDefinition
_crsrrName :: CreateRemoteSchemaRemoteRelationship -> RelName
_crsrrType :: CreateRemoteSchemaRemoteRelationship -> Name
_crsrrRemoteSchema :: CreateRemoteSchemaRemoteRelationship -> RemoteSchemaName
..} = 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)
-> Optic'
     (->)
     (Const (First (RemoteFieldInfo Name)))
     SchemaCache
     RemoteSchemaMap
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SchemaCache -> RemoteSchemaMap
scRemoteSchemas
            Optic'
  (->)
  (Const (First (RemoteFieldInfo Name)))
  SchemaCache
  RemoteSchemaMap
-> ((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
            ((RemoteSchemaCtx
  -> Const (First (RemoteFieldInfo Name)) RemoteSchemaCtx)
 -> RemoteSchemaMap
 -> Const (First (RemoteFieldInfo Name)) RemoteSchemaMap)
-> ((RemoteFieldInfo Name
     -> Const (First (RemoteFieldInfo Name)) (RemoteFieldInfo Name))
    -> RemoteSchemaCtx
    -> Const (First (RemoteFieldInfo Name)) RemoteSchemaCtx)
-> (RemoteFieldInfo Name
    -> Const (First (RemoteFieldInfo Name)) (RemoteFieldInfo Name))
-> RemoteSchemaMap
-> Const (First (RemoteFieldInfo Name)) RemoteSchemaMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteSchemaRelationships
 -> Const (First (RemoteFieldInfo Name)) RemoteSchemaRelationships)
-> RemoteSchemaCtx
-> Const (First (RemoteFieldInfo Name)) RemoteSchemaCtx
Lens' RemoteSchemaCtx RemoteSchemaRelationships
rscRemoteRelationships
            ((RemoteSchemaRelationships
  -> Const (First (RemoteFieldInfo Name)) RemoteSchemaRelationships)
 -> RemoteSchemaCtx
 -> Const (First (RemoteFieldInfo Name)) RemoteSchemaCtx)
-> ((RemoteFieldInfo Name
     -> Const (First (RemoteFieldInfo Name)) (RemoteFieldInfo Name))
    -> RemoteSchemaRelationships
    -> Const (First (RemoteFieldInfo Name)) RemoteSchemaRelationships)
-> (RemoteFieldInfo Name
    -> Const (First (RemoteFieldInfo Name)) (RemoteFieldInfo Name))
-> RemoteSchemaCtx
-> Const (First (RemoteFieldInfo Name)) RemoteSchemaCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index RemoteSchemaRelationships
-> Traversal'
     RemoteSchemaRelationships (IxValue RemoteSchemaRelationships)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index RemoteSchemaRelationships
Name
_crsrrType
            ((InsOrdHashMap RelName (RemoteFieldInfo Name)
  -> Const
       (First (RemoteFieldInfo Name))
       (InsOrdHashMap RelName (RemoteFieldInfo Name)))
 -> RemoteSchemaRelationships
 -> Const (First (RemoteFieldInfo Name)) RemoteSchemaRelationships)
-> ((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))
-> RemoteSchemaRelationships
-> Const (First (RemoteFieldInfo Name)) RemoteSchemaRelationships
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 (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 (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 :: DeleteRemoteSchemaRemoteRelationship -> m EncJSON
runDeleteRemoteSchemaRemoteRelationship DeleteRemoteSchemaRemoteRelationship {Name
RelName
RemoteSchemaName
_drsrrName :: RelName
_drsrrTypeName :: Name
_drsrrRemoteSchema :: RemoteSchemaName
_drsrrName :: DeleteRemoteSchemaRemoteRelationship -> RelName
_drsrrTypeName :: DeleteRemoteSchemaRemoteRelationship -> Name
_drsrrRemoteSchema :: DeleteRemoteSchemaRemoteRelationship -> RemoteSchemaName
..} = 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 ((RemoteSchemaMetadata -> Identity RemoteSchemaMetadata)
 -> RemoteSchemas -> Identity RemoteSchemas)
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> RemoteSchemaMetadata -> Identity RemoteSchemaMetadata)
-> (RemoteRelationships -> Identity RemoteRelationships)
-> RemoteSchemas
-> Identity RemoteSchemas
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SchemaRemoteRelationships -> Identity SchemaRemoteRelationships)
-> RemoteSchemaMetadata -> Identity RemoteSchemaMetadata
Lens' RemoteSchemaMetadata SchemaRemoteRelationships
rsmRemoteRelationships ((SchemaRemoteRelationships -> Identity SchemaRemoteRelationships)
 -> RemoteSchemaMetadata -> Identity RemoteSchemaMetadata)
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> SchemaRemoteRelationships -> Identity SchemaRemoteRelationships)
-> (RemoteRelationships -> Identity RemoteRelationships)
-> RemoteSchemaMetadata
-> Identity RemoteSchemaMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index SchemaRemoteRelationships
-> Traversal'
     SchemaRemoteRelationships (IxValue SchemaRemoteRelationships)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index SchemaRemoteRelationships
Name
_drsrrTypeName ((RemoteSchemaTypeRelationships
  -> Identity RemoteSchemaTypeRelationships)
 -> SchemaRemoteRelationships -> Identity SchemaRemoteRelationships)
-> ((RemoteRelationships -> Identity RemoteRelationships)
    -> RemoteSchemaTypeRelationships
    -> Identity RemoteSchemaTypeRelationships)
-> (RemoteRelationships -> Identity RemoteRelationships)
-> SchemaRemoteRelationships
-> Identity SchemaRemoteRelationships
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteRelationships -> Identity RemoteRelationships)
-> RemoteSchemaTypeRelationships
-> Identity RemoteSchemaTypeRelationships
Lens' RemoteSchemaTypeRelationships RemoteRelationships
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
OMap.delete RelName
relName
  EncJSON -> m EncJSON
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
  { PartiallyResolvedSource b -> SourceMetadata b
_prsSourceMetadata :: SourceMetadata b,
    PartiallyResolvedSource b -> ResolvedSource b
_resolvedSource :: ResolvedSource b,
    PartiallyResolvedSource b
-> HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
_tableCoreInfoMap :: HashMap (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)),
    PartiallyResolvedSource b
-> HashMap (TableName b) (EventTriggerInfoMap b)
_eventTriggerInfoMap :: HashMap (TableName b) (EventTriggerInfoMap b)
  }

-- | 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
  Map.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
  RemoteSchemaMap ->
  -- | 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, [SchemaDependency])
buildRemoteFieldInfo :: LHSIdentifier
-> HashMap FieldName lhsJoinField
-> RemoteRelationship
-> HashMap SourceName (AnyBackend PartiallyResolvedSource)
-> RemoteSchemaMap
-> m (RemoteFieldInfo lhsJoinField, [SchemaDependency])
buildRemoteFieldInfo LHSIdentifier
lhsIdentifier HashMap FieldName lhsJoinField
lhsJoinFields RemoteRelationship {RelName
RemoteRelationshipDefinition
_rrDefinition :: RemoteRelationship -> RemoteRelationshipDefinition
_rrName :: RemoteRelationship -> RelName
_rrDefinition :: RemoteRelationshipDefinition
_rrName :: RelName
..} HashMap SourceName (AnyBackend PartiallyResolvedSource)
allSources RemoteSchemaMap
remoteSchemaMap =
  case RemoteRelationshipDefinition
_rrDefinition of
    RelationshipToSource ToSourceRelationshipDef {Value
HashMap FieldName FieldName
SourceName
RelType
_tsrdTable :: ToSourceRelationshipDef -> Value
_tsrdSource :: ToSourceRelationshipDef -> SourceName
_tsrdFieldMapping :: ToSourceRelationshipDef -> HashMap FieldName FieldName
_tsrdRelationshipType :: ToSourceRelationshipDef -> RelType
_tsrdTable :: Value
_tsrdSource :: SourceName
_tsrdFieldMapping :: HashMap FieldName FieldName
_tsrdRelationshipType :: RelType
..} -> 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
Map.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)
      AnyBackend PartiallyResolvedSource
-> (forall (b :: BackendType).
    Backend b =>
    PartiallyResolvedSource b
    -> m (RemoteFieldInfo lhsJoinField, [SchemaDependency]))
-> m (RemoteFieldInfo lhsJoinField, [SchemaDependency])
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend AnyBackend PartiallyResolvedSource
targetTables \(PartiallyResolvedSource b
partiallyResolvedSource :: PartiallyResolvedSource b') -> do
        let PartiallyResolvedSource SourceMetadata b
_ ResolvedSource b
targetSourceInfo HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
targetTablesInfo HashMap (TableName b) (EventTriggerInfoMap b)
_ = PartiallyResolvedSource b
partiallyResolvedSource
        (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 (ColumnInfo b)
targetColumns <-
          (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
 -> FieldInfoMap (ColumnInfo b))
-> m (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
-> m (FieldInfoMap (ColumnInfo b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)
-> FieldInfoMap (ColumnInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap (m (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
 -> m (FieldInfoMap (ColumnInfo b)))
-> m (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
-> m (FieldInfoMap (ColumnInfo b))
forall a b. (a -> b) -> a -> b
$
            Maybe (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
-> m (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
-> m (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (TableName b
-> HashMap
     (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
-> Maybe (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup TableName b
targetTable HashMap
  (TableName b) (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
targetTablesInfo) (m (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
 -> m (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)))
-> m (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
-> m (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
forall a b. (a -> b) -> a -> b
$
              Code -> Text -> m (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists (Text -> m (TableCoreInfoG b (ColumnInfo b) (ColumnInfo b)))
-> Text -> m (TableCoreInfoG b (ColumnInfo 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)]
Map.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
          ColumnInfo b
tgtField <- FieldInfoMap (ColumnInfo b) -> FieldName -> m (ColumnInfo b)
forall (m :: * -> *) fieldInfo.
MonadError QErr m =>
FieldInfoMap fieldInfo -> FieldName -> m fieldInfo
askFieldInfo FieldInfoMap (ColumnInfo b)
targetColumns FieldName
tgtFieldName
          (FieldName, lhsJoinField, ColumnInfo b)
-> m (FieldName, lhsJoinField, ColumnInfo b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldName
srcFieldName, lhsJoinField
lhsJoinField, ColumnInfo b
tgtField)
        [(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 (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 (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 sourceConfig :: SourceConfig b
sourceConfig = ResolvedSource b -> SourceConfig b
forall (b :: BackendType). ResolvedSource b -> SourceConfig b
_rsConfig ResolvedSource b
targetSourceInfo
            sourceCustomization :: SourceTypeCustomization
sourceCustomization = ResolvedSource b -> SourceTypeCustomization
forall (b :: BackendType).
ResolvedSource b -> SourceTypeCustomization
_rsCustomization ResolvedSource b
targetSourceInfo
            rsri :: RemoteSourceFieldInfo b
rsri =
              RelName
-> RelType
-> SourceName
-> SourceConfig b
-> SourceTypeCustomization
-> TableName b
-> HashMap FieldName (ScalarType b, Column b)
-> RemoteSourceFieldInfo b
forall (tgt :: BackendType).
RelName
-> RelType
-> SourceName
-> SourceConfig tgt
-> SourceTypeCustomization
-> TableName tgt
-> HashMap FieldName (ScalarType tgt, Column tgt)
-> RemoteSourceFieldInfo tgt
RemoteSourceFieldInfo RelName
_rrName RelType
_tsrdRelationshipType SourceName
_tsrdSource SourceConfig b
sourceConfig SourceTypeCustomization
sourceCustomization 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 (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
Map.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
$ TableName b -> SourceObjId 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
$ TableName b -> TableObjId b -> SourceObjId 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
$ Column b -> TableObjId 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 (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
Map.fromList [(FieldName, (lhsJoinField, ScalarType b, Column b))]
columnMapping
        (RemoteFieldInfo lhsJoinField, [SchemaDependency])
-> m (RemoteFieldInfo lhsJoinField, [SchemaDependency])
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
$ RemoteSourceFieldInfo b -> AnyBackend RemoteSourceFieldInfo
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend @b' RemoteSourceFieldInfo b
rsri, [SchemaDependency]
rhsDependencies)
    RelationshipToSchema RRFormat
_ remoteRelationship :: ToSchemaRelationshipDef
remoteRelationship@ToSchemaRelationshipDef {HashSet FieldName
RemoteSchemaName
RemoteFields
_trrdRemoteField :: ToSchemaRelationshipDef -> RemoteFields
_trrdLhsFields :: ToSchemaRelationshipDef -> HashSet FieldName
_trrdRemoteSchema :: ToSchemaRelationshipDef -> RemoteSchemaName
_trrdRemoteField :: RemoteFields
_trrdLhsFields :: HashSet FieldName
_trrdRemoteSchema :: RemoteSchemaName
..} -> do
      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
..} <-
        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
_trrdRemoteSchema 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
RemoteSchemaError (Text -> m RemoteSchemaCtx) -> Text -> m RemoteSchemaCtx
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 rhsDependencies :: [SchemaDependency]
rhsDependencies = [SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency (RemoteSchemaName -> SchemaObjId
SORemoteSchema RemoteSchemaName
_trrdRemoteSchema) DependencyReason
DRRemoteSchema]
      (RemoteFieldInfo lhsJoinField, [SchemaDependency])
-> m (RemoteFieldInfo lhsJoinField, [SchemaDependency])
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]
rhsDependencies)

getRemoteSchemaEntityJoinColumns ::
  (MonadError QErr m) =>
  RemoteSchemaName ->
  RemoteSchemaIntrospection ->
  G.Name ->
  m (HashMap FieldName G.Name)
getRemoteSchemaEntityJoinColumns :: 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 (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
Map.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 (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 (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"