postgresql-simple-migration (empty) → 0.1.0.0
raw patch · 10 files changed
+530/−0 lines, 10 filesdep +basedep +base64-bytestringdep +bytestringsetup-changed
Dependencies added: base, base64-bytestring, bytestring, cryptohash, directory, hspec, postgresql-simple, postgresql-simple-migration
Files
- License +30/−0
- Readme.markdown +109/−0
- Setup.lhs +2/−0
- postgresql-simple-migration.cabal +69/−0
- share/test/script.sql +1/−0
- share/test/scripts/1.sql +1/−0
- src/Database/PostgreSQL/Simple/Migration.hs +166/−0
- src/Main.hs +63/−0
- test/Database/PostgreSQL/Simple/MigrationTest.hs +69/−0
- test/Main.hs +20/−0
+ License view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Andreas Meingast <ameingast@gmail.com>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Readme.markdown view
@@ -0,0 +1,109 @@+# PostgreSQL Migrations for Haskell++[](https://travis-ci.org/ameingast/postgresql-simple-migration)++Welcome to postgresql-simple-migrations, a tool for helping you with+PostgreSQL schema migrations.++This project is an open-source database migration tool. It favors simplicity+over configuration.++It is implemented in Haskell and uses the (excellent) postgresql-simple+library to communicate with PostgreSQL.++It comes in two flavors: a library that features an easy to use Haskell+API and as a standalone application.++Database migrations can be written in SQL (in this case PostgreSQL-sql)+or in Haskell.++## Why?+Database migrations should not be hard. They should be under version control+and documented in both your production systems and in your project files.++## What?+This library executes SQL/Haskell migration scripts and keeps track of their+meta information.++Scripts are be executed exactly once and any changes to scripts will cause+a run-time error notifying you of a corrupted database.++The meta information consists of:+* an MD5 checksum of the executed script to make sure already existing+ scripts cannot be modified in your production system.+* a time-stamp of the date of execution so you can easily track when a change+ happened.++## How?+This utility can be used in two ways: embedded in your Haskell program or as+a standalone binary.++### Standalone+The standalone program supports file-based migrations. To execute all SQL-files+in a directory $BASE\_DIR, execute the following command to initialize the database+in a first step.++```bash+CON="host=$host dbname=$db user=$user password=$pw"+./dist/build/migrate/migrate init $CON+./dist/build/migrate/migrate migrate $CON $BASE_DIR+```++For more information about the PostgreSQL connection string, see:+[libpq-connect](http://www.postgresql.org/docs/9.3/static/libpq-connect.html).++### Library+The library supports more actions than the standalone program.++Initializing the database:++```haskell+main :: IO ()+main = do+ let url = "host=$host dbname=$db user=$user password=$pw"+ con <- connectPostgreSQL (BS8.pack url)+ void $ runMigration $ MigrationContext MigrationInitialization True con+```++For file-based migrations, the following snippet can be used:++```haskell+main :: IO ()+main = do+ let url = "host=$host dbname=$db user=$user password=$pw"+ let dir = "."+ con <- connectPostgreSQL (BS8.pack url)+ void $ runMigration $ MigrationContext (MigrationDirectory dir) True con+```++To run Haskell-based migrations, use this:++```haskell+main :: IO ()+main = do+ let url = "host=$host dbname=$db user=$user password=$pw"+ let name = "my script"+ let script = "create table users (email varchar not null)";+ con <- connectPostgreSQL (BS8.pack url)+ void $ runMigration $ MigrationContext (MigrationScript name script) True con+```++## Compilation and Tests+The program is built with the _cabal_ build system. The following command+builds the library, the standalone binary and the test package.++```bash+cabal configure --enable-tests && cabal build -j+```++To execute the tests, you need a running PostgreSQL server with an empty+database called _test_. Tests are executed through cabal as follows:++```bash+cabal configure --enable-tests && cabal test+```++## To Do+* Collect executed scripts and check if already executed scripts have been+ deleted.+* Validate command for the standalone program.
+ Setup.lhs view
@@ -0,0 +1,2 @@+> import Distribution.Simple+> main = defaultMain
+ postgresql-simple-migration.cabal view
@@ -0,0 +1,69 @@+name: postgresql-simple-migration+version: 0.1.0.0+synopsis: PostgreSQL Schema Migrations+homepage: https://github.com/ameingast/postgresql-simple-migration+Bug-reports: https://github.com/ameingast/postgresql-simple-migration/issues+license: BSD3+license-file: License+author: Andreas Meingast <ameingast@gmail.com>+maintainer: Andreas Meingast <ameingast@gmail.com>+copyright: 2014, Andreas Meingast+category: Database+build-type: Simple+cabal-version: >= 1.10+description: A PostgreSQL-simple schema migration utility++extra-source-files: License+ Readme.markdown++ src/*.hs+ src/Database/PostgreSQL/Simple/*.hs++ test/*.hs+ test/Database/PostgreSQL/Simple/*.hs+ + share/test/*.sql+ share/test/scripts/*.sql++source-repository head+ type: git+ location: git://github.com/ameingast/postgresql-simple-migration++Library+ exposed-modules: Database.PostgreSQL.Simple.Migration+ hs-source-dirs: src+ ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns+ default-extensions: OverloadedStrings+ default-language: Haskell2010+ build-depends: base >= 4.6 && < 5.0,+ base64-bytestring >= 1.0 && < 1.1,+ bytestring >= 0.10 && < 0.11,+ cryptohash >= 0.11 && < 0.12,+ directory >= 1.2 && < 1.3, + postgresql-simple >= 0.4 && < 0.5++Executable migrate+ main-is: Main.hs+ hs-source-dirs: src+ ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns+ default-extensions: OverloadedStrings+ default-language: Haskell2010+ build-depends: base >= 4.6 && < 5.0,+ base64-bytestring >= 1.0 && < 1.1,+ bytestring >= 0.10 && < 0.11,+ cryptohash >= 0.11 && < 0.12,+ directory >= 1.2 && < 1.3, + postgresql-simple >= 0.4 && < 0.5++test-suite tests+ main-is: Main.hs+ hs-source-dirs: test+ ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns+ default-extensions: OverloadedStrings+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ build-depends: base >= 4.6 && < 5.0,+ bytestring >= 0.10 && < 0.11,+ postgresql-simple >= 0.4 && < 0.5,+ hspec >= 1.10 && < 1.11,+ postgresql-simple-migration >= 0.1 && < 0.2
@@ -0,0 +1,1 @@+create table t3 (c3 varchar);
@@ -0,0 +1,1 @@+create table t2 (c2 varchar);
+ src/Database/PostgreSQL/Simple/Migration.hs view
@@ -0,0 +1,166 @@+-- |+-- Module : Database.PostgreSQL.Simple.Migration+-- Copyright : (c) 2014 Andreas Meingast <ameingast@gmail.com>+--+-- License : BSD-style+-- Maintainer : ameingast@gmail.com+-- Stability : experimental+-- Portability : GHC+--+-- Migration library for postgresql-simple.++module Database.PostgreSQL.Simple.Migration+ ( runMigration+ , MigrationContext(..)+ , MigrationCommand(..)+ , MigrationResult(..)+ , ScriptName+ ) where++import Control.Monad (liftM, void, when)+import qualified Crypto.Hash.MD5 as MD5 (hash)+import qualified Data.ByteString as BS (ByteString, readFile)+import qualified Data.ByteString.Base64 as B64 (encode)+import Data.List (isPrefixOf, sort)+import Data.Monoid (mconcat)+import Database.PostgreSQL.Simple (Connection, Only (..),+ execute, execute_, query)+import Database.PostgreSQL.Simple.Types (Query (..))+import System.Directory (getDirectoryContents)++-- | Executes migrations inside the provided 'MigrationContext'.+runMigration :: MigrationContext -> IO (MigrationResult String)+runMigration (MigrationContext cmd verbose con) = case cmd of+ MigrationInitialization ->+ initializeSchema con verbose >> return MigrationSuccess+ MigrationDirectory path ->+ executeDirectoryMigration con verbose path+ MigrationScript name contents ->+ executeMigration con verbose name contents+ MigrationFile name path ->+ executeMigration con verbose name =<< BS.readFile path++-- | Executes all SQL-file based migrations located in the provided 'dir'.+executeDirectoryMigration :: Connection -> Bool -> FilePath -> IO (MigrationResult String)+executeDirectoryMigration con verbose dir =+ liftM (filter (\x -> not $ "." `isPrefixOf` x))+ (getDirectoryContents dir) >>= go . sort+ where+ go [] = return MigrationSuccess+ go (f:fs) = do+ r <- executeMigration con verbose f =<< BS.readFile (dir ++ "/" ++ f)+ case r of+ MigrationError _ ->+ return r+ MigrationSuccess ->+ go fs++-- | Executes a generic SQL migration for the provided script 'name' with+-- content 'contents'.+executeMigration :: Connection -> Bool -> ScriptName -> BS.ByteString -> IO (MigrationResult String)+executeMigration con verbose name contents = do+ let checksum = md5Hash contents+ checkScript con name checksum >>= \r -> case r of+ ScriptOk -> do+ when verbose $ putStrLn $ "Ok:\t" ++ name+ return MigrationSuccess+ ScriptNotExecuted -> do+ void $ execute_ con (Query contents)+ void $ execute con q (name, checksum)+ when verbose $ putStrLn $ "Execute:\t" ++ name+ return MigrationSuccess+ ScriptModified _ -> do+ when verbose $ putStrLn $ "Fail:\t" ++ name+ return (MigrationError name)+ where+ q = "insert into schema_migrations(filename, checksum) values(?, ?) "++-- | Initializes the database schema with a helper table containing+-- meta-information about executed migrations.+initializeSchema :: Connection -> Bool -> IO ()+initializeSchema con verbose = do+ when verbose $ putStrLn "Initializing schema"+ void $ execute_ con $ mconcat+ [ "create table if not exists schema_migrations "+ , "( filename varchar(512) not null"+ , ", checksum varchar(32) not null"+ , ", executed_at timestamp without time zone not null default now() "+ , ");"+ ]++-- | Checks the status of the script with the given name 'name'.+-- If the script has already been executed, the checksum of the script+-- is compared against the one that was executed.+-- If there is no matching script entry in the database, the script+-- will be executed and its meta-information will be recorded.+checkScript :: Connection -> ScriptName -> Checksum -> IO CheckScriptResult+checkScript con name checksum =+ query con q (Only name) >>= \r -> case r of+ [] ->+ return ScriptNotExecuted+ Only actualChecksum:_ | checksum == actualChecksum ->+ return ScriptOk+ Only actualChecksum:_ ->+ return (ScriptModified actualChecksum)+ where+ q = mconcat+ [ "select checksum from schema_migrations "+ , "where filename = ? limit 1"+ ]++-- | Calculates the MD5 checksum of the provided bytestring in base64+-- encoding.+md5Hash :: BS.ByteString -> Checksum+md5Hash = B64.encode . MD5.hash++-- | The checksum type of a migration script.+type Checksum = BS.ByteString++-- | The name of a script. Typically the filename or a custom name+-- when using Haskell migrations.+type ScriptName = String++-- | 'MigrationCommand' determines the action of the 'runMigration' script.+data MigrationCommand+ = MigrationInitialization+ -- ^ Initializes the database with a helper table containing meta+ -- information.+ | MigrationDirectory FilePath+ -- ^ Executes migrations based on SQL scripts in the provided 'FilePath'+ -- in alphabetical order.+ | MigrationFile ScriptName FilePath+ -- ^ Executes a migration based on script located at the provided+ -- 'FilePath'.+ | MigrationScript ScriptName BS.ByteString+ -- ^ Executes a migration based on the provided bytestring.+ deriving (Show, Eq, Read, Ord)++-- | A sum-type denoting the result of a single migration.+data CheckScriptResult+ = ScriptOk+ -- ^ The script has already been executed and the checksums match.+ -- This is good.+ | ScriptModified Checksum+ -- ^ The script has already been executed and there is a checksum+ -- mismatch. This is bad.+ | ScriptNotExecuted+ -- ^ The script has not been executed, yet. This is good.+ deriving (Show, Eq, Read, Ord)++-- | A sum-type denoting the result of a migration.+data MigrationResult a+ = MigrationError a+ -- ^ There was an error in script migration.+ | MigrationSuccess+ -- ^ All scripts have been executed successfully.+ deriving (Show, Eq, Read, Ord)++-- | The 'MigrationContext' provides an execution context for migrations.+data MigrationContext = MigrationContext+ { migrationContextCommand :: MigrationCommand+ -- ^ The action that will be performed by 'runMigration'+ , migrationContextVerbose :: Bool+ -- ^ Verbosity of the library.+ , migrationContextConnection :: Connection+ -- ^ The PostgreSQL connection to use for migrations.+ }
+ src/Main.hs view
@@ -0,0 +1,63 @@+module Main (+ main+ ) where++import Control.Monad (void)+import qualified Data.ByteString.Char8 as BS8 (pack)+import Database.PostgreSQL.Simple (connectPostgreSQL)+import Database.PostgreSQL.Simple.Migration (MigrationCommand (..),+ MigrationContext (..),+ runMigration)+import System.Environment (getArgs)+import System.Exit (exitFailure)++main :: IO ()+main = getArgs >>= \args -> case args of+ "-h":_ ->+ printUsage+ "-q":xs ->+ run (parseCommand xs) False+ xs ->+ run (parseCommand xs) True++run :: Maybe Command -> Bool-> IO ()+run Nothing _ = printUsage >> exitFailure+run (Just cmd) verbose =+ void $ case cmd of+ Initialize url -> do+ con <- connectPostgreSQL (BS8.pack url)+ runMigration $ MigrationContext MigrationInitialization verbose con+ Migrate url dir -> do+ con <- connectPostgreSQL (BS8.pack url)+ runMigration $ MigrationContext (MigrationDirectory dir) verbose con++parseCommand :: [String] -> Maybe Command+parseCommand ("init":url:_) = Just (Initialize url)+parseCommand ("migrate":url:dir:_) = Just (Migrate url dir)+parseCommand _ = Nothing++printUsage :: IO ()+printUsage = do+ putStrLn "migrate [options] <command>"+ putStrLn " Options:"+ putStrLn " -h Print help text"+ putStrLn " -q Enable quiet mode"+ putStrLn " Commands:"+ putStrLn " init <con>"+ putStrLn " Initialize the database. Required to be run"+ putStrLn " at least once."+ putStrLn " migrate <con> <directory>"+ putStrLn " Execute all SQL scripts in the provided"+ putStrLn " directory in alphabetical order."+ putStrLn " Scripts that have already been executed are"+ putStrLn " ignored. If a script was changed since the"+ putStrLn " time of its last execution, an error is"+ putStrLn " raised."+ putStrLn " The <con> parameter is based on libpq connection string"+ putStrLn " syntax. Detailled information is available here:"+ putStrLn " <http://www.postgresql.org/docs/9.3/static/libpq-connect.html>"++data Command+ = Initialize String+ | Migrate String String+ deriving (Show, Eq, Read, Ord)
+ test/Database/PostgreSQL/Simple/MigrationTest.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Database.PostgreSQL.Simple.MigrationTest where++import Control.Monad (liftM)+import Database.PostgreSQL.Simple (Connection, Only (..),+ query)+import Database.PostgreSQL.Simple.Migration (MigrationCommand (..),+ MigrationContext (..),+ MigrationResult (..),+ runMigration)+import Test.Hspec (Spec, describe, it,+ shouldBe)++migrationSpec:: Connection -> Spec+migrationSpec con = describe "runMigration" $ do+ it "initializes a database" $ do+ r <- runMigration $+ MigrationContext MigrationInitialization False con+ r `shouldBe` MigrationSuccess++ it "creates the schema_migration table" $ do+ r <- existsTable con "schema_migration"+ r `shouldBe` True++ it "executes a migration script" $ do+ r <- runMigration $+ MigrationContext (MigrationScript "test.sql" q) False con+ r `shouldBe` MigrationSuccess++ it "creates the table from the executed script" $ do+ r <- existsTable con "t1"+ r `shouldBe` True++ it "skips execution of the same migration script" $ do+ r <- runMigration $+ MigrationContext (MigrationScript "test.sql" q) False con+ r `shouldBe` MigrationSuccess++ it "reports an error on a different checksum for the same script" $ do+ r <- runMigration $+ MigrationContext (MigrationScript "test.sql" "") False con+ r `shouldBe` MigrationError "test.sql"++ it "executes migration scripts inside a folder" $ do+ r <- runMigration $+ MigrationContext (MigrationDirectory "share/test/scripts") False con+ r `shouldBe` MigrationSuccess++ it "creates the table from the executed scripts" $ do+ r <- existsTable con "t2"+ r `shouldBe` True++ it "executes a file based migration script" $ do+ r <- runMigration $+ MigrationContext (MigrationFile "s.sql" "share/test/script.sql") False con+ r `shouldBe` MigrationSuccess++ it "creates the table from the executed scripts" $ do+ r <- existsTable con "t3"+ r `shouldBe` True+ where+ q = "create table t1 (c1 varchar);"++existsTable :: Connection -> String -> IO Bool+existsTable con table =+ liftM (not . null) (query con q (Only table) :: IO [[Int]])+ where+ q = "select count(relname) from pg_class where relname = ?"
+ test/Main.hs view
@@ -0,0 +1,20 @@+module Main+ ( main+ ) where++import Control.Exception (finally)+import Database.PostgreSQL.Simple (begin,+ connectPostgreSQL,+ rollback)+import Database.PostgreSQL.Simple.MigrationTest (migrationSpec)+import Test.Hspec (hspec)++main :: IO ()+main = do+ con <- connectPostgreSQL "dbname=test"+ begin con+ finally+ (hspec (migrationSpec con))+ (rollback con)++