module Database.Schema.Migrations.Test.BackendTest
( BackendConnection (..)
, tests
) where
import Control.Monad ( forM_ )
import Test.HUnit
import Database.Schema.Migrations.Migration ( Migration(..), newMigration )
import Database.Schema.Migrations.Backend ( Backend(..) )
class BackendConnection c where
supportsTransactionalDDL :: c -> Bool
commit :: c -> IO ()
withTransaction :: c -> (c -> IO a) -> IO a
getTables :: c -> IO [String]
catchAll :: c -> (IO a -> IO a -> IO a)
makeBackend :: c -> Backend
testSuite :: BackendConnection bc => Bool -> [bc -> IO ()]
testSuite transactDDL =
[ isBootstrappedFalseTest
, bootstrapTest
, isBootstrappedTrueTest
, if transactDDL then applyMigrationFailure else (const $ return ())
, applyMigrationSuccess
, revertMigrationFailure
, revertMigrationNothing
, revertMigrationJust
]
tests :: BackendConnection bc => bc -> IO ()
tests conn = do
let acts = testSuite $ supportsTransactionalDDL conn
forM_ acts $ \act -> do
commit conn
act conn
bootstrapTest :: BackendConnection bc => bc -> IO ()
bootstrapTest conn = do
let backend = makeBackend conn
bs <- getBootstrapMigration backend
applyMigration backend bs
assertEqual "installed_migrations table exists" ["installed_migrations"] =<< getTables conn
assertEqual "successfully bootstrapped" [mId bs] =<< getMigrations backend
isBootstrappedTrueTest :: BackendConnection bc => bc -> IO ()
isBootstrappedTrueTest conn = do
result <- isBootstrapped $ makeBackend conn
assertBool "Bootstrapped check" result
isBootstrappedFalseTest :: BackendConnection bc => bc -> IO ()
isBootstrappedFalseTest conn = do
result <- isBootstrapped $ makeBackend conn
assertBool "Bootstrapped check" $ not result
ignoreSqlExceptions :: BackendConnection bc => bc -> IO a -> IO (Maybe a)
ignoreSqlExceptions conn act =
(catchAll conn)
(act >>= return . Just)
(return Nothing)
applyMigrationSuccess :: BackendConnection bc => bc -> IO ()
applyMigrationSuccess conn = do
let backend = makeBackend conn
let m1 = (newMigration "validMigration") { mApply = "CREATE TABLE valid1 (a int)" }
withTransaction conn $ \conn' -> applyMigration (makeBackend conn') m1
assertEqual "Installed migrations" ["root", "validMigration"] =<< getMigrations backend
assertEqual "Installed tables" ["installed_migrations", "valid1"] =<< getTables conn
applyMigrationFailure :: BackendConnection bc => bc -> IO ()
applyMigrationFailure conn = do
let backend = makeBackend conn
let m1 = (newMigration "second") { mApply = "CREATE TABLE validButTemporary (a int)" }
m2 = (newMigration "third") { mApply = "INVALID SQL" }
ignoreSqlExceptions conn $ withTransaction conn $ \conn' -> do
let backend' = makeBackend conn'
applyMigration backend' m1
applyMigration backend' m2
assertEqual "Installed migrations" ["root"] =<< getMigrations backend
assertEqual "Installed tables" ["installed_migrations"] =<< getTables conn
revertMigrationFailure :: BackendConnection bc => bc -> IO ()
revertMigrationFailure conn = do
let backend = makeBackend conn
let m1 = (newMigration "second") { mApply = "CREATE TABLE validRMF (a int)"
, mRevert = Just "DROP TABLE validRMF"}
m2 = (newMigration "third") { mApply = "alter table validRMF add column b int"
, mRevert = Just "INVALID REVERT SQL"}
applyMigration backend m1
applyMigration backend m2
installedBeforeRevert <- getMigrations backend
commitBackend backend
ignoreSqlExceptions conn $ withTransaction conn $ \conn' -> do
let backend' = makeBackend conn'
revertMigration backend' m2
revertMigration backend' m1
assertEqual "successfully roll back failed revert" installedBeforeRevert
=<< getMigrations backend
revertMigrationNothing :: BackendConnection bc => bc -> IO ()
revertMigrationNothing conn = do
let backend = makeBackend conn
let m1 = (newMigration "second") { mApply = "create table revert_nothing (a int)"
, mRevert = Nothing }
applyMigration backend m1
installedAfterApply <- getMigrations backend
assertBool "Check that the migration was applied" $ "second" `elem` installedAfterApply
revertMigration backend m1
installed <- getMigrations backend
assertBool "Check that the migration was reverted" $ not $ "second" `elem` installed
revertMigrationJust :: BackendConnection bc => bc -> IO ()
revertMigrationJust conn = do
let name = "revertable"
backend = makeBackend conn
let m1 = (newMigration name) { mApply = "CREATE TABLE the_test_table (a int)"
, mRevert = Just "DROP TABLE the_test_table" }
applyMigration backend m1
installedAfterApply <- getMigrations backend
assertBool "Check that the migration was applied" $ name `elem` installedAfterApply
revertMigration backend m1
installed <- getMigrations backend
assertBool "Check that the migration was reverted" $ not $ name `elem` installed