mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-16 18:42:30 +03:00
11867b50a4
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4530 Co-authored-by: Karthikeyan Chinnakonda <15602904+codingkarthik@users.noreply.github.com> Co-authored-by: Rikin Kachhia <54616969+rikinsk@users.noreply.github.com> GitOrigin-RevId: c4c1a3bd9736ec275e77c6f55c76049c550443f9
744 lines
25 KiB
Haskell
744 lines
25 KiB
Haskell
-- | Functions for updating the metadata (with integrity checking) to incorporate schema changes
|
|
-- discovered after applying a user-supplied SQL query. None of these functions modify the schema
|
|
-- cache, so it must be reloaded after the metadata is updated.
|
|
module Hasura.RQL.DDL.Schema.Rename
|
|
( renameTableInMetadata,
|
|
renameColumnInMetadata,
|
|
renameRelationshipInMetadata,
|
|
)
|
|
where
|
|
|
|
import Control.Lens.Combinators
|
|
import Control.Lens.Operators
|
|
import Data.Aeson
|
|
import Data.HashMap.Strict qualified as M
|
|
import Data.HashMap.Strict.InsOrd qualified as OMap
|
|
import Data.HashSet qualified as Set
|
|
import Data.Text.Extended
|
|
import Hasura.Base.Error
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.DDL.Permission
|
|
import Hasura.RQL.IR.BoolExp
|
|
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.Permission
|
|
import Hasura.RQL.Types.Relationships.Local
|
|
import Hasura.RQL.Types.Relationships.Remote
|
|
import Hasura.RQL.Types.Relationships.ToSchema
|
|
import Hasura.RQL.Types.Relationships.ToSource
|
|
import Hasura.RQL.Types.SchemaCache
|
|
import Hasura.RQL.Types.SchemaCacheTypes
|
|
import Hasura.RQL.Types.Table
|
|
import Hasura.SQL.AnyBackend qualified as AB
|
|
import Hasura.SQL.Backend
|
|
import Hasura.Session
|
|
import Language.GraphQL.Draft.Syntax qualified as G
|
|
|
|
data RenameItem (b :: BackendType) a = RenameItem
|
|
{ _riTable :: !(TableName b),
|
|
_riOld :: !a,
|
|
_riNew :: !a
|
|
}
|
|
|
|
type RenameCol (b :: BackendType) = RenameItem b (Column b)
|
|
|
|
data RenameField b
|
|
= RFCol !(RenameCol b)
|
|
| RFRel !(RenameItem b RelName)
|
|
|
|
type RenameTable b = (TableName b, TableName b)
|
|
|
|
data Rename b
|
|
= RTable !(RenameTable b)
|
|
| RField !(RenameField b)
|
|
|
|
otherDeps :: QErrM m => Text -> SchemaObjId -> m ()
|
|
otherDeps errMsg d =
|
|
throw500 $
|
|
"unexpected dependency "
|
|
<> reportSchemaObj d
|
|
<> "; "
|
|
<> errMsg
|
|
|
|
-- | Replace all references to a given table name by its new name across the entire metadata.
|
|
--
|
|
-- This function will make use of the metadata dependency graph (see 'getDependentObjs') to identify
|
|
-- all places that refer to the old table name, and replace it accordingly. Most operations will
|
|
-- occur within the same source, such as table references in relationships and permissions.
|
|
-- Dependencies across sources can happen in the case of cross-source relationships.
|
|
--
|
|
-- This function will fail if it encounters a nonsensical dependency; for instance, if there's a
|
|
-- dependency from that table to a source.
|
|
--
|
|
-- For more information about the dependency graph, see 'SchemaObjId'.
|
|
renameTableInMetadata ::
|
|
forall b m.
|
|
( MonadError QErr m,
|
|
CacheRM m,
|
|
MonadWriter MetadataModifier m,
|
|
BackendMetadata b
|
|
) =>
|
|
SourceName ->
|
|
TableName b ->
|
|
TableName b ->
|
|
m ()
|
|
renameTableInMetadata source newQT oldQT = do
|
|
sc <- askSchemaCache
|
|
let allDeps =
|
|
getDependentObjs sc $
|
|
SOSourceObj source $
|
|
AB.mkAnyBackend $
|
|
SOITable @b oldQT
|
|
|
|
-- update all dependant schema objects
|
|
forM_ allDeps $ \case
|
|
-- the dependend object is a source object in the same source
|
|
sobj@(SOSourceObj depSourceName exists)
|
|
| depSourceName == source,
|
|
Just sourceObjId <- AB.unpackAnyBackend @b exists ->
|
|
case sourceObjId of
|
|
SOITableObj refQT (TORel rn) ->
|
|
updateRelDefs @b source refQT rn (oldQT, newQT)
|
|
SOITableObj refQT (TOPerm rn pt) ->
|
|
updatePermFlds @b source refQT rn pt $ RTable (oldQT, newQT)
|
|
-- A trigger's definition is not dependent on the table directly
|
|
SOITableObj _ (TOTrigger _) -> pure ()
|
|
-- A remote relationship's definition is not dependent on the table directly
|
|
SOITableObj _ (TORemoteRel _) -> pure ()
|
|
_ -> otherDeps errMsg sobj
|
|
-- the dependend object is a source object in a different source
|
|
sobj@(SOSourceObj depSourceName exists) ->
|
|
AB.dispatchAnyBackend @Backend exists \(sourceObjId :: SourceObjId b') ->
|
|
case sourceObjId of
|
|
SOITableObj tableName (TORemoteRel remoteRelationshipName) -> do
|
|
updateTableInRemoteRelationshipRHS @b' @b depSourceName tableName remoteRelationshipName (oldQT, newQT)
|
|
-- only remote relationships might create dependencies across sources
|
|
_ -> otherDeps errMsg sobj
|
|
-- any other kind of dependent object (erroneous)
|
|
d -> otherDeps errMsg d
|
|
-- Update table name in metadata
|
|
tell $
|
|
MetadataModifier $
|
|
metaSources . ix source . (toSourceMetadata @b) . smTables %~ \tables ->
|
|
flip (maybe tables) (OMap.lookup oldQT tables) $
|
|
\tableMeta -> OMap.delete oldQT $ OMap.insert newQT tableMeta {_tmTable = newQT} tables
|
|
where
|
|
errMsg = "cannot rename table " <> oldQT <<> " to " <>> newQT
|
|
|
|
-- | Replace all references to a given column name by its new name across the entire metadata.
|
|
--
|
|
-- This function will make use of the metadata dependency graph (see 'getDependentObjs') to identify
|
|
-- all places that refer to the old column name, and replace it accordingly. Most operations will
|
|
-- occur within the same source, such as column references in relationships and permissions.
|
|
-- Dependencies across sources can happen in the case of cross-source relationships.
|
|
--
|
|
-- This function will fail if it encounters a nonsensical dependency; for instance, if there's a
|
|
-- dependency from that table to a source.
|
|
--
|
|
-- For more information about the dependency graph, see 'SchemaObjId'.
|
|
renameColumnInMetadata ::
|
|
forall b m.
|
|
( MonadError QErr m,
|
|
CacheRM m,
|
|
MonadWriter MetadataModifier m,
|
|
BackendMetadata b
|
|
) =>
|
|
Column b ->
|
|
Column b ->
|
|
SourceName ->
|
|
TableName b ->
|
|
FieldInfoMap (FieldInfo b) ->
|
|
m ()
|
|
renameColumnInMetadata oCol nCol source qt fieldInfo = do
|
|
sc <- askSchemaCache
|
|
-- Check if any relation exists with new column name
|
|
assertFldNotExists
|
|
-- Fetch dependent objects
|
|
let depObjs =
|
|
getDependentObjs sc $
|
|
SOSourceObj source $
|
|
AB.mkAnyBackend $
|
|
SOITableObj @b qt $
|
|
TOCol @b oCol
|
|
renameItem = RenameItem @b qt oCol nCol
|
|
renameFld = RFCol renameItem
|
|
-- Update dependent objects
|
|
forM_ depObjs $ \case
|
|
-- the dependend object is a source object in the same source
|
|
sobj@(SOSourceObj depSourceName exists)
|
|
| depSourceName == source,
|
|
Just sourceObjId <- AB.unpackAnyBackend @b exists ->
|
|
case sourceObjId of
|
|
SOITableObj refQT (TOPerm role pt) ->
|
|
updatePermFlds @b source refQT role pt $ RField renameFld
|
|
SOITableObj refQT (TORel rn) ->
|
|
updateColInRel @b source refQT rn renameItem
|
|
SOITableObj refQT (TOTrigger triggerName) ->
|
|
tell $
|
|
MetadataModifier $
|
|
tableMetadataSetter @b source refQT . tmEventTriggers . ix triggerName
|
|
%~ updateColumnInEventTrigger @b refQT oCol nCol qt
|
|
SOITableObj _ (TORemoteRel remoteRelName) ->
|
|
updateColInRemoteRelationshipLHS source remoteRelName renameItem
|
|
_ -> otherDeps errMsg sobj
|
|
-- the dependend object is a source object in a different source
|
|
sobj@(SOSourceObj depSourceName exists) ->
|
|
AB.dispatchAnyBackend @Backend exists \(sourceObjId :: SourceObjId b') ->
|
|
case sourceObjId of
|
|
SOITableObj tableName (TORemoteRel remoteRelationshipName) -> do
|
|
updateColInRemoteRelationshipRHS @b' @b depSourceName tableName remoteRelationshipName renameItem
|
|
-- only remote relationships might create dependencies across sources
|
|
_ -> otherDeps errMsg sobj
|
|
-- any other kind of dependent object (erroneous)
|
|
d -> otherDeps errMsg d
|
|
-- Update custom column names
|
|
possiblyUpdateCustomColumnNames @b source qt oCol nCol
|
|
where
|
|
errMsg = "cannot rename column " <> oCol <<> " to " <>> nCol
|
|
assertFldNotExists =
|
|
case M.lookup (fromCol @b oCol) fieldInfo of
|
|
Just (FIRelationship _) ->
|
|
throw400 AlreadyExists $
|
|
"cannot rename column " <> oCol
|
|
<<> " to " <> nCol
|
|
<<> " in table " <> qt
|
|
<<> " as a relationship with the name already exists"
|
|
_ -> pure ()
|
|
|
|
renameRelationshipInMetadata ::
|
|
forall b m.
|
|
( MonadError QErr m,
|
|
CacheRM m,
|
|
MonadWriter MetadataModifier m,
|
|
BackendMetadata b
|
|
) =>
|
|
SourceName ->
|
|
TableName b ->
|
|
RelName ->
|
|
RelType ->
|
|
RelName ->
|
|
m ()
|
|
renameRelationshipInMetadata source qt oldRN relType newRN = do
|
|
sc <- askSchemaCache
|
|
let depObjs =
|
|
getDependentObjs sc $
|
|
SOSourceObj source $
|
|
AB.mkAnyBackend $
|
|
SOITableObj @b qt $
|
|
TORel oldRN
|
|
renameFld = RFRel $ RenameItem @b qt oldRN newRN
|
|
|
|
forM_ depObjs $ \case
|
|
sobj@(SOSourceObj _ exists) -> case AB.unpackAnyBackend @b exists of
|
|
Just (SOITableObj refQT (TOPerm role pt)) ->
|
|
updatePermFlds @b source refQT role pt $ RField renameFld
|
|
_ -> otherDeps errMsg sobj
|
|
d -> otherDeps errMsg d
|
|
tell $
|
|
MetadataModifier $
|
|
tableMetadataSetter @b source qt %~ case relType of
|
|
ObjRel -> tmObjectRelationships %~ rewriteRelationships
|
|
ArrRel -> tmArrayRelationships %~ rewriteRelationships
|
|
where
|
|
errMsg = "cannot rename relationship " <> oldRN <<> " to " <>> newRN
|
|
rewriteRelationships ::
|
|
Relationships (RelDef a) -> Relationships (RelDef a)
|
|
rewriteRelationships relationsMap =
|
|
flip (maybe relationsMap) (OMap.lookup oldRN relationsMap) $
|
|
\rd -> OMap.insert newRN rd {_rdName = newRN} $ OMap.delete oldRN relationsMap
|
|
|
|
-- update table names in relationship definition
|
|
updateRelDefs ::
|
|
forall b m.
|
|
( MonadError QErr m,
|
|
CacheRM m,
|
|
MonadWriter MetadataModifier m,
|
|
BackendMetadata b
|
|
) =>
|
|
SourceName ->
|
|
TableName b ->
|
|
RelName ->
|
|
RenameTable b ->
|
|
m ()
|
|
updateRelDefs source qt rn renameTable = do
|
|
fim <- askTableFieldInfoMap @b source qt
|
|
ri <- askRelType fim rn ""
|
|
tell $
|
|
MetadataModifier $
|
|
tableMetadataSetter source qt %~ case riType ri of
|
|
ObjRel -> tmObjectRelationships . ix rn %~ updateObjRelDef renameTable
|
|
ArrRel -> tmArrayRelationships . ix rn %~ updateArrRelDef renameTable
|
|
where
|
|
updateObjRelDef :: RenameTable b -> ObjRelDef b -> ObjRelDef b
|
|
updateObjRelDef (oldQT, newQT) =
|
|
rdUsing %~ \case
|
|
RUFKeyOn fk -> RUFKeyOn fk
|
|
RUManual (RelManualConfig origQT rmCols rmIO) ->
|
|
let updQT = bool origQT newQT $ oldQT == origQT
|
|
in RUManual $ RelManualConfig updQT rmCols rmIO
|
|
|
|
updateArrRelDef :: RenameTable b -> ArrRelDef b -> ArrRelDef b
|
|
updateArrRelDef (oldQT, newQT) =
|
|
rdUsing %~ \case
|
|
RUFKeyOn (ArrRelUsingFKeyOn origQT c) ->
|
|
let updQT = getUpdQT origQT
|
|
in RUFKeyOn $ ArrRelUsingFKeyOn updQT c
|
|
RUManual (RelManualConfig origQT rmCols rmIO) ->
|
|
let updQT = getUpdQT origQT
|
|
in RUManual $ RelManualConfig updQT rmCols rmIO
|
|
where
|
|
getUpdQT origQT = bool origQT newQT $ oldQT == origQT
|
|
|
|
-- | update fields in permissions
|
|
updatePermFlds ::
|
|
forall b m.
|
|
( MonadError QErr m,
|
|
CacheRM m,
|
|
MonadWriter MetadataModifier m,
|
|
BackendMetadata b
|
|
) =>
|
|
SourceName ->
|
|
TableName b ->
|
|
RoleName ->
|
|
PermType ->
|
|
Rename b ->
|
|
m ()
|
|
updatePermFlds source refQT rn pt rename = do
|
|
tables <- fold <$> askTableCache source
|
|
let withTables :: Reader (TableCache b) a -> a
|
|
withTables = flip runReader tables
|
|
tell $
|
|
MetadataModifier $
|
|
tableMetadataSetter source refQT %~ case pt of
|
|
PTInsert ->
|
|
tmInsertPermissions . ix rn . pdPermission %~ \insPerm ->
|
|
withTables $ updateInsPermFlds refQT rename insPerm
|
|
PTSelect ->
|
|
tmSelectPermissions . ix rn . pdPermission %~ \selPerm ->
|
|
withTables $ updateSelPermFlds refQT rename selPerm
|
|
PTUpdate ->
|
|
tmUpdatePermissions . ix rn . pdPermission %~ \updPerm ->
|
|
withTables $ updateUpdPermFlds refQT rename updPerm
|
|
PTDelete ->
|
|
tmDeletePermissions . ix rn . pdPermission %~ \delPerm ->
|
|
withTables $ updateDelPermFlds refQT rename delPerm
|
|
|
|
updateInsPermFlds ::
|
|
(MonadReader (TableCache b) m, Backend b) =>
|
|
TableName b ->
|
|
Rename b ->
|
|
PermDefPermission b InsPerm ->
|
|
m (PermDefPermission b InsPerm)
|
|
updateInsPermFlds refQT rename (InsPerm' (InsPerm chk preset cols backendOnly)) =
|
|
case rename of
|
|
RTable rt -> do
|
|
let updChk = updateTableInBoolExp rt chk
|
|
pure $ InsPerm' $ InsPerm updChk preset cols backendOnly
|
|
RField rf -> do
|
|
updChk <- updateFieldInBoolExp refQT rf chk
|
|
let updPresetM = updatePreset refQT rf <$> preset
|
|
updColsM = updateCols refQT rf <$> cols
|
|
pure $ InsPerm' $ InsPerm updChk updPresetM updColsM backendOnly
|
|
|
|
updateSelPermFlds ::
|
|
(MonadReader (TableCache b) m, Backend b) =>
|
|
TableName b ->
|
|
Rename b ->
|
|
PermDefPermission b SelPerm ->
|
|
m (PermDefPermission b SelPerm)
|
|
updateSelPermFlds refQT rename (SelPerm' (SelPerm cols fltr limit aggAllwd computedFields)) = do
|
|
case rename of
|
|
RTable rt -> do
|
|
let updFltr = updateTableInBoolExp rt fltr
|
|
pure $ SelPerm' $ SelPerm cols updFltr limit aggAllwd computedFields
|
|
RField rf -> do
|
|
updFltr <- updateFieldInBoolExp refQT rf fltr
|
|
let updCols = updateCols refQT rf cols
|
|
pure $ SelPerm' $ SelPerm updCols updFltr limit aggAllwd computedFields
|
|
|
|
updateUpdPermFlds ::
|
|
(MonadReader (TableCache b) m, Backend b) =>
|
|
TableName b ->
|
|
Rename b ->
|
|
PermDefPermission b UpdPerm ->
|
|
m (PermDefPermission b UpdPerm)
|
|
updateUpdPermFlds refQT rename (UpdPerm' (UpdPerm cols preset fltr check backendOnly)) = do
|
|
case rename of
|
|
RTable rt -> do
|
|
let updFltr = updateTableInBoolExp rt fltr
|
|
updCheck = fmap (updateTableInBoolExp rt) check
|
|
pure $ UpdPerm' $ UpdPerm cols preset updFltr updCheck backendOnly
|
|
RField rf -> do
|
|
updFltr <- updateFieldInBoolExp refQT rf fltr
|
|
updCheck <- traverse (updateFieldInBoolExp refQT rf) check
|
|
let updCols = updateCols refQT rf cols
|
|
updPresetM = updatePreset refQT rf <$> preset
|
|
pure $ UpdPerm' $ UpdPerm updCols updPresetM updFltr updCheck backendOnly
|
|
|
|
updateDelPermFlds ::
|
|
(MonadReader (TableCache b) m, Backend b) =>
|
|
TableName b ->
|
|
Rename b ->
|
|
PermDefPermission b DelPerm ->
|
|
m (PermDefPermission b DelPerm)
|
|
updateDelPermFlds refQT rename (DelPerm' (DelPerm fltr backendOnly)) = do
|
|
case rename of
|
|
RTable rt -> do
|
|
let updFltr = updateTableInBoolExp rt fltr
|
|
pure $ DelPerm' $ DelPerm updFltr backendOnly
|
|
RField rf -> do
|
|
updFltr <- updateFieldInBoolExp refQT rf fltr
|
|
pure $ DelPerm' $ DelPerm updFltr backendOnly
|
|
|
|
updatePreset ::
|
|
(Backend b) =>
|
|
TableName b ->
|
|
RenameField b ->
|
|
ColumnValues b Value ->
|
|
ColumnValues b Value
|
|
updatePreset qt rf obj =
|
|
case rf of
|
|
RFCol (RenameItem opQT oCol nCol) ->
|
|
if qt == opQT
|
|
then updatePreset' oCol nCol
|
|
else obj
|
|
_ -> obj
|
|
where
|
|
updatePreset' oCol nCol =
|
|
M.fromList updItems
|
|
where
|
|
updItems = map procObjItem $ M.toList obj
|
|
procObjItem (pgCol, v) =
|
|
let isUpdated = pgCol == oCol
|
|
updCol = bool pgCol nCol isUpdated
|
|
in (updCol, v)
|
|
|
|
updateCols ::
|
|
(Backend b) => TableName b -> RenameField b -> PermColSpec b -> PermColSpec b
|
|
updateCols qt rf permSpec =
|
|
case rf of
|
|
RFCol (RenameItem opQT oCol nCol) ->
|
|
if qt == opQT
|
|
then updateCols' oCol nCol permSpec
|
|
else permSpec
|
|
_ -> permSpec
|
|
where
|
|
updateCols' oCol nCol cols = case cols of
|
|
PCStar -> cols
|
|
PCCols c -> PCCols $
|
|
flip map c $
|
|
\col -> if col == oCol then nCol else col
|
|
|
|
updateTableInBoolExp :: (Backend b) => RenameTable b -> BoolExp b -> BoolExp b
|
|
updateTableInBoolExp (oldQT, newQT) =
|
|
over _Wrapped . transform $
|
|
(_BoolExists . geTable) %~ \rqfQT ->
|
|
if rqfQT == oldQT then newQT else rqfQT
|
|
|
|
updateFieldInBoolExp ::
|
|
(MonadReader (TableCache b) m, Backend b) =>
|
|
TableName b ->
|
|
RenameField b ->
|
|
BoolExp b ->
|
|
m (BoolExp b)
|
|
updateFieldInBoolExp qt rf be =
|
|
BoolExp
|
|
<$> case unBoolExp be of
|
|
BoolAnd exps -> BoolAnd <$> procExps exps
|
|
BoolOr exps -> BoolOr <$> procExps exps
|
|
BoolNot e -> BoolNot <$> updateBoolExp' e
|
|
BoolExists (GExists refqt wh) ->
|
|
BoolExists . GExists refqt . unBoolExp
|
|
<$> updateFieldInBoolExp refqt rf (BoolExp wh)
|
|
BoolFld fld -> BoolFld <$> updateColExp qt rf fld
|
|
where
|
|
procExps = mapM updateBoolExp'
|
|
updateBoolExp' =
|
|
fmap unBoolExp . updateFieldInBoolExp qt rf . BoolExp
|
|
|
|
updateColExp ::
|
|
forall b m.
|
|
(MonadReader (TableCache b) m, Backend b) =>
|
|
TableName b ->
|
|
RenameField b ->
|
|
ColExp ->
|
|
m ColExp
|
|
updateColExp qt rf (ColExp fld val) =
|
|
ColExp updatedFld <$> updatedVal
|
|
where
|
|
updatedFld = bool fld nFld $ opQT == qt && oFld == fld
|
|
updatedVal = do
|
|
tables <- ask
|
|
let maybeFieldInfo =
|
|
M.lookup qt tables
|
|
>>= M.lookup fld . _tciFieldInfoMap . _tiCoreInfo
|
|
case maybeFieldInfo of
|
|
Nothing -> pure val
|
|
Just fi -> case fi of
|
|
FIColumn _ -> pure val
|
|
FIComputedField _ -> pure val
|
|
FIRelationship ri -> do
|
|
let remTable = riRTable ri
|
|
case decodeValue val of
|
|
Left _ -> pure val
|
|
Right be -> toJSON <$> updateFieldInBoolExp remTable rf be
|
|
FIRemoteRelationship {} -> pure val
|
|
|
|
(oFld, nFld, opQT) = case rf of
|
|
RFCol (RenameItem tn oCol nCol) -> (fromCol @b oCol, fromCol @b nCol, tn)
|
|
RFRel (RenameItem tn oRel nRel) -> (fromRel oRel, fromRel nRel, tn)
|
|
|
|
-- rename columns in relationship definitions
|
|
updateColInRel ::
|
|
forall b m.
|
|
(CacheRM m, MonadWriter MetadataModifier m, BackendMetadata b) =>
|
|
SourceName ->
|
|
TableName b ->
|
|
RelName ->
|
|
RenameCol b ->
|
|
m ()
|
|
updateColInRel source fromQT rn rnCol = do
|
|
tables <- fold <$> askTableCache @b source
|
|
let maybeRelInfo =
|
|
tables ^? ix fromQT . tiCoreInfo . tciFieldInfoMap . ix (fromRel rn) . _FIRelationship
|
|
forM_ maybeRelInfo $ \relInfo ->
|
|
let relTableName = riRTable relInfo
|
|
in tell $
|
|
MetadataModifier $
|
|
tableMetadataSetter source fromQT
|
|
%~ case riType relInfo of
|
|
ObjRel ->
|
|
tmObjectRelationships . ix rn . rdUsing
|
|
%~ updateColInObjRel fromQT relTableName rnCol
|
|
ArrRel ->
|
|
tmArrayRelationships . ix rn . rdUsing
|
|
%~ updateColInArrRel fromQT relTableName rnCol
|
|
|
|
-- | Local helper: update a column's name in the left-hand side of a remote relationship.
|
|
--
|
|
-- There are two kinds or remote relationships: remote source relationships, across sources, and
|
|
-- remote schema relationships, on remote schemas. In both cases, we maintain a mapping from the
|
|
-- source table's colunns to what they should be joined against in the target; when a column is
|
|
-- renamed, those references must be renamed as well. This function handles both cases.
|
|
--
|
|
-- See 'renameColumnInMetadata'.
|
|
updateColInRemoteRelationshipLHS ::
|
|
forall b m.
|
|
( MonadError QErr m,
|
|
MonadWriter MetadataModifier m,
|
|
BackendMetadata b
|
|
) =>
|
|
SourceName ->
|
|
RelName ->
|
|
RenameCol b ->
|
|
m ()
|
|
updateColInRemoteRelationshipLHS source remoteRelationshipName (RenameItem qt oldCol newCol) = do
|
|
oldColName <- parseGraphQLName $ toTxt oldCol
|
|
newColName <- parseGraphQLName $ toTxt newCol
|
|
let oldFieldName = fromCol @b oldCol
|
|
newFieldName = fromCol @b newCol
|
|
|
|
updateSet =
|
|
Set.insert newFieldName . Set.delete oldFieldName
|
|
|
|
updateMapKey =
|
|
-- mapKeys is not available in 0.2.13.0
|
|
M.fromList . map (\(key, value) -> (if key == oldFieldName then newFieldName else key, value)) . M.toList
|
|
|
|
updateFieldCalls (RemoteFields fields) =
|
|
RemoteFields $
|
|
fields <&> \(FieldCall name (RemoteArguments args)) ->
|
|
FieldCall name $ RemoteArguments $ updateVariableName <$> args
|
|
|
|
updateVariableName =
|
|
fmap \v -> if v == oldColName then newColName else v
|
|
|
|
remoteRelationshipLens =
|
|
tableMetadataSetter @b source qt . tmRemoteRelationships . ix remoteRelationshipName . rrDefinition
|
|
|
|
remoteSchemaLHSModifier =
|
|
remoteRelationshipLens . _RelationshipToSchema . _2
|
|
%~ (trrdLhsFields %~ updateSet)
|
|
. (trrdRemoteField %~ updateFieldCalls)
|
|
|
|
remoteSourceLHSModifier =
|
|
remoteRelationshipLens . _RelationshipToSource . tsrdFieldMapping %~ updateMapKey
|
|
|
|
tell $ MetadataModifier $ remoteSchemaLHSModifier . remoteSourceLHSModifier
|
|
where
|
|
parseGraphQLName txt =
|
|
G.mkName txt
|
|
`onNothing` throw400 ParseFailed (txt <> " is not a valid GraphQL name")
|
|
|
|
-- | Local helper: update a column's name in the right-hand side of a remote relationship.
|
|
--
|
|
-- In the case of remote _source_ relationships, the mapping from column to column needs to be
|
|
-- updated if one of the rhs columns has been renamed. A dependency is tracked from the rhs source's
|
|
-- column to the lhs source's relationship: when a rhs source's column has been renamed, this
|
|
-- function performs the corresponding update in the lhs source's relationship definition.
|
|
--
|
|
-- See 'renameColumnInMetadata'.
|
|
updateColInRemoteRelationshipRHS ::
|
|
forall source target m.
|
|
( MonadWriter MetadataModifier m,
|
|
Backend source,
|
|
Backend target
|
|
) =>
|
|
SourceName ->
|
|
TableName source ->
|
|
RelName ->
|
|
RenameCol target ->
|
|
m ()
|
|
updateColInRemoteRelationshipRHS source tableName remoteRelationshipName (RenameItem _ oldCol newCol) =
|
|
tell $
|
|
MetadataModifier $
|
|
tableMetadataSetter @source source tableName
|
|
. tmRemoteRelationships
|
|
. ix remoteRelationshipName
|
|
. rrDefinition
|
|
. _RelationshipToSource
|
|
. tsrdFieldMapping
|
|
%~ updateMapValue
|
|
where
|
|
oldFieldName = fromCol @target oldCol
|
|
newFieldName = fromCol @target newCol
|
|
updateMapValue =
|
|
fmap \value -> if value == oldFieldName then newFieldName else value
|
|
|
|
-- | Local helper: update a table's name in the right-hand side of a remote relationship.
|
|
--
|
|
-- In the case of remote _source_ relationships, the relationship definition targets a specific
|
|
-- table in the rhs source, and that reference needs to be updated if the targeted table has been
|
|
-- renamed. A dependency is tracked from the rhs source's table to the lhs source's relationship:
|
|
-- when a rhs table has been renamed, this function performs the corresponding update in the lhs
|
|
-- source's relationship definition.
|
|
--
|
|
-- See 'renameTableInMetadata'.
|
|
updateTableInRemoteRelationshipRHS ::
|
|
forall source target m.
|
|
( MonadWriter MetadataModifier m,
|
|
Backend source,
|
|
Backend target
|
|
) =>
|
|
SourceName ->
|
|
TableName source ->
|
|
RelName ->
|
|
RenameTable target ->
|
|
m ()
|
|
updateTableInRemoteRelationshipRHS source tableName remoteRelationshipName (_, newTableName) =
|
|
tell $
|
|
MetadataModifier $
|
|
tableMetadataSetter @source source tableName
|
|
. tmRemoteRelationships
|
|
. ix remoteRelationshipName
|
|
. rrDefinition
|
|
. _RelationshipToSource
|
|
. tsrdTable
|
|
.~ toJSON newTableName
|
|
|
|
updateColInObjRel ::
|
|
(Backend b) =>
|
|
TableName b ->
|
|
TableName b ->
|
|
RenameCol b ->
|
|
ObjRelUsing b ->
|
|
ObjRelUsing b
|
|
updateColInObjRel fromQT toQT rnCol = \case
|
|
RUFKeyOn c ->
|
|
RUFKeyOn $ updateRelChoice fromQT toQT rnCol c
|
|
RUManual manConfig ->
|
|
RUManual $ updateRelManualConfig fromQT toQT rnCol manConfig
|
|
|
|
updateRelChoice ::
|
|
Backend b =>
|
|
TableName b ->
|
|
TableName b ->
|
|
RenameCol b ->
|
|
ObjRelUsingChoice b ->
|
|
ObjRelUsingChoice b
|
|
updateRelChoice fromQT toQT rnCol =
|
|
\case
|
|
SameTable col -> SameTable $ getNewCol rnCol fromQT col
|
|
RemoteTable t c -> RemoteTable t (getNewCol rnCol toQT c)
|
|
|
|
updateColInArrRel ::
|
|
(Backend b) =>
|
|
TableName b ->
|
|
TableName b ->
|
|
RenameCol b ->
|
|
ArrRelUsing b ->
|
|
ArrRelUsing b
|
|
updateColInArrRel fromQT toQT rnCol = \case
|
|
RUFKeyOn (ArrRelUsingFKeyOn t c) ->
|
|
let updCol = getNewCol rnCol toQT c
|
|
in RUFKeyOn $ ArrRelUsingFKeyOn t updCol
|
|
RUManual manConfig -> RUManual $ updateRelManualConfig fromQT toQT rnCol manConfig
|
|
|
|
type ColMap b = HashMap (Column b) (Column b)
|
|
|
|
getNewCol ::
|
|
forall b f.
|
|
Backend b =>
|
|
Functor f =>
|
|
RenameCol b ->
|
|
TableName b ->
|
|
f (Column b) ->
|
|
f (Column b)
|
|
getNewCol rnCol qt cols =
|
|
if qt == opQT
|
|
then go <$> cols
|
|
else cols
|
|
where
|
|
RenameItem opQT oCol nCol = rnCol
|
|
go :: Column b -> Column b
|
|
go col
|
|
| col == oCol = nCol
|
|
| otherwise = col
|
|
|
|
updateRelManualConfig ::
|
|
forall b.
|
|
(Backend b) =>
|
|
TableName b ->
|
|
TableName b ->
|
|
RenameCol b ->
|
|
RelManualConfig b ->
|
|
RelManualConfig b
|
|
updateRelManualConfig fromQT toQT rnCol manConfig =
|
|
RelManualConfig tn (updateColMap fromQT toQT rnCol colMap) io
|
|
where
|
|
RelManualConfig tn colMap io = manConfig
|
|
|
|
updateColMap ::
|
|
forall b.
|
|
(Backend b) =>
|
|
TableName b ->
|
|
TableName b ->
|
|
RenameCol b ->
|
|
ColMap b ->
|
|
ColMap b
|
|
updateColMap fromQT toQT rnCol =
|
|
M.fromList . map (modCol fromQT *** modCol toQT) . M.toList
|
|
where
|
|
RenameItem qt oCol nCol = rnCol
|
|
modCol colQt col = if colQt == qt && col == oCol then nCol else col
|
|
|
|
possiblyUpdateCustomColumnNames ::
|
|
forall b m.
|
|
(MonadWriter MetadataModifier m, BackendMetadata b) =>
|
|
SourceName ->
|
|
TableName b ->
|
|
Column b ->
|
|
Column b ->
|
|
m ()
|
|
possiblyUpdateCustomColumnNames source tableName oldColumn newColumn = do
|
|
tell $
|
|
MetadataModifier $
|
|
tableMetadataSetter @b source tableName . tmConfiguration . tcColumnConfig %~ swapOldColumnForNewColumn
|
|
where
|
|
swapOldColumnForNewColumn :: HashMap (Column b) columnData -> HashMap (Column b) columnData
|
|
swapOldColumnForNewColumn customColumns =
|
|
M.fromList $ (\(dbCol, val) -> (,val) $ if dbCol == oldColumn then newColumn else dbCol) <$> M.toList customColumns
|