graphql-engine/server/src-lib/Hasura/RQL/DDL/Schema/Rename.hs
Naveen Naidu 11867b50a4 server: extend backend_only setting for update and delete permissions
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
2022-05-31 14:42:14 +00:00

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