dbmigrations 1.0 → 1.1
raw patch · 6 files changed
+276/−49 lines, 6 filesdep +mysqldep +mysql-simpledep +splitPVP ok
version bump matches the API change (PVP)
Dependencies added: mysql, mysql-simple, split
API changes (from Hackage documentation)
+ Database.Schema.Migrations.Backend.MySQL: mysqlBackend :: Connection -> Backend
Files
- MOO.TXT +53/−6
- dbmigrations.cabal +13/−5
- src/Database/Schema/Migrations/Backend/MySQL.hs +78/−0
- src/Moo/Core.hs +31/−1
- test/BackendTest.hs +67/−24
- test/TestDriver.hs +34/−13
MOO.TXT view
@@ -6,7 +6,7 @@ "moo", is responsible for creating, installing, and reverting migrations in your database backend. -At present, PostgreSQL and Sqlite3 are the only supported database+At present, MySQL, PostgreSQL and Sqlite3 are the only supported database backends. The moo tool works by creating migration files in a specific location,@@ -25,6 +25,42 @@ migrations is tracked by way of a migration table that is installed into your database. +WARNING TO MYSQL USERS+----------------------++If you are using this library with MySQL, beware of the following+caveat!++Unlike PostgreSQL and SQLite, MySQL does not support transactional+Data Definition Language (DDL) statements such as CREATE TABLE. Since+dbmigrations is designed around the assumption that it's useful and+important to make migrations atomic, and since most migrations will have+at least some DDL in them, this means that dbmigrations cannot make+atomicity guarantees about your migrations if you are using MySQL as+your backend. The MySQL docs have this to say:++http://dev.mysql.com/doc/refman/5.7/en/cannot-roll-back.html++This means that features like moo's "--test" flag will not do what you+expect, that mistakes in migrations will be tough to fix in development,+and that a problem in a migration in a production deployment COULD+HOSE YOUR DATABASE and BREAK RUNNING APPLICATIONS. Note that MySQL's+DDL statements cause an implicit commit, so any errors after each DDL+statement will have to be corrected by hand!++It is the author's opinion that this makes MySQL unfit for production+use and that you should strongly consider using some other backend such+as PostgreSQL which has much more robust support for transactional DDL.++You might be wondering why support for MySQL is included if it can be+so dangerous to use. Some users have requested and contributed support+for it, and of course we can't always choose to use a different backend+for preexisting systems. In those cases at least dbmigrations doesn't+make your problem any worse than it already is, provided you heed this+disclaimer. :)++You have been warned!+ Getting started --------------- @@ -34,11 +70,13 @@ directory you created in step 1. 3. Set an environment variable DBM_DATABASE_TYPE to a supported- backend. Valid values are "postgresql" and "sqlite3".+ backend. Valid values are "mysql", "postgresql" and "sqlite3". 4. Set an environment variable DBM_DATABASE to a database connection string that is appropriate for the value of DBM_DATABASE_TYPE you- chose.+ chose. The contents of this depend on the value of+ DBM_DATABASE_TYPE, see the "Environment" documentation section for+ more information. 5. Run "moo upgrade". This command will not actually install any migrations, since you have not created any, but it will attempt to@@ -195,9 +233,9 @@ DBM_DATABASE_TYPE - The type of database you'll be managing. The only supported value- at present is "postgresql". This will determine the format of- DBM_DATABASE.+ The type of database you'll be managing. Supported values+ at present are "mysql", "postgresql" and "sqlite3". This will+ determine the format of DBM_DATABASE. DBM_DATABASE @@ -216,6 +254,15 @@ The format of this value is a filesystem path to the Sqlite3 database to be used.++ DBM_DATABASE_TYPE=mysql:++ For MySQL, DBM_DATABASE should be a value of key value pairs,+ where each pair is formed by `key=value`, and each pair separated+ by a semicolon. Required keys are `host`, `user` and `database`,+ and you can optionally supply `port` and `password`.++ Example: DBM_DATABASE="host=localhost; user=root; database=cows" DBM_MIGRATION_STORE
dbmigrations.cabal view
@@ -1,5 +1,5 @@ Name: dbmigrations-Version: 1.0+Version: 1.1 Synopsis: An implementation of relational database "migrations" Description: A library and program for the creation, management, and installation of schema updates@@ -11,8 +11,9 @@ transactions for safety. This package is written to support any- HDBC-supported database, although at present only- PostgreSQL is fully supported.+ HDBC-supported database. This package supports+ SQLite, PostgreSQL, and MySQL. Please see MOO.TXT+ for warnings about MySQL! To get started, see the included 'README.md' and 'MOO.TXT' files and the usage output for the@@ -73,7 +74,10 @@ text >= 0.11, configurator >= 0.2, HDBC-postgresql,- HDBC-sqlite3+ HDBC-sqlite3,+ mysql >= 0.1.1.8,+ mysql-simple >= 0.2.2.5,+ split >= 0.2.2 Hs-Source-Dirs: src Exposed-Modules:@@ -83,6 +87,7 @@ Database.Schema.Migrations.Filesystem Database.Schema.Migrations.Backend Database.Schema.Migrations.Backend.HDBC+ Database.Schema.Migrations.Backend.MySQL Database.Schema.Migrations.Store Moo.Main Moo.CommandHandlers@@ -115,7 +120,10 @@ HUnit >= 1.2, process >= 1.1, configurator >= 0.2,- text >= 0.11+ text >= 0.11,+ mysql-simple >= 0.2.2.5,+ mysql >= 0.1.1.8,+ split >= 0.2.2 other-modules: BackendTest
+ src/Database/Schema/Migrations/Backend/MySQL.hs view
@@ -0,0 +1,78 @@+module Database.Schema.Migrations.Backend.MySQL (mysqlBackend) where++import Control.Monad (when)+import Database.MySQL.Simple+import Database.Schema.Migrations.Backend+ (Backend(..), rootMigrationName)+import Database.Schema.Migrations.Migration+ (Migration(..), newMigration)+import Data.Time.Clock (getCurrentTime)+import Data.String (fromString)+import Data.Maybe (listToMaybe)+import qualified Database.MySQL.Base as Base++mysqlBackend :: Connection -> Backend+mysqlBackend conn =+ Backend {isBootstrapped =+ fmap ((Just migrationTableName ==) . listToMaybe . fmap fromOnly)+ (query conn+ (fromString "SELECT table_name FROM information_schema.tables WHERE table_name = ? AND table_schema = database()")+ (Only migrationTableName) :: IO [Only String])+ ,getBootstrapMigration =+ do ts <- getCurrentTime+ return ((newMigration rootMigrationName) {mApply = createSql+ ,mRevert =+ Just revertSql+ ,mDesc =+ Just "Migration table installation"+ ,mTimestamp = Just ts})+ ,applyMigration =+ \m ->+ do execute_ conn (fromString (mApply m))+ discardResults conn+ execute conn+ (fromString+ ("INSERT INTO " +++ migrationTableName +++ " (migration_id) VALUES (?)"))+ (Only (mId m))+ return ()+ ,revertMigration =+ \m ->+ do case mRevert m of+ Nothing -> return ()+ Just sql ->+ do execute_ conn (fromString sql)+ return ()+ discardResults conn+ -- Remove migration from installed_migrations in either case.+ execute+ conn+ (fromString+ ("DELETE FROM " +++ migrationTableName ++ " WHERE migration_id = ?"))+ (Only (mId m))+ return ()+ ,getMigrations =+ do results <-+ query_ conn+ (fromString+ ("SELECT migration_id FROM " ++ migrationTableName))+ return (map fromOnly results)+ ,commitBackend = commit conn+ ,rollbackBackend = rollback conn+ ,disconnectBackend = close conn}++discardResults :: Connection -> IO ()+discardResults conn =+ do more <- Base.nextResult conn+ when more (discardResults conn)++migrationTableName :: String+migrationTableName = "installed_migrations"++createSql :: String+createSql = "CREATE TABLE " ++ migrationTableName ++ " (migration_id TEXT)"++revertSql :: String+revertSql = "DROP TABLE " ++ migrationTableName
src/Moo/Core.hs view
@@ -14,6 +14,8 @@ , envStoreName , loadConfiguration) where +import Data.List.Split (wordsBy)+import Data.Char (isSpace) import Control.Applicative ((<$>), (<*>)) import Control.Monad.Reader (ReaderT) import qualified Data.Configurator as C@@ -24,12 +26,14 @@ import Database.HDBC.Sqlite3 (connectSqlite3) import System.Environment (getEnvironment) import Data.Maybe (isJust, fromMaybe)-+import qualified Database.MySQL.Simple as MySQL+import qualified Database.MySQL.Base as MySQLB import Database.Schema.Migrations () import Database.Schema.Migrations.Store (MigrationStore, StoreData) import Database.Schema.Migrations.Backend import Database.Schema.Migrations.Backend.HDBC+import Database.Schema.Migrations.Backend.MySQL -- |The monad in which the application runs. type AppT a = ReaderT AppState IO a@@ -180,7 +184,33 @@ databaseTypes :: [(String, String -> IO Backend)] databaseTypes = [ ("postgresql", fmap hdbcBackend . connectPostgreSQL) , ("sqlite3", fmap hdbcBackend . connectSqlite3)+ , ("mysql", fmap mysqlBackend . connectMySQL) ]++-- A slightly hacky connection string parser for MySQL, because mysql-simple+-- doesn't come with one.+connectMySQL :: String -> IO MySQL.Connection+connectMySQL connectionString =+ let kvs =+ [(map toLower (trimlr k),trimlr v) | kvPair <-+ wordsBy (== ';') connectionString :: [String]+ , let (k,v) = case wordsBy (== '=') kvPair of+ (k:v:_) -> (k,v)+ [k] -> (k,"")+ [] -> error "impossible"]+ trimlr = takeWhile (not . isSpace) . dropWhile isSpace+ connInfo =+ MySQL.ConnectInfo+ <$> lookup "host" kvs+ <*> pure (read (fromMaybe "3306" (lookup "port" kvs)))+ <*> lookup "user" kvs+ <*> pure (fromMaybe "" (lookup "password" kvs))+ <*> lookup "database" kvs+ <*> pure [MySQLB.MultiStatements]+ <*> pure ""+ <*> pure Nothing+ in MySQL.connect (fromMaybe (error "Invalid connection string. Expected form: host=hostname; user=username; port=portNumber; database=dbname; password=pwd.")+ connInfo) envDatabaseType :: String envDatabaseType = "DBM_DATABASE_TYPE"
test/BackendTest.hs view
@@ -1,15 +1,58 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+ module BackendTest where import Test.HUnit+import Control.Exception (Handler(..), catches) import Control.Monad ( forM_ ) -import Database.Schema.Migrations.Backend.HDBC+import Database.Schema.Migrations.Backend.HDBC (hdbcBackend)+import Database.Schema.Migrations.Backend.MySQL import Database.Schema.Migrations.Migration ( Migration(..), newMigration ) import Database.Schema.Migrations.Backend ( Backend(..) ) -import Database.HDBC ( IConnection(..), catchSql, withTransaction )+import qualified Database.HDBC as HDBC+import qualified Database.MySQL.Simple as MySQL+import qualified Database.MySQL.Base as MySQL -tests :: (IConnection a) => a -> IO ()+data BackendConnection+ = forall a. HDBC.IConnection a => HDBCConnection a+ | MySQLConnection MySQL.Connection++migrationBackend :: BackendConnection -> Backend+migrationBackend (HDBCConnection c) = hdbcBackend c+migrationBackend (MySQLConnection c) = mysqlBackend c++commit :: BackendConnection -> IO ()+commit (HDBCConnection c) = HDBC.commit c+commit (MySQLConnection c) = MySQL.commit c++getTables :: BackendConnection -> IO [String]+getTables (HDBCConnection c) = HDBC.getTables c+getTables (MySQLConnection c) =+ fmap (map MySQL.fromOnly)+ (MySQL.query_ c "SHOW TABLES")++catchSql_ :: IO a -> IO a -> IO a+catchSql_ act handler =+ act `catches`+ [Handler (\(_ :: MySQL.FormatError) -> handler)+ ,Handler (\(_ :: MySQL.QueryError) -> handler)+ ,Handler (\(_ :: MySQL.MySQLError) -> handler)+ ,Handler (\(_ :: MySQL.ResultError) -> handler)+ ,Handler (\(_ :: HDBC.SqlError) -> handler)]++withTransaction+ :: BackendConnection -> (BackendConnection -> IO a) -> IO a+withTransaction (HDBCConnection c) transaction =+ HDBC.withTransaction c+ (transaction . HDBCConnection)+withTransaction (MySQLConnection c) transaction =+ MySQL.withTransaction c+ (transaction (MySQLConnection c))+tests :: BackendConnection -> IO () tests conn = do let acts = [ isBootstrappedFalseTest , bootstrapTest@@ -24,52 +67,52 @@ commit conn act conn -bootstrapTest :: (IConnection a) => a -> IO ()+bootstrapTest :: BackendConnection -> IO () bootstrapTest conn = do- let backend = hdbcBackend conn+ let backend = migrationBackend conn bs <- getBootstrapMigration backend applyMigration backend bs assertEqual "installed_migrations table exists" ["installed_migrations"] =<< getTables conn assertEqual "successfully bootstrapped" [mId bs] =<< getMigrations backend -isBootstrappedTrueTest :: (IConnection a) => a -> IO ()+isBootstrappedTrueTest :: BackendConnection -> IO () isBootstrappedTrueTest conn = do- result <- isBootstrapped $ hdbcBackend conn+ result <- isBootstrapped $ migrationBackend conn assertBool "Bootstrapped check" result -isBootstrappedFalseTest :: (IConnection a) => a -> IO ()+isBootstrappedFalseTest :: BackendConnection -> IO () isBootstrappedFalseTest conn = do- result <- isBootstrapped $ hdbcBackend conn+ result <- isBootstrapped $ migrationBackend conn assertBool "Bootstrapped check" $ not result ignoreSqlExceptions :: IO a -> IO (Maybe a)-ignoreSqlExceptions act = (act >>= return . Just) `catchSql`- (\_ -> return Nothing)+ignoreSqlExceptions act = (act >>= return . Just) `catchSql_`+ (return Nothing) -applyMigrationSuccess :: (IConnection a) => a -> IO ()+applyMigrationSuccess :: BackendConnection -> IO () applyMigrationSuccess conn = do- let backend = hdbcBackend conn+ let backend = migrationBackend conn let m1 = (newMigration "validMigration") { mApply = "CREATE TABLE valid1 (a int); CREATE TABLE valid2 (a int);" } -- Apply the migrations, ignore exceptions- withTransaction conn $ \conn' -> applyMigration (hdbcBackend conn') m1+ withTransaction conn $ \conn' -> applyMigration (migrationBackend conn') m1 -- Check that none of the migrations were installed assertEqual "Installed migrations" ["root", "validMigration"] =<< getMigrations backend assertEqual "Installed tables" ["installed_migrations", "valid1", "valid2"] =<< getTables conn -- |Does a failure to apply a migration imply a transaction rollback?-applyMigrationFailure :: (IConnection a) => a -> IO ()+applyMigrationFailure :: BackendConnection -> IO () applyMigrationFailure conn = do- let backend = hdbcBackend conn+ let backend = migrationBackend conn let m1 = (newMigration "second") { mApply = "CREATE TABLE validButTemporary (a int)" } m2 = (newMigration "third") { mApply = "INVALID SQL" } -- Apply the migrations, ignore exceptions ignoreSqlExceptions $ withTransaction conn $ \conn' -> do- let backend' = hdbcBackend conn'+ let backend' = migrationBackend conn' applyMigration backend' m1 applyMigration backend' m2 @@ -77,9 +120,9 @@ assertEqual "Installed migrations" ["root"] =<< getMigrations backend assertEqual "Installed tables" ["installed_migrations"] =<< getTables conn -revertMigrationFailure :: (IConnection a) => a -> IO ()+revertMigrationFailure :: BackendConnection -> IO () revertMigrationFailure conn = do- let backend = hdbcBackend conn+ let backend = migrationBackend conn let m1 = (newMigration "second") { mApply = "CREATE TABLE validRMF (a int)" , mRevert = Just "DROP TABLE validRMF"}@@ -96,7 +139,7 @@ -- Revert the migrations, ignore exceptions; the revert will fail, -- but withTransaction will roll back. ignoreSqlExceptions $ withTransaction conn $ \conn' -> do- let backend' = hdbcBackend conn'+ let backend' = migrationBackend conn' revertMigration backend' m2 revertMigration backend' m1 @@ -104,9 +147,9 @@ assertEqual "successfully roll back failed revert" installedBeforeRevert =<< getMigrations backend -revertMigrationNothing :: (IConnection a) => a -> IO ()+revertMigrationNothing :: BackendConnection -> IO () revertMigrationNothing conn = do- let backend = hdbcBackend conn+ let backend = migrationBackend conn let m1 = (newMigration "second") { mApply = "SELECT 1" , mRevert = Nothing }@@ -123,10 +166,10 @@ installed <- getMigrations backend assertBool "Check that the migration was reverted" $ not $ "second" `elem` installed -revertMigrationJust :: (IConnection a) => a -> IO ()+revertMigrationJust :: BackendConnection -> IO () revertMigrationJust conn = do let name = "revertable"- backend = hdbcBackend conn+ backend = migrationBackend conn let m1 = (newMigration name) { mApply = "CREATE TABLE the_test_table (a int)" , mRevert = Just "DROP TABLE the_test_table" }
test/TestDriver.hs view
@@ -17,22 +17,27 @@ import qualified ConfigurationTest import Control.Monad ( forM )-import Control.Exception ( finally, catch, SomeException )+import Control.Exception ( finally, catch, try, SomeException(..) )+import Data.String (fromString) import Database.HDBC ( IConnection(disconnect) ) import Database.HDBC.Sqlite3 ( connectSqlite3 ) import qualified Database.HDBC.PostgreSQL as PostgreSQL+import qualified Database.MySQL.Simple as MySQL loadTests :: IO [Test] loadTests = do sqliteConn <- connectSqlite3 ":memory:"- pgConn <- setupPostgresDb+ --pgConn <- setupPostgresDb+ mysqlConn <- setupMySQLDb - let backends = [ ("Sqlite", (BackendTest.tests sqliteConn) `finally`+ let backends = [ ("Sqlite", (BackendTest.tests (BackendTest.HDBCConnection sqliteConn)) `finally` (disconnect sqliteConn))- , ("PostgreSQL", (BackendTest.tests pgConn) `finally`- (disconnect pgConn >> teardownPostgresDb))+ -- , ("PostgreSQL", (BackendTest.tests (BackendTest.HDBCConnection pgConn)) `finally`+ -- (disconnect pgConn >> teardownPostgresDb))+ , ("MySQL", (BackendTest.tests (BackendTest.MySQLConnection mysqlConn)) `finally`+ (MySQL.close mysqlConn >> teardownMySQLDb)) ] backendTests <- forM backends $ \(name, testAct) -> do@@ -56,8 +61,8 @@ , StoreTest.tests ] -tempPgDatabase :: String-tempPgDatabase = "dbmigrations_test"+tempDatabase :: String+tempDatabase = "dbmigrations_test" ignoreException :: SomeException -> IO () ignoreException _ = return ()@@ -67,21 +72,37 @@ teardownPostgresDb `catch` ignoreException -- create database- status <- system $ "createdb " ++ tempPgDatabase+ status <- system $ "createdb " ++ tempDatabase case status of ExitSuccess -> return ()- ExitFailure _ -> error $ "Failed to create PostgreSQL database " ++ (show tempPgDatabase)+ ExitFailure _ -> error $ "Failed to create PostgreSQL database " ++ (show tempDatabase) -- return test db connection- PostgreSQL.connectPostgreSQL $ "dbname=" ++ tempPgDatabase+ PostgreSQL.connectPostgreSQL $ "dbname=" ++ tempDatabase teardownPostgresDb :: IO () teardownPostgresDb = do- -- create database- status <- system $ "dropdb " ++ tempPgDatabase ++ " 2>/dev/null"+ -- drop database+ status <- system $ "dropdb " ++ tempDatabase ++ " 2>/dev/null" case status of ExitSuccess -> return ()- ExitFailure _ -> error $ "Failed to drop PostgreSQL database " ++ (show tempPgDatabase)+ ExitFailure _ -> error $ "Failed to drop PostgreSQL database " ++ (show tempDatabase)++setupMySQLDb :: IO MySQL.Connection+setupMySQLDb = do+ teardownMySQLDb `catch` ignoreException+ conn <- MySQL.connect MySQL.defaultConnectInfo+ MySQL.execute_ conn (fromString ("CREATE DATABASE " ++ tempDatabase))+ MySQL.execute_ conn (fromString ("USE " ++ tempDatabase))+ pure conn++teardownMySQLDb :: IO ()+teardownMySQLDb = do+ conn <- MySQL.connect MySQL.defaultConnectInfo+ e <- try (MySQL.execute_ conn (fromString ("DROP DATABASE " ++ tempDatabase)))+ case e of+ Left ex@SomeException{} -> error ("Failed to drop test MySQL database: " ++ show ex)+ Right _ -> return () main :: IO () main = do