Primary Key Migration Woes

persistent-mysql/test/main.hs

@@ -34,6 +34,7 @@ import qualified LargeNumberTest
 import qualified MaxLenTest
 import qualified MigrationColumnLengthTest
 import qualified MigrationIdempotencyTest
+import qualified MigrationTest
 import qualified MigrationOnlyTest
 import qualified MpsNoPrefixTest
 import qualified MpsCustomPrefixTest
@@ -167,6 +168,7 @@ main = do
     MaxLenTest.specsWith db
     Recursive.specsWith db
     SumTypeTest.specsWith db (Just (runMigrationSilent SumTypeTest.sumTypeMigrate))
+    MigrationTest.specsWith db
     MigrationOnlyTest.specsWith db
         (Just
             $ runMigrationSilent MigrationOnlyTest.migrateAll1

persistent-postgresql/test/main.hs

@@ -38,6 +38,7 @@ import qualified MigrationColumnLengthTest
 import qualified MigrationTest
 import qualified MigrationOnlyTest
 import qualified MpsNoPrefixTest
+import qualified MigrationTest
 import qualified MpsCustomPrefixTest
 import qualified PersistentTest
 import qualified PersistUniqueTest
@@ -154,18 +155,16 @@ main = do
     HtmlTest.specsWith
         runConnAssert
         (Just (runMigrationSilent HtmlTest.htmlMigrate))
-
-    EmbedTest.specsWith runConnAssert
     EmbedOrderTest.specsWith runConnAssert
-    LargeNumberTest.specsWith runConnAssert
+    EmbedTest.specsWith runConnAssert
     ForeignKey.specsWith runConnAssert
-    UniqueTest.specsWith runConnAssert
+    LargeNumberTest.specsWith runConnAssert
     MaxLenTest.specsWith runConnAssert
+    MigrationOnlyTest.specsWith runConnAssert
+    MigrationTest.specsWith runConnAssert
     Recursive.specsWith runConnAssert
     SumTypeTest.specsWith runConnAssert (Just (runMigrationSilent SumTypeTest.sumTypeMigrate))
-    MigrationTest.specsWith runConnAssert
-    MigrationOnlyTest.specsWith runConnAssert
-
+    UniqueTest.specsWith runConnAssert
         (Just
             $ runMigrationSilent MigrationOnlyTest.migrateAll1
             >> runMigrationSilent MigrationOnlyTest.migrateAll2

persistent-test/src/MigrationTest.hs

@@ -18,6 +18,10 @@ Source
     field3 Int
     field4 TargetId
 
+PreUnique sql=pre_unique
+    field5 Int
+    field6 T.Text
+
 CustomSqlId
     pk      Int   sql=id
     Primary pk
@@ -34,22 +38,67 @@ Source1 sql=source
     field3 Int
     extra  Int
     field4 Target1Id
+
 |]
 
-specsWith :: (MonadUnliftIO m) => RunDb SqlBackend m -> Spec
-specsWith runDb = describe "Migration" $ do
+share [mkPersist sqlSettings, mkMigrate "addPrimKey", mkDeleteCascade sqlSettings] [persistLowerCase|
+FromRawMigration
+    name T.Text
+    age  Int
+
+    Primary name
+|]
+
+share [mkPersist sqlSettings, mkMigrate "addUniqKey", mkDeleteCascade sqlSettings] [persistLowerCase|
+
+PostUnique sql=pre_unique
+    field5 Int
+    field6 T.Text
+
+    UniquField5 field5
+
+|]
+
+dropTables :: MonadIO m => SqlPersistT m ()
+dropTables = do
+    rawExecute "DROP TABLE IF EXISTS source" []
+    rawExecute "DROP TABLE IF EXISTS target" []
+    rawExecute "DROP TABLE IF EXISTS pre_unique" []
+    rawExecute "DROP TABLE IF EXISTS from_raw_migration" []
+
+specsWith :: (MonadIO m, MonadFail m) => RunDb SqlBackend m -> Spec
+specsWith runDb = describe "Migration" $ before_ (runDb dropTables) $ do
     it "is idempotent" $ runDb $ do
-      again <- getMigration migrationMigrate
-      liftIO $ again @?= []
-    it "really is idempotent" $ runDb $ do
-      runMigrationSilent migrationMigrate
-      runMigrationSilent migrationMigrate
-      again <- getMigration migrationMigrate
-      liftIO $ again @?= []
+        _ <- runMigration migrationMigrate
+        again <- getMigration migrationMigrate
+        liftIO $ again @?= []
     it "can add an extra column" $ runDb $ do
-      -- Failing test case for #735.  Foreign-key checking, switched on in
-      -- version 2.6.1, caused persistent-sqlite to generate a `references`
-      -- constraint in a *temporary* table during migration, which fails.
-      _ <- runMigrationSilent migrationAddCol
-      again <- getMigration migrationAddCol
-      liftIO $ again @?= []
+        -- Failing test case for #735.  Foreign-key checking, switched on in
+        -- version 2.6.1, caused persistent-sqlite to generate a `references`
+        -- constraint in a *temporary* table during migration, which fails.
+        _ <- runMigration migrationMigrate
+        _ <- runMigration migrationAddCol
+        again <- getMigration migrationAddCol
+        liftIO $ again @?= []
+    describe "Add Unique Key constraint" $ do
+        it "should not be considered safe" $ runDb $ do
+            _ <- runMigration migrationMigrate
+            Right migration <- parseMigration addUniqKey
+            liftIO $ migration
+                `shouldSatisfy`
+                    (\cm -> True `elem` map fst cm)
+
+    xdescribe "Add Primary key constraint on raw table" $ do
+        it "should not be considered safe" $ runDb $ do
+            rawExecute "CREATE TABLE from_raw_migration (name VARCHAR NOT NULL, age INT8 NOT NULL)" []
+            Right migration <- parseMigration addPrimKey
+            liftIO $ migration
+                `shouldSatisfy`
+                    (\cm -> True `elem` map fst cm)
+
+        it "works" $ runDb $ do
+            rawExecute "CREATE TABLE from_raw_migration (name VARCHAR NOT NULL, age INT NOT NULL)" []
+            Right migration <- parseMigration addPrimKey
+            () <- runMigration addPrimKey
+            again <- getMigration addPrimKey
+            liftIO $ again @?= []