module Hasura.RQL.DDL.Relationship
  ( CreateArrRel (..),
    CreateObjRel (..),
    runCreateRelationship,
    objRelP2Setup,
    arrRelP2Setup,
    DropRel,
    runDropRel,
    dropRelationshipInMetadata,
    SetRelComment,
    runSetRelComment,
  )
where

import Control.Lens ((.~))
import Data.Aeson.Types
import Data.HashMap.Strict qualified as Map
import Data.HashMap.Strict.InsOrd qualified as OMap
import Data.HashMap.Strict.NonEmpty qualified as NEHashMap
import Data.HashSet qualified as Set
import Data.Text.Extended
import Data.Tuple (swap)
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.DDL.Permission
import Hasura.RQL.Types.Backend
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.Local
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.RQL.Types.Table
import Hasura.SQL.AnyBackend qualified as AB

--------------------------------------------------------------------------------
-- Create local relationship

newtype CreateArrRel b = CreateArrRel {CreateArrRel b -> WithTable b (ArrRelDef b)
unCreateArrRel :: WithTable b (ArrRelDef b)}
  deriving newtype (Value -> Parser [CreateArrRel b]
Value -> Parser (CreateArrRel b)
(Value -> Parser (CreateArrRel b))
-> (Value -> Parser [CreateArrRel b]) -> FromJSON (CreateArrRel b)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall (b :: BackendType).
Backend b =>
Value -> Parser [CreateArrRel b]
forall (b :: BackendType).
Backend b =>
Value -> Parser (CreateArrRel b)
parseJSONList :: Value -> Parser [CreateArrRel b]
$cparseJSONList :: forall (b :: BackendType).
Backend b =>
Value -> Parser [CreateArrRel b]
parseJSON :: Value -> Parser (CreateArrRel b)
$cparseJSON :: forall (b :: BackendType).
Backend b =>
Value -> Parser (CreateArrRel b)
FromJSON)

newtype CreateObjRel b = CreateObjRel {CreateObjRel b -> WithTable b (ObjRelDef b)
unCreateObjRel :: WithTable b (ObjRelDef b)}
  deriving newtype (Value -> Parser [CreateObjRel b]
Value -> Parser (CreateObjRel b)
(Value -> Parser (CreateObjRel b))
-> (Value -> Parser [CreateObjRel b]) -> FromJSON (CreateObjRel b)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall (b :: BackendType).
Backend b =>
Value -> Parser [CreateObjRel b]
forall (b :: BackendType).
Backend b =>
Value -> Parser (CreateObjRel b)
parseJSONList :: Value -> Parser [CreateObjRel b]
$cparseJSONList :: forall (b :: BackendType).
Backend b =>
Value -> Parser [CreateObjRel b]
parseJSON :: Value -> Parser (CreateObjRel b)
$cparseJSON :: forall (b :: BackendType).
Backend b =>
Value -> Parser (CreateObjRel b)
FromJSON)

runCreateRelationship ::
  forall m b a.
  (MonadError QErr m, CacheRWM m, ToJSON a, MetadataM m, Backend b, BackendMetadata b) =>
  RelType ->
  WithTable b (RelDef a) ->
  m EncJSON
runCreateRelationship :: RelType -> WithTable b (RelDef a) -> m EncJSON
runCreateRelationship RelType
relType (WithTable SourceName
source TableName b
tableName RelDef a
relDef) = do
  let relName :: RelName
relName = RelDef a -> RelName
forall a. RelDef a -> RelName
_rdName RelDef a
relDef
  -- Check if any field with relationship name already exists in the table
  FieldInfoMap (FieldInfo b)
tableFields <- TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> FieldInfoMap (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
 -> FieldInfoMap (FieldInfo b))
-> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> m (FieldInfoMap (FieldInfo b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceName
-> TableName b -> m (TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableCoreInfo b)
askTableCoreInfo @b SourceName
source TableName b
tableName
  Maybe (FieldInfo b) -> (FieldInfo b -> m ()) -> m ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
onJust (FieldName -> FieldInfoMap (FieldInfo b) -> Maybe (FieldInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup (RelName -> FieldName
fromRel RelName
relName) FieldInfoMap (FieldInfo b)
tableFields) ((FieldInfo b -> m ()) -> m ()) -> (FieldInfo b -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
    m () -> FieldInfo b -> m ()
forall a b. a -> b -> a
const (m () -> FieldInfo b -> m ()) -> m () -> FieldInfo b -> m ()
forall a b. (a -> b) -> a -> b
$
      Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
AlreadyExists (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
        Text
"field with name " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName
relName RelName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" already exists in table " Text -> TableName b -> Text
forall t. ToTxt t => Text -> t -> Text
<>> TableName b
tableName

  HashMap (TableName b) (TableInfo b)
tableCache <-
    m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
      m SchemaCache
-> (SchemaCache -> m (HashMap (TableName b) (TableInfo b)))
-> m (HashMap (TableName b) (TableInfo b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe (HashMap (TableName b) (TableInfo b))
 -> m (HashMap (TableName b) (TableInfo b))
 -> m (HashMap (TableName b) (TableInfo b)))
-> m (HashMap (TableName b) (TableInfo b))
-> Maybe (HashMap (TableName b) (TableInfo b))
-> m (HashMap (TableName b) (TableInfo b))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe (HashMap (TableName b) (TableInfo b))
-> m (HashMap (TableName b) (TableInfo b))
-> m (HashMap (TableName b) (TableInfo b))
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (Code -> Text -> m (HashMap (TableName b) (TableInfo b))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound Text
"Could not find source.")
        (Maybe (HashMap (TableName b) (TableInfo b))
 -> m (HashMap (TableName b) (TableInfo b)))
-> (SchemaCache -> Maybe (HashMap (TableName b) (TableInfo b)))
-> SchemaCache
-> m (HashMap (TableName b) (TableInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceName
-> SourceCache -> Maybe (HashMap (TableName b) (TableInfo b))
forall (b :: BackendType).
Backend b =>
SourceName -> SourceCache -> Maybe (TableCache b)
unsafeTableCache SourceName
source
        (SourceCache -> Maybe (HashMap (TableName b) (TableInfo b)))
-> (SchemaCache -> SourceCache)
-> SchemaCache
-> Maybe (HashMap (TableName b) (TableInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaCache -> SourceCache
scSources

  let comment :: Maybe Text
comment = RelDef a -> Maybe Text
forall a. RelDef a -> Maybe Text
_rdComment RelDef a
relDef
      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
tableName (TableMetadataObjId -> SourceMetadataObjId b)
-> TableMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$
              RelName -> RelType -> TableMetadataObjId
MTORel RelName
relName RelType
relType
  TableMetadata b -> TableMetadata b
addRelationshipToMetadata <- case RelType
relType of
    RelType
ObjRel -> do
      ObjRelDef b
value <- Value -> m (ObjRelDef b)
forall a (m :: * -> *). (FromJSON a, QErrM m) => Value -> m a
decodeValue (Value -> m (ObjRelDef b)) -> Value -> m (ObjRelDef b)
forall a b. (a -> b) -> a -> b
$ RelDef a -> Value
forall a. ToJSON a => a -> Value
toJSON RelDef a
relDef
      HashMap (TableName b) (TableInfo b)
-> TableName b -> Either (ObjRelDef b) (ArrRelDef b) -> m ()
forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadError QErr m) =>
TableCache b
-> TableName b -> Either (ObjRelDef b) (ArrRelDef b) -> m ()
validateRelationship @b
        HashMap (TableName b) (TableInfo b)
tableCache
        TableName b
tableName
        (ObjRelDef b -> Either (ObjRelDef b) (ArrRelDef b)
forall a b. a -> Either a b
Left ObjRelDef b
value)
      (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TableMetadata b -> TableMetadata b)
 -> m (TableMetadata b -> TableMetadata b))
-> (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall a b. (a -> b) -> a -> b
$ (Relationships (ObjRelDef b)
 -> Identity (Relationships (ObjRelDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType).
Lens' (TableMetadata b) (Relationships (ObjRelDef b))
tmObjectRelationships ((Relationships (ObjRelDef b)
  -> Identity (Relationships (ObjRelDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> (Relationships (ObjRelDef b) -> Relationships (ObjRelDef b))
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RelName
-> ObjRelDef b
-> Relationships (ObjRelDef b)
-> Relationships (ObjRelDef b)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
OMap.insert RelName
relName (RelName -> ObjRelUsing b -> Maybe Text -> ObjRelDef b
forall a. RelName -> a -> Maybe Text -> RelDef a
RelDef RelName
relName (ObjRelDef b -> ObjRelUsing b
forall a. RelDef a -> a
_rdUsing ObjRelDef b
value) Maybe Text
comment)
    RelType
ArrRel -> do
      ArrRelDef b
value <- Value -> m (ArrRelDef b)
forall a (m :: * -> *). (FromJSON a, QErrM m) => Value -> m a
decodeValue (Value -> m (ArrRelDef b)) -> Value -> m (ArrRelDef b)
forall a b. (a -> b) -> a -> b
$ RelDef a -> Value
forall a. ToJSON a => a -> Value
toJSON RelDef a
relDef
      HashMap (TableName b) (TableInfo b)
-> TableName b -> Either (ObjRelDef b) (ArrRelDef b) -> m ()
forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadError QErr m) =>
TableCache b
-> TableName b -> Either (ObjRelDef b) (ArrRelDef b) -> m ()
validateRelationship @b
        HashMap (TableName b) (TableInfo b)
tableCache
        TableName b
tableName
        (ArrRelDef b -> Either (ObjRelDef b) (ArrRelDef b)
forall a b. b -> Either a b
Right ArrRelDef b
value)
      (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TableMetadata b -> TableMetadata b)
 -> m (TableMetadata b -> TableMetadata b))
-> (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall a b. (a -> b) -> a -> b
$ (Relationships (ArrRelDef b)
 -> Identity (Relationships (ArrRelDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType).
Lens' (TableMetadata b) (Relationships (ArrRelDef b))
tmArrayRelationships ((Relationships (ArrRelDef b)
  -> Identity (Relationships (ArrRelDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> (Relationships (ArrRelDef b) -> Relationships (ArrRelDef b))
-> TableMetadata b
-> TableMetadata b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ RelName
-> ArrRelDef b
-> Relationships (ArrRelDef b)
-> Relationships (ArrRelDef b)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
OMap.insert RelName
relName (RelName -> ArrRelUsing b -> Maybe Text -> ArrRelDef b
forall a. RelName -> a -> Maybe Text -> RelDef a
RelDef RelName
relName (ArrRelDef b -> ArrRelUsing b
forall a. RelDef a -> a
_rdUsing ArrRelDef b
value) Maybe Text
comment)

  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
tableName ASetter' Metadata (TableMetadata b)
-> (TableMetadata b -> TableMetadata b) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TableMetadata b -> TableMetadata b
addRelationshipToMetadata
  EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

objRelP2Setup ::
  forall b m.
  (QErrM m, Backend b) =>
  SourceName ->
  TableName b ->
  HashMap (TableName b) (HashSet (ForeignKey b)) ->
  RelDef (ObjRelUsing b) ->
  m (RelInfo b, [SchemaDependency])
objRelP2Setup :: SourceName
-> TableName b
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> RelDef (ObjRelUsing b)
-> m (RelInfo b, [SchemaDependency])
objRelP2Setup SourceName
source TableName b
qt HashMap (TableName b) (HashSet (ForeignKey b))
foreignKeys (RelDef RelName
rn ObjRelUsing b
ru Maybe Text
_) = case ObjRelUsing b
ru of
  RUManual RelManualConfig b
rm -> do
    let refqt :: TableName b
refqt = RelManualConfig b -> TableName b
forall (b :: BackendType). RelManualConfig b -> TableName b
rmTable RelManualConfig b
rm
        ([Column b]
lCols, [Column b]
rCols) = [(Column b, Column b)] -> ([Column b], [Column b])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Column b, Column b)] -> ([Column b], [Column b]))
-> [(Column b, Column b)] -> ([Column b], [Column b])
forall a b. (a -> b) -> a -> b
$ HashMap (Column b) (Column b) -> [(Column b, Column b)]
forall k v. HashMap k v -> [(k, v)]
Map.toList (HashMap (Column b) (Column b) -> [(Column b, Column b)])
-> HashMap (Column b) (Column b) -> [(Column b, Column b)]
forall a b. (a -> b) -> a -> b
$ RelManualConfig b -> HashMap (Column b) (Column b)
forall (b :: BackendType).
RelManualConfig b -> HashMap (Column b) (Column b)
rmColumns RelManualConfig b
rm
        io :: InsertOrder
io = InsertOrder -> Maybe InsertOrder -> InsertOrder
forall a. a -> Maybe a -> a
fromMaybe InsertOrder
BeforeParent (Maybe InsertOrder -> InsertOrder)
-> Maybe InsertOrder -> InsertOrder
forall a b. (a -> b) -> a -> b
$ RelManualConfig b -> Maybe InsertOrder
forall (b :: BackendType). RelManualConfig b -> Maybe InsertOrder
rmInsertOrder RelManualConfig b
rm
        mkDependency :: TableName b -> DependencyReason -> Column b -> SchemaDependency
mkDependency TableName b
tableName DependencyReason
reason Column b
col =
          SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
            ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source (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
tableName (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
col
            )
            DependencyReason
reason
        dependencies :: [SchemaDependency]
dependencies =
          (Column b -> SchemaDependency) -> [Column b] -> [SchemaDependency]
forall a b. (a -> b) -> [a] -> [b]
map (TableName b -> DependencyReason -> Column b -> SchemaDependency
mkDependency TableName b
qt DependencyReason
DRLeftColumn) [Column b]
lCols
            [SchemaDependency] -> [SchemaDependency] -> [SchemaDependency]
forall a. Semigroup a => a -> a -> a
<> (Column b -> SchemaDependency) -> [Column b] -> [SchemaDependency]
forall a b. (a -> b) -> [a] -> [b]
map (TableName b -> DependencyReason -> Column b -> SchemaDependency
mkDependency TableName b
refqt DependencyReason
DRRightColumn) [Column b]
rCols
    (RelInfo b, [SchemaDependency])
-> m (RelInfo b, [SchemaDependency])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelName
-> RelType
-> HashMap (Column b) (Column b)
-> TableName b
-> Bool
-> InsertOrder
-> RelInfo b
forall (b :: BackendType).
RelName
-> RelType
-> HashMap (Column b) (Column b)
-> TableName b
-> Bool
-> InsertOrder
-> RelInfo b
RelInfo RelName
rn RelType
ObjRel (RelManualConfig b -> HashMap (Column b) (Column b)
forall (b :: BackendType).
RelManualConfig b -> HashMap (Column b) (Column b)
rmColumns RelManualConfig b
rm) TableName b
refqt Bool
True InsertOrder
io, [SchemaDependency]
dependencies)
  RUFKeyOn (SameTable NonEmpty (Column b)
columns) -> do
    HashSet (ForeignKey b)
foreignTableForeignKeys <-
      TableName b
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> Maybe (HashSet (ForeignKey b))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup TableName b
qt HashMap (TableName b) (HashSet (ForeignKey b))
foreignKeys
        Maybe (HashSet (ForeignKey b))
-> m (HashSet (ForeignKey b)) -> m (HashSet (ForeignKey b))
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m (HashSet (ForeignKey b))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound (Text
"table " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b
qt 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
source)
    ForeignKey Constraint b
constraint TableName b
foreignTable NEHashMap (Column b) (Column b)
colMap <- NonEmpty (Column b) -> [ForeignKey b] -> m (ForeignKey b)
forall (m :: * -> *) (b :: BackendType).
(QErrM m, Backend b) =>
NonEmpty (Column b) -> [ForeignKey b] -> m (ForeignKey b)
getRequiredFkey NonEmpty (Column b)
columns (HashSet (ForeignKey b) -> [ForeignKey b]
forall a. HashSet a -> [a]
Set.toList HashSet (ForeignKey b)
foreignTableForeignKeys)
    let dependencies :: [SchemaDependency]
dependencies =
          [ SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
              ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source (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
qt (TableObjId b -> SourceObjId b) -> TableObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$
                      ConstraintName b -> TableObjId b
forall (b :: BackendType). ConstraintName b -> TableObjId b
TOForeignKey @b (Constraint b -> ConstraintName b
forall (b :: BackendType). Constraint b -> ConstraintName b
_cName Constraint b
constraint)
              )
              DependencyReason
DRFkey,
            -- this needs to be added explicitly to handle the remote table being untracked. In this case,
            -- neither the using_col nor the constraint name will help.
            SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
              ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source (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
foreignTable
              )
              DependencyReason
DRRemoteTable
          ]
            [SchemaDependency] -> [SchemaDependency] -> [SchemaDependency]
forall a. Semigroup a => a -> a -> a
<> (Column b -> SchemaDependency) -> [Column b] -> [SchemaDependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SourceName -> TableName b -> Column b -> SchemaDependency
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> Column b -> SchemaDependency
drUsingColumnDep @b SourceName
source TableName b
qt) (NonEmpty (Column b) -> [Column b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Column b)
columns)
    (RelInfo b, [SchemaDependency])
-> m (RelInfo b, [SchemaDependency])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelName
-> RelType
-> HashMap (Column b) (Column b)
-> TableName b
-> Bool
-> InsertOrder
-> RelInfo b
forall (b :: BackendType).
RelName
-> RelType
-> HashMap (Column b) (Column b)
-> TableName b
-> Bool
-> InsertOrder
-> RelInfo b
RelInfo RelName
rn RelType
ObjRel (NEHashMap (Column b) (Column b) -> HashMap (Column b) (Column b)
forall k v. NEHashMap k v -> HashMap k v
NEHashMap.toHashMap NEHashMap (Column b) (Column b)
colMap) TableName b
foreignTable Bool
False InsertOrder
BeforeParent, [SchemaDependency]
dependencies)
  RUFKeyOn (RemoteTable TableName b
remoteTable NonEmpty (Column b)
remoteCols) ->
    RelType
-> InsertOrder
-> SourceName
-> RelName
-> TableName b
-> TableName b
-> NonEmpty (Column b)
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> m (RelInfo b, [SchemaDependency])
forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
RelType
-> InsertOrder
-> SourceName
-> RelName
-> TableName b
-> TableName b
-> NonEmpty (Column b)
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> m (RelInfo b, [SchemaDependency])
mkFkeyRel RelType
ObjRel InsertOrder
AfterParent SourceName
source RelName
rn TableName b
qt TableName b
remoteTable NonEmpty (Column b)
remoteCols HashMap (TableName b) (HashSet (ForeignKey b))
foreignKeys

arrRelP2Setup ::
  forall b m.
  (QErrM m, Backend b) =>
  HashMap (TableName b) (HashSet (ForeignKey b)) ->
  SourceName ->
  TableName b ->
  ArrRelDef b ->
  m (RelInfo b, [SchemaDependency])
arrRelP2Setup :: HashMap (TableName b) (HashSet (ForeignKey b))
-> SourceName
-> TableName b
-> ArrRelDef b
-> m (RelInfo b, [SchemaDependency])
arrRelP2Setup HashMap (TableName b) (HashSet (ForeignKey b))
foreignKeys SourceName
source TableName b
qt (RelDef RelName
rn ArrRelUsing b
ru Maybe Text
_) = case ArrRelUsing b
ru of
  RUManual RelManualConfig b
rm -> do
    let refqt :: TableName b
refqt = RelManualConfig b -> TableName b
forall (b :: BackendType). RelManualConfig b -> TableName b
rmTable RelManualConfig b
rm
        ([Column b]
lCols, [Column b]
rCols) = [(Column b, Column b)] -> ([Column b], [Column b])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Column b, Column b)] -> ([Column b], [Column b]))
-> [(Column b, Column b)] -> ([Column b], [Column b])
forall a b. (a -> b) -> a -> b
$ HashMap (Column b) (Column b) -> [(Column b, Column b)]
forall k v. HashMap k v -> [(k, v)]
Map.toList (HashMap (Column b) (Column b) -> [(Column b, Column b)])
-> HashMap (Column b) (Column b) -> [(Column b, Column b)]
forall a b. (a -> b) -> a -> b
$ RelManualConfig b -> HashMap (Column b) (Column b)
forall (b :: BackendType).
RelManualConfig b -> HashMap (Column b) (Column b)
rmColumns RelManualConfig b
rm
        deps :: [SchemaDependency]
deps =
          (Column b -> SchemaDependency) -> [Column b] -> [SchemaDependency]
forall a b. (a -> b) -> [a] -> [b]
map
            ( \Column b
c ->
                SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
                  ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source (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
qt (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
c
                  )
                  DependencyReason
DRLeftColumn
            )
            [Column b]
lCols
            [SchemaDependency] -> [SchemaDependency] -> [SchemaDependency]
forall a. Semigroup a => a -> a -> a
<> (Column b -> SchemaDependency) -> [Column b] -> [SchemaDependency]
forall a b. (a -> b) -> [a] -> [b]
map
              ( \Column b
c ->
                  SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
                    ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source (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
refqt (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
c
                    )
                    DependencyReason
DRRightColumn
              )
              [Column b]
rCols
    (RelInfo b, [SchemaDependency])
-> m (RelInfo b, [SchemaDependency])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelName
-> RelType
-> HashMap (Column b) (Column b)
-> TableName b
-> Bool
-> InsertOrder
-> RelInfo b
forall (b :: BackendType).
RelName
-> RelType
-> HashMap (Column b) (Column b)
-> TableName b
-> Bool
-> InsertOrder
-> RelInfo b
RelInfo RelName
rn RelType
ArrRel (RelManualConfig b -> HashMap (Column b) (Column b)
forall (b :: BackendType).
RelManualConfig b -> HashMap (Column b) (Column b)
rmColumns RelManualConfig b
rm) TableName b
refqt Bool
True InsertOrder
AfterParent, [SchemaDependency]
deps)
  RUFKeyOn (ArrRelUsingFKeyOn TableName b
refqt NonEmpty (Column b)
refCols) ->
    RelType
-> InsertOrder
-> SourceName
-> RelName
-> TableName b
-> TableName b
-> NonEmpty (Column b)
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> m (RelInfo b, [SchemaDependency])
forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
RelType
-> InsertOrder
-> SourceName
-> RelName
-> TableName b
-> TableName b
-> NonEmpty (Column b)
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> m (RelInfo b, [SchemaDependency])
mkFkeyRel RelType
ArrRel InsertOrder
AfterParent SourceName
source RelName
rn TableName b
qt TableName b
refqt NonEmpty (Column b)
refCols HashMap (TableName b) (HashSet (ForeignKey b))
foreignKeys

mkFkeyRel ::
  forall b m.
  QErrM m =>
  Backend b =>
  RelType ->
  InsertOrder ->
  SourceName ->
  RelName ->
  TableName b ->
  TableName b ->
  NonEmpty (Column b) ->
  HashMap (TableName b) (HashSet (ForeignKey b)) ->
  m (RelInfo b, [SchemaDependency])
mkFkeyRel :: RelType
-> InsertOrder
-> SourceName
-> RelName
-> TableName b
-> TableName b
-> NonEmpty (Column b)
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> m (RelInfo b, [SchemaDependency])
mkFkeyRel RelType
relType InsertOrder
io SourceName
source RelName
rn TableName b
sourceTable TableName b
remoteTable NonEmpty (Column b)
remoteColumns HashMap (TableName b) (HashSet (ForeignKey b))
foreignKeys = do
  HashSet (ForeignKey b)
foreignTableForeignKeys <-
    TableName b
-> HashMap (TableName b) (HashSet (ForeignKey b))
-> Maybe (HashSet (ForeignKey b))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
Map.lookup TableName b
remoteTable HashMap (TableName b) (HashSet (ForeignKey b))
foreignKeys
      Maybe (HashSet (ForeignKey b))
-> m (HashSet (ForeignKey b)) -> m (HashSet (ForeignKey b))
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m (HashSet (ForeignKey b))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound (Text
"table " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TableName b
remoteTable 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
source)
  let keysThatReferenceUs :: [ForeignKey b]
keysThatReferenceUs = (ForeignKey b -> Bool) -> [ForeignKey b] -> [ForeignKey b]
forall a. (a -> Bool) -> [a] -> [a]
filter ((TableName b -> TableName b -> Bool
forall a. Eq a => a -> a -> Bool
== TableName b
sourceTable) (TableName b -> Bool)
-> (ForeignKey b -> TableName b) -> ForeignKey b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignKey b -> TableName b
forall (b :: BackendType). ForeignKey b -> TableName b
_fkForeignTable) (HashSet (ForeignKey b) -> [ForeignKey b]
forall a. HashSet a -> [a]
Set.toList HashSet (ForeignKey b)
foreignTableForeignKeys)
  ForeignKey Constraint b
constraint TableName b
_foreignTable NEHashMap (Column b) (Column b)
colMap <- NonEmpty (Column b) -> [ForeignKey b] -> m (ForeignKey b)
forall (m :: * -> *) (b :: BackendType).
(QErrM m, Backend b) =>
NonEmpty (Column b) -> [ForeignKey b] -> m (ForeignKey b)
getRequiredFkey NonEmpty (Column b)
remoteColumns [ForeignKey b]
keysThatReferenceUs
  let dependencies :: [SchemaDependency]
dependencies =
        [ SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
            ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source (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
remoteTable (TableObjId b -> SourceObjId b) -> TableObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$
                    ConstraintName b -> TableObjId b
forall (b :: BackendType). ConstraintName b -> TableObjId b
TOForeignKey @b (Constraint b -> ConstraintName b
forall (b :: BackendType). Constraint b -> ConstraintName b
_cName Constraint b
constraint)
            )
            DependencyReason
DRRemoteFkey,
          SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
            ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source (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
remoteTable
            )
            DependencyReason
DRRemoteTable
        ]
          [SchemaDependency] -> [SchemaDependency] -> [SchemaDependency]
forall a. Semigroup a => a -> a -> a
<> (Column b -> SchemaDependency) -> [Column b] -> [SchemaDependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SourceName -> TableName b -> Column b -> SchemaDependency
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> Column b -> SchemaDependency
drUsingColumnDep @b SourceName
source TableName b
remoteTable) (NonEmpty (Column b) -> [Column b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Column b)
remoteColumns)
  (RelInfo b, [SchemaDependency])
-> m (RelInfo b, [SchemaDependency])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelName
-> RelType
-> HashMap (Column b) (Column b)
-> TableName b
-> Bool
-> InsertOrder
-> RelInfo b
forall (b :: BackendType).
RelName
-> RelType
-> HashMap (Column b) (Column b)
-> TableName b
-> Bool
-> InsertOrder
-> RelInfo b
RelInfo RelName
rn RelType
relType (HashMap (Column b) (Column b) -> HashMap (Column b) (Column b)
forall y x. (Eq y, Hashable y) => HashMap x y -> HashMap y x
reverseMap (NEHashMap (Column b) (Column b) -> HashMap (Column b) (Column b)
forall k v. NEHashMap k v -> HashMap k v
NEHashMap.toHashMap NEHashMap (Column b) (Column b)
colMap)) TableName b
remoteTable Bool
False InsertOrder
io, [SchemaDependency]
dependencies)
  where
    reverseMap :: Eq y => Hashable y => HashMap x y -> HashMap y x
    reverseMap :: HashMap x y -> HashMap y x
reverseMap = [(y, x)] -> HashMap y x
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList ([(y, x)] -> HashMap y x)
-> (HashMap x y -> [(y, x)]) -> HashMap x y -> HashMap y x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((x, y) -> (y, x)) -> [(x, y)] -> [(y, x)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x, y) -> (y, x)
forall a b. (a, b) -> (b, a)
swap ([(x, y)] -> [(y, x)])
-> (HashMap x y -> [(x, y)]) -> HashMap x y -> [(y, x)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap x y -> [(x, y)]
forall k v. HashMap k v -> [(k, v)]
Map.toList

-- | Try to find a foreign key constraint, identifying a constraint by its set of columns
getRequiredFkey ::
  (QErrM m, Backend b) =>
  NonEmpty (Column b) ->
  [ForeignKey b] ->
  m (ForeignKey b)
getRequiredFkey :: NonEmpty (Column b) -> [ForeignKey b] -> m (ForeignKey b)
getRequiredFkey NonEmpty (Column b)
cols [ForeignKey b]
fkeys =
  case [ForeignKey b]
filteredFkeys of
    [ForeignKey b
k] -> ForeignKey b -> m (ForeignKey b)
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignKey b
k
    [] -> Code -> Text -> m (ForeignKey b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ConstraintError Text
"no foreign constraint exists on the given column(s)"
    [ForeignKey b]
_ -> Code -> Text -> m (ForeignKey b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ConstraintError Text
"more than one foreign key constraint exists on the given column(s)"
  where
    filteredFkeys :: [ForeignKey b]
filteredFkeys = (ForeignKey b -> Bool) -> [ForeignKey b] -> [ForeignKey b]
forall a. (a -> Bool) -> [a] -> [a]
filter ((HashSet (Column b) -> HashSet (Column b) -> Bool
forall a. Eq a => a -> a -> Bool
== [Column b] -> HashSet (Column b)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
Set.fromList (NonEmpty (Column b) -> [Column b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Column b)
cols)) (HashSet (Column b) -> Bool)
-> (ForeignKey b -> HashSet (Column b)) -> ForeignKey b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap (Column b) (Column b) -> HashSet (Column b)
forall k a. HashMap k a -> HashSet k
Map.keysSet (HashMap (Column b) (Column b) -> HashSet (Column b))
-> (ForeignKey b -> HashMap (Column b) (Column b))
-> ForeignKey b
-> HashSet (Column b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEHashMap (Column b) (Column b) -> HashMap (Column b) (Column b)
forall k v. NEHashMap k v -> HashMap k v
NEHashMap.toHashMap (NEHashMap (Column b) (Column b) -> HashMap (Column b) (Column b))
-> (ForeignKey b -> NEHashMap (Column b) (Column b))
-> ForeignKey b
-> HashMap (Column b) (Column b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignKey b -> NEHashMap (Column b) (Column b)
forall (b :: BackendType).
ForeignKey b -> NEHashMap (Column b) (Column b)
_fkColumnMapping) [ForeignKey b]
fkeys

drUsingColumnDep ::
  forall b.
  Backend b =>
  SourceName ->
  TableName b ->
  Column b ->
  SchemaDependency
drUsingColumnDep :: SourceName -> TableName b -> Column b -> SchemaDependency
drUsingColumnDep SourceName
source TableName b
qt Column b
col =
  SchemaObjId -> DependencyReason -> SchemaDependency
SchemaDependency
    ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source (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
qt (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
col
    )
    DependencyReason
DRUsingColumn

--------------------------------------------------------------------------------
-- Drop local relationship

data DropRel b = DropRel
  { DropRel b -> SourceName
_drSource :: SourceName,
    DropRel b -> TableName b
_drTable :: TableName b,
    DropRel b -> RelName
_drRelationship :: RelName,
    DropRel b -> Bool
_drCascade :: Bool
  }

instance (Backend b) => FromJSON (DropRel b) where
  parseJSON :: Value -> Parser (DropRel b)
parseJSON = String
-> (Object -> Parser (DropRel b)) -> Value -> Parser (DropRel b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DropRel" ((Object -> Parser (DropRel b)) -> Value -> Parser (DropRel b))
-> (Object -> Parser (DropRel b)) -> Value -> Parser (DropRel b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SourceName -> TableName b -> RelName -> Bool -> DropRel b
forall (b :: BackendType).
SourceName -> TableName b -> RelName -> Bool -> DropRel b
DropRel
      (SourceName -> TableName b -> RelName -> Bool -> DropRel b)
-> Parser SourceName
-> Parser (TableName b -> RelName -> Bool -> DropRel 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 -> Bool -> DropRel b)
-> Parser (TableName b) -> Parser (RelName -> Bool -> DropRel 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 -> Bool -> DropRel b)
-> Parser RelName -> Parser (Bool -> DropRel 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
"relationship"
      Parser (Bool -> DropRel b) -> Parser Bool -> Parser (DropRel b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cascade" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False

runDropRel ::
  forall b m.
  (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b) =>
  DropRel b ->
  m EncJSON
runDropRel :: DropRel b -> m EncJSON
runDropRel (DropRel SourceName
source TableName b
qt RelName
rn Bool
cascade) = do
  [SchemaObjId]
depObjs <- m [SchemaObjId]
collectDependencies
  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck do
    [TableMetadata b -> TableMetadata b]
metadataModifiers <- (SchemaObjId -> m (TableMetadata b -> TableMetadata b))
-> [SchemaObjId] -> m [TableMetadata b -> TableMetadata b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SchemaObjId -> m (TableMetadata b -> TableMetadata b)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, Backend b) =>
SchemaObjId -> m (TableMetadata b -> TableMetadata b)
purgeRelDep [SchemaObjId]
depObjs
    MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache (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
qt
          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
dropRelationshipInMetadata RelName
rn (TableMetadata b -> TableMetadata b)
-> (TableMetadata b -> TableMetadata b)
-> TableMetadata b
-> TableMetadata b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TableMetadata b -> TableMetadata b)
 -> (TableMetadata b -> TableMetadata b)
 -> TableMetadata b
 -> TableMetadata b)
-> (TableMetadata b -> TableMetadata b)
-> [TableMetadata b -> TableMetadata b]
-> TableMetadata b
-> TableMetadata b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (TableMetadata b -> TableMetadata b)
-> (TableMetadata b -> TableMetadata b)
-> TableMetadata b
-> TableMetadata b
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) TableMetadata b -> TableMetadata b
forall a. a -> a
id [TableMetadata b -> TableMetadata b]
metadataModifiers
  EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg
  where
    collectDependencies :: m [SchemaObjId]
collectDependencies = do
      TableCoreInfo b
tabInfo <- SourceName -> TableName b -> m (TableCoreInfo b)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableCoreInfo b)
askTableCoreInfo @b SourceName
source TableName b
qt
      m (RelInfo b) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (RelInfo b) -> m ()) -> m (RelInfo b) -> m ()
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo b) -> RelName -> Text -> m (RelInfo b)
forall (m :: * -> *) (backend :: BackendType).
MonadError QErr m =>
FieldInfoMap (FieldInfo backend)
-> RelName -> Text -> m (RelInfo backend)
askRelType (TableCoreInfo b -> FieldInfoMap (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap TableCoreInfo b
tabInfo) RelName
rn Text
""
      SchemaCache
sc <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
      let depObjs :: [SchemaObjId]
depObjs =
            SchemaCache -> SchemaObjId -> [SchemaObjId]
getDependentObjs
              SchemaCache
sc
              ( SourceName -> AnyBackend SourceObjId -> SchemaObjId
SOSourceObj SourceName
source (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
qt (TableObjId b -> SourceObjId b) -> TableObjId b -> SourceObjId b
forall a b. (a -> b) -> a -> b
$
                      RelName -> TableObjId b
forall (b :: BackendType). RelName -> TableObjId b
TORel RelName
rn
              )
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SchemaObjId] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SchemaObjId]
depObjs Bool -> Bool -> Bool
|| Bool
cascade) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [SchemaObjId] -> m ()
forall (m :: * -> *). MonadError QErr m => [SchemaObjId] -> m ()
reportDependentObjectsExist [SchemaObjId]
depObjs
      [SchemaObjId] -> m [SchemaObjId]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [SchemaObjId]
depObjs

purgeRelDep ::
  forall b m.
  QErrM m =>
  Backend b =>
  SchemaObjId ->
  m (TableMetadata b -> TableMetadata b)
purgeRelDep :: SchemaObjId -> m (TableMetadata b -> TableMetadata b)
purgeRelDep (SOSourceObj SourceName
_ AnyBackend SourceObjId
exists)
  | Just (SOITableObj TableName b
_ (TOPerm RoleName
rn PermType
pt)) <- AnyBackend SourceObjId -> Maybe (SourceObjId b)
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
AnyBackend i -> Maybe (i b)
AB.unpackAnyBackend @b AnyBackend SourceObjId
exists =
    (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TableMetadata b -> TableMetadata b)
 -> m (TableMetadata b -> TableMetadata b))
-> (TableMetadata b -> TableMetadata b)
-> m (TableMetadata b -> TableMetadata b)
forall a b. (a -> b) -> a -> b
$ RoleName -> PermType -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
RoleName -> PermType -> TableMetadata b -> TableMetadata b
dropPermissionInMetadata RoleName
rn PermType
pt
purgeRelDep SchemaObjId
d =
  Text -> m (TableMetadata b -> TableMetadata b)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m (TableMetadata b -> TableMetadata b))
-> Text -> m (TableMetadata b -> TableMetadata b)
forall a b. (a -> b) -> a -> b
$
    Text
"unexpected dependency of relationship : "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SchemaObjId -> Text
reportSchemaObj SchemaObjId
d

--------------------------------------------------------------------------------
-- Set local relationship comment

data SetRelComment b = SetRelComment
  { SetRelComment b -> SourceName
arSource :: SourceName,
    SetRelComment b -> TableName b
arTable :: TableName b,
    SetRelComment b -> RelName
arRelationship :: RelName,
    SetRelComment b -> Maybe Text
arComment :: Maybe Text
  }
  deriving ((forall x. SetRelComment b -> Rep (SetRelComment b) x)
-> (forall x. Rep (SetRelComment b) x -> SetRelComment b)
-> Generic (SetRelComment b)
forall x. Rep (SetRelComment b) x -> SetRelComment b
forall x. SetRelComment b -> Rep (SetRelComment b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (SetRelComment b) x -> SetRelComment b
forall (b :: BackendType) x.
SetRelComment b -> Rep (SetRelComment b) x
$cto :: forall (b :: BackendType) x.
Rep (SetRelComment b) x -> SetRelComment b
$cfrom :: forall (b :: BackendType) x.
SetRelComment b -> Rep (SetRelComment b) x
Generic)

deriving instance (Backend b) => Show (SetRelComment b)

deriving instance (Backend b) => Eq (SetRelComment b)

instance (Backend b) => FromJSON (SetRelComment b) where
  parseJSON :: Value -> Parser (SetRelComment b)
parseJSON = String
-> (Object -> Parser (SetRelComment b))
-> Value
-> Parser (SetRelComment b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SetRelComment" ((Object -> Parser (SetRelComment b))
 -> Value -> Parser (SetRelComment b))
-> (Object -> Parser (SetRelComment b))
-> Value
-> Parser (SetRelComment b)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    SourceName
-> TableName b -> RelName -> Maybe Text -> SetRelComment b
forall (b :: BackendType).
SourceName
-> TableName b -> RelName -> Maybe Text -> SetRelComment b
SetRelComment
      (SourceName
 -> TableName b -> RelName -> Maybe Text -> SetRelComment b)
-> Parser SourceName
-> Parser (TableName b -> RelName -> Maybe Text -> SetRelComment 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 -> Maybe Text -> SetRelComment b)
-> Parser (TableName b)
-> Parser (RelName -> Maybe Text -> SetRelComment 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 -> Maybe Text -> SetRelComment b)
-> Parser RelName -> Parser (Maybe Text -> SetRelComment 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
"relationship"
      Parser (Maybe Text -> SetRelComment b)
-> Parser (Maybe Text) -> Parser (SetRelComment b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comment"

runSetRelComment ::
  forall m b.
  (CacheRWM m, MonadError QErr m, MetadataM m, BackendMetadata b) =>
  SetRelComment b ->
  m EncJSON
runSetRelComment :: SetRelComment b -> m EncJSON
runSetRelComment SetRelComment b
defn = do
  TableCoreInfo b
tabInfo <- SourceName -> TableName b -> m (TableCoreInfo b)
forall (b :: BackendType) (m :: * -> *).
(QErrM m, CacheRM m, Backend b) =>
SourceName -> TableName b -> m (TableCoreInfo b)
askTableCoreInfo @b SourceName
source TableName b
qt
  RelType
relType <- RelInfo b -> RelType
forall (b :: BackendType). RelInfo b -> RelType
riType (RelInfo b -> RelType) -> m (RelInfo b) -> m RelType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldInfoMap (FieldInfo b) -> RelName -> Text -> m (RelInfo b)
forall (m :: * -> *) (backend :: BackendType).
MonadError QErr m =>
FieldInfoMap (FieldInfo backend)
-> RelName -> Text -> m (RelInfo backend)
askRelType (TableCoreInfo b -> FieldInfoMap (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap TableCoreInfo b
tabInfo) RelName
rn Text
""
  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
qt (TableMetadataObjId -> SourceMetadataObjId b)
-> TableMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$
              RelName -> RelType -> TableMetadataObjId
MTORel RelName
rn RelType
relType
  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
qt ASetter' Metadata (TableMetadata b)
-> (TableMetadata b -> TableMetadata b) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case RelType
relType of
        RelType
ObjRel -> (Relationships (ObjRelDef b)
 -> Identity (Relationships (ObjRelDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType).
Lens' (TableMetadata b) (Relationships (ObjRelDef b))
tmObjectRelationships ((Relationships (ObjRelDef b)
  -> Identity (Relationships (ObjRelDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> ((Maybe Text -> Identity (Maybe Text))
    -> Relationships (ObjRelDef b)
    -> Identity (Relationships (ObjRelDef b)))
-> (Maybe Text -> Identity (Maybe Text))
-> TableMetadata b
-> Identity (TableMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Relationships (ObjRelDef b))
-> Traversal'
     (Relationships (ObjRelDef b))
     (IxValue (Relationships (ObjRelDef b)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Relationships (ObjRelDef b))
RelName
rn ((ObjRelDef b -> Identity (ObjRelDef b))
 -> Relationships (ObjRelDef b)
 -> Identity (Relationships (ObjRelDef b)))
-> ((Maybe Text -> Identity (Maybe Text))
    -> ObjRelDef b -> Identity (ObjRelDef b))
-> (Maybe Text -> Identity (Maybe Text))
-> Relationships (ObjRelDef b)
-> Identity (Relationships (ObjRelDef b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text))
-> ObjRelDef b -> Identity (ObjRelDef b)
forall a. Lens' (RelDef a) (Maybe Text)
rdComment ((Maybe Text -> Identity (Maybe Text))
 -> TableMetadata b -> Identity (TableMetadata b))
-> Maybe Text -> TableMetadata b -> TableMetadata b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
comment
        RelType
ArrRel -> (Relationships (ArrRelDef b)
 -> Identity (Relationships (ArrRelDef b)))
-> TableMetadata b -> Identity (TableMetadata b)
forall (b :: BackendType).
Lens' (TableMetadata b) (Relationships (ArrRelDef b))
tmArrayRelationships ((Relationships (ArrRelDef b)
  -> Identity (Relationships (ArrRelDef b)))
 -> TableMetadata b -> Identity (TableMetadata b))
-> ((Maybe Text -> Identity (Maybe Text))
    -> Relationships (ArrRelDef b)
    -> Identity (Relationships (ArrRelDef b)))
-> (Maybe Text -> Identity (Maybe Text))
-> TableMetadata b
-> Identity (TableMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Relationships (ArrRelDef b))
-> Traversal'
     (Relationships (ArrRelDef b))
     (IxValue (Relationships (ArrRelDef b)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Relationships (ArrRelDef b))
RelName
rn ((ArrRelDef b -> Identity (ArrRelDef b))
 -> Relationships (ArrRelDef b)
 -> Identity (Relationships (ArrRelDef b)))
-> ((Maybe Text -> Identity (Maybe Text))
    -> ArrRelDef b -> Identity (ArrRelDef b))
-> (Maybe Text -> Identity (Maybe Text))
-> Relationships (ArrRelDef b)
-> Identity (Relationships (ArrRelDef b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text))
-> ArrRelDef b -> Identity (ArrRelDef b)
forall a. Lens' (RelDef a) (Maybe Text)
rdComment ((Maybe Text -> Identity (Maybe Text))
 -> TableMetadata b -> Identity (TableMetadata b))
-> Maybe Text -> TableMetadata b -> TableMetadata b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
comment
  EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg
  where
    SetRelComment SourceName
source TableName b
qt RelName
rn Maybe Text
comment = SetRelComment b
defn