Merge pull request #736 from paul-rouse/sqlite-735

Sqlite: do not add foreign key constraints to temporary tables
yesodweb · Nov 24, 2017 · 0f1f552 · 0f1f552
2 parents b510404 + e385fdf
commit 0f1f552
Show file tree

Hide file tree

Showing 5 changed files with 36 additions and 6 deletions.
diff --git a/persistent-sqlite/ChangeLog.md b/persistent-sqlite/ChangeLog.md
@@ -1,3 +1,7 @@
+## 2.6.3.1
+
+* Fix migration to avoid creating foreign-key constraints in temporary tables [#736](https://github.com/yesodweb/persistent/pull/736)
+
 ## 2.6.3
 
 * Add 'use-pkgconfig' flag to use pkg-config to find system SQLite library.

diff --git a/persistent-sqlite/Database/Persist/Sqlite.hs b/persistent-sqlite/Database/Persist/Sqlite.hs
@@ -429,7 +429,7 @@ mkCreateTable isTemp entity (cols, uniqs) =
         , " TABLE "
         , escape $ entityDB entity
         , "("
-        , T.drop 1 $ T.concat $ map sqlColumn cols
+        , T.drop 1 $ T.concat $ map (sqlColumn isTemp) cols
         , ", PRIMARY KEY "
         , "("
         , T.intercalate "," $ map (escape . fieldDB) $ compositeFields pdef
@@ -447,7 +447,7 @@ mkCreateTable isTemp entity (cols, uniqs) =
         , showSqlType $ fieldSqlType $ entityId entity
         ," PRIMARY KEY"
         , mayDefault $ defaultAttribute $ fieldAttrs $ entityId entity
-        , T.concat $ map sqlColumn cols
+        , T.concat $ map (sqlColumn isTemp) cols
         , T.concat $ map sqlUnique uniqs
         , ")"
         ]
@@ -457,8 +457,8 @@ mayDefault def = case def of
     Nothing -> ""
     Just d -> " DEFAULT " <> d
 
-sqlColumn :: Column -> Text
-sqlColumn (Column name isNull typ def _cn _maxLen ref) = T.concat
+sqlColumn :: Bool -> Column -> Text
+sqlColumn noRef (Column name isNull typ def _cn _maxLen ref) = T.concat
     [ ","
     , escape name
     , " "
@@ -467,7 +467,7 @@ sqlColumn (Column name isNull typ def _cn _maxLen ref) = T.concat
     , mayDefault def
     , case ref of
         Nothing -> ""
-        Just (table, _) -> " REFERENCES " <> escape table
+        Just (table, _) -> if noRef then "" else " REFERENCES " <> escape table
     ]
 
 sqlUnique :: UniqueDef -> Text

diff --git a/persistent-sqlite/persistent-sqlite.cabal b/persistent-sqlite/persistent-sqlite.cabal
@@ -1,5 +1,5 @@
 name:            persistent-sqlite
-version:         2.6.3
+version:         2.6.3.1
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <[email protected]>

diff --git a/persistent-test/persistent-test.cabal b/persistent-test/persistent-test.cabal
@@ -187,6 +187,8 @@ executable persistent-test
                  , resourcet
                  , scientific
 
+  if !flag(postgresql) && !flag(mysql) && !flag(mongodb) && !flag(zookeeper)
+      cpp-options: -DWITH_SQLITE -DDEBUG
   if flag(zookeeper)
       cpp-options: -DWITH_NOSQL -DWITH_ZOOKEEPER -DDEBUG
   if flag(mongodb)

diff --git a/persistent-test/src/MigrationTest.hs b/persistent-test/src/MigrationTest.hs
@@ -25,6 +25,23 @@ Source
     field4 TargetId
 |]
 
+#ifdef WITH_NOSQL
+mkPersist persistSettings [persistUpperCase|
+#else
+share [mkPersist sqlSettings, mkMigrate "migrationAddCol", mkDeleteCascade sqlSettings] [persistLowerCase|
+#endif
+Target1 sql=target
+    field1 Int
+    field2 T.Text
+    UniqueTarget1 field1 field2
+    deriving Eq Show
+
+Source1 sql=source
+    field3 Int
+    extra  Int
+    field4 Target1Id
+|]
+
 #ifndef WITH_NOSQL
 specs :: Spec
 specs = describe "Migration" $ do
@@ -35,4 +52,11 @@ specs = describe "Migration" $ do
       runMigration migrationMigrate
       again <- getMigration migrationMigrate
       liftIO $ again @?= []
+    it "can add an extra column" $ db $ 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 @?= []
 #endif