mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-16 18:42:30 +03:00
342391f39d
This upgrades the version of Ormolu required by the HGE repository to v0.5.0.1, and reformats all code accordingly. Ormolu v0.5 reformats code that uses infix operators. This is mostly useful, adding newlines and indentation to make it clear which operators are applied first, but in some cases, it's unpleasant. To make this easier on the eyes, I had to do the following: * Add a few fixity declarations (search for `infix`) * Add parentheses to make precedence clear, allowing Ormolu to keep everything on one line * Rename `relevantEq` to `(==~)` in #6651 and set it to `infix 4` * Add a few _.ormolu_ files (thanks to @hallettj for helping me get started), mostly for Autodocodec operators that don't have explicit fixity declarations In general, I think these changes are quite reasonable. They mostly affect indentation. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6675 GitOrigin-RevId: cd47d87f1d089fb0bc9dcbbe7798dbceedcd7d83
747 lines
26 KiB
Haskell
747 lines
26 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.ToSource
|
|
import Hasura.RQL.Types.SchemaCache
|
|
import Hasura.RQL.Types.SchemaCacheTypes
|
|
import Hasura.RQL.Types.Table
|
|
import Hasura.RemoteSchema.Metadata
|
|
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 allowedQueryRootFieldTypes allowedSubsRootFieldTypes)) = do
|
|
case rename of
|
|
RTable rt -> do
|
|
let updFltr = updateTableInBoolExp rt fltr
|
|
pure $ SelPerm' $ SelPerm cols updFltr limit aggAllwd computedFields allowedQueryRootFieldTypes allowedSubsRootFieldTypes
|
|
RField rf -> do
|
|
updFltr <- updateFieldInBoolExp refQT rf fltr
|
|
let updCols = updateCols refQT rf cols
|
|
pure $ SelPerm' $ SelPerm updCols updFltr limit aggAllwd computedFields allowedQueryRootFieldTypes allowedSubsRootFieldTypes
|
|
|
|
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)
|
|
BoolField fld -> BoolField <$> 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
|