diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Changelog for persistent-postgresql +# 2.14.2.0 + +* [#1614](https://github.com/yesodweb/persistent/pull/1614) + * Generate migrations to create foreign key constraints while adding new foreign key columns (previously you had to generate migrations twice to create foreign key constraints) + # 2.14.1.0 * [#1612](https://github.com/yesodweb/persistent/pull/1612) diff --git a/Database/Persist/Postgresql/Internal/Migration.hs b/Database/Persist/Postgresql/Internal/Migration.hs --- a/Database/Persist/Postgresql/Internal/Migration.hs +++ b/Database/Persist/Postgresql/Internal/Migration.hs @@ -1097,80 +1097,87 @@ -> EntityDef -- ^ The entity definition for the entity that we're working on. -> Column - -- ^ The column that we're searching for potential alterations for. + -- ^ The column that we're searching for potential alterations for, derived + -- from the Persistent EntityDef. That is: this is how we _want_ the column + -- to look, and not necessarily how it actually looks in the database right + -- now. -> [Column] + -- ^ The columns for this table, as they currently exist in the database. -> ([AlterColumn], [Column]) -findAlters defs edef col@(Column name isNull sqltype def _gen _defConstraintName _maxLen ref) cols = - case List.find (\c -> cName c == name) cols of +findAlters defs edef newCol oldCols = + case List.find (\c -> cName c == cName newCol) oldCols of Nothing -> - ([AddColumn col], cols) + ([AddColumn newCol] ++ refAdd (cReference newCol), oldCols) Just - (Column _oldName isNull' sqltype' def' _gen' _defConstraintName' _maxLen' ref') -> + oldCol -> let refDrop Nothing = [] refDrop (Just ColumnReference{crConstraintName = cname}) = [DropReference cname] - refAdd Nothing = [] - refAdd (Just colRef) = - case find ((== crTableName colRef) . getEntityDBName) defs of - Just refdef - | Just _oldName /= fmap fieldDB (getEntityIdField edef) -> - [ AddReference - (crTableName colRef) - (crConstraintName colRef) - (name NEL.:| []) - (NEL.toList $ Util.dbIdColumnsEsc escapeF refdef) - (crFieldCascade colRef) - ] - Just _ -> [] - Nothing -> - error $ - "could not find the entityDef for reftable[" - ++ show (crTableName colRef) - ++ "]" modRef = - if equivalentRef ref ref' + if equivalentRef (cReference oldCol) (cReference newCol) then [] - else refDrop ref' ++ refAdd ref - modNull = case (isNull, isNull') of + else refDrop (cReference oldCol) ++ refAdd (cReference newCol) + modNull = case (cNull newCol, cNull oldCol) of (True, False) -> do - guard $ Just name /= fmap fieldDB (getEntityIdField edef) - pure (IsNull col) + guard $ Just (cName newCol) /= fmap fieldDB (getEntityIdField edef) + pure (IsNull newCol) (False, True) -> let - up = case def of + up = case cDefault newCol of Nothing -> id - Just s -> (:) (UpdateNullToValue col s) + Just s -> (:) (UpdateNullToValue newCol s) in - up [NotNull col] + up [NotNull newCol] _ -> [] modType - | sqlTypeEq sqltype sqltype' = [] + | sqlTypeEq (cSqlType newCol) (cSqlType oldCol) = [] -- When converting from Persistent pre-2.0 databases, we -- need to make sure that TIMESTAMP WITHOUT TIME ZONE is -- treated as UTC. - | sqltype == SqlDayTime && sqltype' == SqlOther "timestamp" = - [ ChangeType col sqltype $ + | cSqlType newCol == SqlDayTime && cSqlType oldCol == SqlOther "timestamp" = + [ ChangeType newCol (cSqlType newCol) $ T.concat [ " USING " - , escapeF name + , escapeF (cName newCol) , " AT TIME ZONE 'UTC'" ] ] - | otherwise = [ChangeType col sqltype ""] + | otherwise = [ChangeType newCol (cSqlType newCol) ""] modDef = - if def == def' - || isJust (T.stripPrefix "nextval" =<< def') + if cDefault newCol == cDefault oldCol + || isJust (T.stripPrefix "nextval" =<< cDefault oldCol) then [] - else case def of - Nothing -> [NoDefault col] - Just s -> [Default col s] + else case cDefault newCol of + Nothing -> [NoDefault newCol] + Just s -> [Default newCol s] dropSafe = - if safeToRemove edef name - then error "wtf" [Drop col (SafeToRemove True)] + if safeToRemove edef (cName newCol) + then error "wtf" [Drop newCol (SafeToRemove True)] else [] in ( modRef ++ modDef ++ modNull ++ modType ++ dropSafe - , filter (\c -> cName c /= name) cols + , filter (\c -> cName c /= cName newCol) oldCols ) + where + refAdd Nothing = [] + -- This check works around a bug where persistent will sometimes + -- generate an erroneous ForeignRef for ID fields. + -- See: https://github.com/yesodweb/persistent/issues/1615 + refAdd _ | fmap fieldDB (getEntityIdField edef) == Just (cName newCol) = [] + refAdd (Just colRef) = + case find ((== crTableName colRef) . getEntityDBName) defs of + Just refdef -> + [ AddReference + (crTableName colRef) + (crConstraintName colRef) + (cName newCol NEL.:| []) + (NEL.toList $ Util.dbIdColumnsEsc escapeF refdef) + (crFieldCascade colRef) + ] + Nothing -> + error $ + "could not find the entityDef for reftable[" + ++ show (crTableName colRef) + ++ "]" diff --git a/persistent-postgresql.cabal b/persistent-postgresql.cabal --- a/persistent-postgresql.cabal +++ b/persistent-postgresql.cabal @@ -1,5 +1,5 @@ name: persistent-postgresql -version: 2.14.1.0 +version: 2.14.2.0 license: MIT license-file: LICENSE author: Felipe Lessa, Michael Snoyman diff --git a/test/MigrationSpec.hs b/test/MigrationSpec.hs --- a/test/MigrationSpec.hs +++ b/test/MigrationSpec.hs @@ -60,6 +60,17 @@ promotedByUserId UserId UniquePromotedByUserId promotedByUserId + +FKParent sql=migration_fk_parent + +FKChildV1 sql=migration_fk_child + +-- Simulate creating a new FK field on an existing table +FKChildV2 sql=migration_fk_child + parentId FKParentId + +ExplicitPrimaryKey sql=explicit_primary_key + Id Text |] userEntityDef :: EntityDef @@ -77,6 +88,20 @@ adminUserEntityDef :: EntityDef adminUserEntityDef = entityDef (Proxy :: Proxy AdminUser) +fkParentEntityDef :: EntityDef +fkParentEntityDef = entityDef (Proxy :: Proxy FKParent) + +fkChildV1EntityDef :: EntityDef +fkChildV1EntityDef = entityDef (Proxy :: Proxy FKChildV1) + +fkChildV2EntityDef :: EntityDef +fkChildV2EntityDef = entityDef (Proxy :: Proxy FKChildV2) + +explicitPrimaryKeyEntityDef :: EntityDef +explicitPrimaryKeyEntityDef = entityDef (Proxy :: Proxy ExplicitPrimaryKey) + +-- Note that FKChild is deliberately omitted here because we have two +-- versions of it allEntityDefs :: [EntityDef] allEntityDefs = [ userEntityDef @@ -84,8 +109,11 @@ , passwordEntityDef , password2EntityDef , adminUserEntityDef + , fkParentEntityDef + , explicitPrimaryKeyEntityDef ] +-- Note that this function migrates to the schema expected by FKChildV1 migrateManually :: (HasCallStack, MonadIO m) => SqlPersistT m () migrateManually = do cleanDB @@ -150,6 +178,9 @@ , " ADD CONSTRAINT unique_promoted_by_user_id" , " UNIQUE(promoted_by_user_id);" ] + rawEx "CREATE TABLE migration_fk_parent(id int8 primary key);" + rawEx "CREATE TABLE migration_fk_child(id int8 primary key);" + rawEx "CREATE TABLE explicit_primary_key(id text primary key);" rawEx "CREATE TABLE ignored(id int8 primary key);" cleanDB :: (HasCallStack, MonadIO m) => SqlPersistT m () @@ -162,6 +193,9 @@ rawEx "DROP TABLE IF EXISTS ignored;" rawEx "DROP TABLE IF EXISTS admin_users;" rawEx "DROP TABLE IF EXISTS users;" + rawEx "DROP TABLE IF EXISTS migration_fk_child;" + rawEx "DROP TABLE IF EXISTS migration_fk_parent;" + rawEx "DROP TABLE IF EXISTS explicit_primary_key;" spec :: Spec spec = describe "MigrationSpec" $ do @@ -582,3 +616,27 @@ result2 <- liftIO $ migrateEntitiesStructured getter allEntityDefs allEntityDefs result2 `shouldBe` Right [] + + it "suggests FK constraints for new fields first time" $ runConnAssert $ do + migrateManually + + getter <- getStmtGetter + result <- + liftIO $ + migrateEntitiesStructured + getter + (fkChildV2EntityDef : allEntityDefs) + [fkChildV2EntityDef] + + cleanDB + + case result of + Right [] -> + pure () + Left err -> + expectationFailure $ show err + Right alters -> + map (snd . showAlterDb) alters + `shouldBe` [ "ALTER TABLE \"migration_fk_child\" ADD COLUMN \"parent_id\" INT8 NOT NULL" + , "ALTER TABLE \"migration_fk_child\" ADD CONSTRAINT \"migration_fk_child_parent_id_fkey\" FOREIGN KEY(\"parent_id\") REFERENCES \"migration_fk_parent\"(\"id\") ON DELETE RESTRICT ON UPDATE RESTRICT" + ]