From 37d2d252e41416a309bb9b4b2ab48943cb1c616f Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Mon, 13 May 2019 11:30:05 -0600
Subject: [PATCH] what

---
 persistent-mysql/test/main.hs        |  2 ++
 persistent-postgresql/test/main.hs   |  2 ++
 persistent-test/src/MigrationTest.hs | 49 ++++++++++++++++++++--------
 3 files changed, 40 insertions(+), 13 deletions(-)

diff --git a/persistent-mysql/test/main.hs b/persistent-mysql/test/main.hs
index c3c2d4a41..d2cebfaf8 100644
--- a/persistent-mysql/test/main.hs
+++ b/persistent-mysql/test/main.hs
@@ -31,6 +31,7 @@ import qualified LargeNumberTest
 import qualified MaxLenTest
 import qualified MigrationColumnLengthTest
 import qualified MigrationIdempotencyTest
+import qualified MigrationTest
 import qualified MigrationOnlyTest
 import qualified MpsNoPrefixTest
 import qualified PersistentTest
@@ -153,6 +154,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
diff --git a/persistent-postgresql/test/main.hs b/persistent-postgresql/test/main.hs
index ce95a7cf0..fc3a450ed 100644
--- a/persistent-postgresql/test/main.hs
+++ b/persistent-postgresql/test/main.hs
@@ -34,6 +34,7 @@ import qualified MaxLenTest
 import qualified MigrationColumnLengthTest
 import qualified MigrationOnlyTest
 import qualified MpsNoPrefixTest
+import qualified MigrationTest
 import qualified PersistentTest
 import qualified PersistUniqueTest
 import qualified PrimaryTest
@@ -146,6 +147,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
diff --git a/persistent-test/src/MigrationTest.hs b/persistent-test/src/MigrationTest.hs
index 31a7d5e29..dc81fae20 100644
--- a/persistent-test/src/MigrationTest.hs
+++ b/persistent-test/src/MigrationTest.hs
@@ -17,6 +17,7 @@ Target
 Source
     field3 Int
     field4 TargetId
+
 |]
 
 share [mkPersist sqlSettings, mkMigrate "migrationAddCol", mkDeleteCascade sqlSettings] [persistLowerCase|
@@ -30,21 +31,43 @@ Source1 sql=source
     field3 Int
     extra  Int
     field4 Target1Id
+
 |]
 
-specsWith :: (MonadIO m) => RunDb SqlBackend m -> Spec
+share [mkPersist sqlSettings, mkMigrate "addPrimKey", mkDeleteCascade sqlSettings] [persistLowerCase|
+FromRawMigration
+    name T.Text
+    age  Int
+
+    Primary name
+
+|]
+
+specsWith :: (MonadIO m, MonadFail m) => RunDb SqlBackend m -> Spec
 specsWith runDb = describe "Migration" $ do
     it "is idempotent" $ runDb $ do
-      again <- getMigration migrationMigrate
-      liftIO $ again @?= []
-    it "really is idempotent" $ runDb $ do
-      runMigration migrationMigrate
-      again <- getMigration migrationMigrate
-      liftIO $ again @?= []
+        _ <- runMigration migrateionMigrate
+        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.
-      _ <- runMigration 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 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 @?= []