postgresql-simple-migration 0.1.0.0 → 0.1.1.0

raw patch · 7 files changed

+246/−49 lines, 7 filesdep +timePVP ok

version bump matches the API change (PVP)

Dependencies added: time

API changes (from Hackage documentation)

Files

• Changelog.markdown +8/−0
• Readme.markdown +29/−2
• postgresql-simple-migration.cabal +8/−3
• src/Database/PostgreSQL/Simple/Internal/Util.hs +24/−0
• src/Database/PostgreSQL/Simple/Migration.hs +119/−14
• src/Main.hs +11/−3
• test/Database/PostgreSQL/Simple/MigrationTest.hs +47/−27

@@ -0,0 +1,8 @@+# Changelog++## 0.1.1.0+* Support for schema validations.+* Improved Haskell API++## 0.1.0.0+* Support for file-based and Haskell migrations.

@@ -34,6 +34,9 @@ * a time-stamp of the date of execution so you can easily track when a change   happened. +This library also supports migration validation so you can ensure (some)+correctness before your application logic kicks in.+ ## How? This utility can be used in two ways: embedded in your Haskell program or as a standalone binary.@@ -49,6 +52,13 @@ ./dist/build/migrate/migrate migrate $CON $BASE_DIR ``` +To validate already executed scripts, execute the following:+```bash+CON="host=$host dbname=$db user=$user password=$pw"+./dist/build/migrate/migrate init $CON+./dist/build/migrate/migrate validate $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). @@ -85,9 +95,27 @@     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+    void $ runMigration $ MigrationContext +        (MigrationScript name script) True con ``` +Validations wrap _MigrationCommands_. This means that you can re-use all+MigrationCommands to perform a read-only validation of your migrations.++To perform a validation on a directory-based migration, you can use the+following code:++```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 +        (MigrationValidation (MigrationDirectory dir)) verbose 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.@@ -106,4 +134,3 @@ ## To Do * Collect executed scripts and check if already executed scripts have been   deleted.-* Validate command for the standalone program.

@@ -1,5 +1,5 @@ name:                       postgresql-simple-migration-version:                    0.1.0.0+version:                    0.1.1.0 synopsis:                   PostgreSQL Schema Migrations homepage:                   https://github.com/ameingast/postgresql-simple-migration Bug-reports:                https://github.com/ameingast/postgresql-simple-migration/issues@@ -15,9 +15,11 @@  extra-source-files:         License                             Readme.markdown+                            Changelog.markdown                              src/*.hs                             src/Database/PostgreSQL/Simple/*.hs+                            src/Database/PostgreSQL/Simple/Internal/*.hs                              test/*.hs                             test/Database/PostgreSQL/Simple/*.hs@@ -31,6 +33,7 @@  Library     exposed-modules:        Database.PostgreSQL.Simple.Migration+                            Database.PostgreSQL.Simple.Internal.Util     hs-source-dirs:         src     ghc-options:            -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns     default-extensions:     OverloadedStrings@@ -40,7 +43,8 @@                             bytestring                  >= 0.10     && < 0.11,                             cryptohash                  >= 0.11     && < 0.12,                             directory                   >= 1.2      && < 1.3,    -                            postgresql-simple           >= 0.4      && < 0.5+                            postgresql-simple           >= 0.4      && < 0.5,+                            time                        >= 1.4      && < 1.5  Executable migrate     main-is:                Main.hs@@ -53,7 +57,8 @@                             bytestring                  >= 0.10     && < 0.11,                             cryptohash                  >= 0.11     && < 0.12,                             directory                   >= 1.2      && < 1.3,    -                            postgresql-simple           >= 0.4      && < 0.5+                            postgresql-simple           >= 0.4      && < 0.5,+                            time                        >= 1.4      && < 1.5  test-suite tests     main-is:                Main.hs

@@ -0,0 +1,24 @@+-- |+-- 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.Internal.Util+    ( existsTable+    ) where++import           Control.Monad              (liftM)+import           Database.PostgreSQL.Simple (Connection, Only (..), query)++-- | Checks if the table named 'table' exists in the provided database.+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 = ?"

@@ -10,23 +10,43 @@ -- Migration library for postgresql-simple.  module Database.PostgreSQL.Simple.Migration-    ( runMigration+    (+    -- * Migration actions+    runMigration++    -- * Migration types     , MigrationContext(..)     , MigrationCommand(..)     , MigrationResult(..)     , ScriptName+    , Checksum++    -- * Migration result actions+    , getMigrations++    -- * Migration result types+    , SchemaMigration(..)     ) 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)+import           Control.Applicative                      ((<$>), (<*>))+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           Data.Time                                (LocalTime)+import           Database.PostgreSQL.Simple               (Connection,+                                                           Only (..), execute,+                                                           execute_, query,+                                                           query_)+import           Database.PostgreSQL.Simple.FromRow       (FromRow (..), field)+import           Database.PostgreSQL.Simple.Internal.Util (existsTable)+import           Database.PostgreSQL.Simple.ToField       (ToField (..))+import           Database.PostgreSQL.Simple.ToRow         (ToRow (..))+import           Database.PostgreSQL.Simple.Types         (Query (..))+import           System.Directory                         (getDirectoryContents)  -- | Executes migrations inside the provided 'MigrationContext'. runMigration :: MigrationContext -> IO (MigrationResult String)@@ -39,12 +59,14 @@         executeMigration con verbose name contents     MigrationFile name path ->         executeMigration con verbose name =<< BS.readFile path+    MigrationValidation validationCmd ->+        executeValidation con verbose validationCmd --- | Executes all SQL-file based migrations located in the provided 'dir'.+-- | Executes all SQL-file based migrations located in the provided 'dir'+-- in alphabetical order. executeDirectoryMigration :: Connection -> Bool -> FilePath -> IO (MigrationResult String) executeDirectoryMigration con verbose dir =-    liftM (filter (\x -> not $ "." `isPrefixOf` x))-        (getDirectoryContents dir) >>= go . sort+    scriptsInDirectory dir >>= go     where         go [] = return MigrationSuccess         go (f:fs) = do@@ -55,6 +77,12 @@                 MigrationSuccess ->                     go fs +-- | Lists all files in the given 'FilePath' 'dir' in alphabetical order.+scriptsInDirectory :: FilePath -> IO [String]+scriptsInDirectory dir =+    liftM (sort . filter (\x -> not $ "." `isPrefixOf` x))+        (getDirectoryContents dir)+ -- | Executes a generic SQL migration for the provided script 'name' with -- content 'contents'. executeMigration :: Connection -> Bool -> ScriptName -> BS.ByteString -> IO (MigrationResult String)@@ -88,6 +116,52 @@         , ");"         ] +-- | Validates a 'MigrationCommand'. Validation is defined as follows for these+-- types:+--+-- * 'MigrationInitialization': validate the presence of the meta-information+-- table.+-- * 'MigrationDirectory': validate the presence and checksum of all scripts+-- found in the given directory.+-- * 'MigrationScript': validate the presence and checksum of the given script.+-- * 'MigrationFile': validate the presence and checksum of the given file.+-- * 'MigrationValidation': always succeeds.+executeValidation :: Connection -> Bool -> MigrationCommand -> IO (MigrationResult String)+executeValidation con verbose cmd = case cmd of+    MigrationInitialization ->+        existsTable con "schema_migrations" >>= \r -> return $ if r+            then MigrationSuccess+            else MigrationError "No such table: schema_migrations"+    MigrationDirectory path ->+        scriptsInDirectory path >>= goScripts path+    MigrationScript name contents ->+        validate name contents+    MigrationFile name path ->+        validate name =<< BS.readFile path+    MigrationValidation _ ->+        return MigrationSuccess+    where+        validate name contents =+            checkScript con name (md5Hash contents) >>= \r -> case r of+                ScriptOk -> do+                    when verbose $ putStrLn $ "Ok:\t" ++ name+                    return MigrationSuccess+                ScriptNotExecuted -> do+                    when verbose $ putStrLn $ "Missing:\t" ++ name+                    return (MigrationError $ "Missing: " ++ name)+                ScriptModified _ -> do+                    when verbose $ putStrLn $ "Checksum mismatch:\t" ++ name+                    return (MigrationError $ "Checksum mismatch: " ++ name)++        goScripts _ [] = return MigrationSuccess+        goScripts path (x:xs) = do+            r <- validate x =<< BS.readFile (path ++ "/" ++ x)+            case r of+                e@(MigrationError _) ->+                    return e+                MigrationSuccess ->+                    goScripts path xs+ -- | 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.@@ -133,6 +207,7 @@     -- 'FilePath'.     | MigrationScript ScriptName BS.ByteString     -- ^ Executes a migration based on the provided bytestring.+    | MigrationValidation MigrationCommand     deriving (Show, Eq, Read, Ord)  -- | A sum-type denoting the result of a single migration.@@ -164,3 +239,33 @@     , migrationContextConnection :: Connection     -- ^ The PostgreSQL connection to use for migrations.     }++-- | Produces a list of all executed 'SchemaMigration's.+getMigrations :: Connection -> IO [SchemaMigration]+getMigrations = flip query_ q+    where q = mconcat+            [ "select filename, checksum, executed_at "+            , "from schema_migrations"+            ]++-- | A product type representing a single, executed 'SchemaMigration'.+data SchemaMigration = SchemaMigration+    { schemaMigrationName       :: BS.ByteString+    -- ^ The name of the executed migration.+    , schemaMigrationChecksum   :: Checksum+    -- ^ The calculated MD5 checksum of the executed script.+    , schemaMigrationExecutedAt :: LocalTime+    -- ^ A timestamp without timezone of the date of execution of the script.+    } deriving (Show, Eq, Read)++instance Ord SchemaMigration where+    compare (SchemaMigration nameLeft _ _) (SchemaMigration nameRight _ _) =+        compare nameLeft nameRight++instance FromRow SchemaMigration where+    fromRow = SchemaMigration <$>+        field <*> field <*> field++instance ToRow SchemaMigration where+    toRow (SchemaMigration name checksum executedAt) =+       [toField name, toField checksum, toField executedAt]

@@ -26,14 +26,21 @@     void $ case cmd of         Initialize url -> do             con <- connectPostgreSQL (BS8.pack url)-            runMigration $ MigrationContext MigrationInitialization verbose con+            runMigration $ MigrationContext+                MigrationInitialization verbose con         Migrate url dir -> do             con <- connectPostgreSQL (BS8.pack url)-            runMigration $ MigrationContext (MigrationDirectory dir) verbose con+            runMigration $ MigrationContext+                (MigrationDirectory dir) verbose con+        Validate url dir -> do+            con <- connectPostgreSQL (BS8.pack url)+            runMigration $ MigrationContext+                (MigrationValidation (MigrationDirectory dir)) verbose con  parseCommand :: [String] -> Maybe Command parseCommand ("init":url:_) = Just (Initialize url) parseCommand ("migrate":url:dir:_) = Just (Migrate url dir)+parseCommand ("validate":url:dir:_) = Just (Validate url dir) parseCommand _ = Nothing  printUsage :: IO ()@@ -59,5 +66,6 @@  data Command     = Initialize String-    | Migrate String String+    | Migrate String FilePath+    | Validate String FilePath     deriving (Show, Eq, Read, Ord)

@@ -2,30 +2,33 @@  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)+import           Database.PostgreSQL.Simple               (Connection)+import           Database.PostgreSQL.Simple.Internal.Util (existsTable)+import           Database.PostgreSQL.Simple.Migration     (MigrationCommand (..), MigrationContext (..),+                                                           MigrationResult (..),+                                                           SchemaMigration (..),+                                                           getMigrations,+                                                           runMigration)+import           Test.Hspec                               (Spec, describe, it,+                                                           shouldBe)  migrationSpec:: Connection -> Spec-migrationSpec con = describe "runMigration" $ do+migrationSpec con = describe "Migrations" $ do+    let migrationScript = MigrationScript "test.sql" q+    let migrationScriptAltered = MigrationScript "test.sql" ""+    let migrationDir = MigrationDirectory "share/test/scripts"+    let migrationFile = MigrationFile "s.sql" "share/test/script.sql"+     it "initializes a database" $ do-        r <- runMigration $-            MigrationContext MigrationInitialization False con+        r <- runMigration $ MigrationContext MigrationInitialization False con         r `shouldBe` MigrationSuccess -    it "creates the schema_migration table" $ do+    it "creates the schema_migrations 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 <- runMigration $ MigrationContext migrationScript False con         r `shouldBe` MigrationSuccess      it "creates the table from the executed script" $ do@@ -34,17 +37,15 @@      it "skips execution of the same migration script" $ do         r <- runMigration $-            MigrationContext (MigrationScript "test.sql" q) False con+            MigrationContext migrationScript 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 <- runMigration $ MigrationContext migrationScriptAltered 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 <- runMigration $ MigrationContext migrationDir False con         r `shouldBe` MigrationSuccess      it "creates the table from the executed scripts" $ do@@ -52,18 +53,37 @@         r `shouldBe` True      it "executes a file based migration script" $ do-        r <- runMigration $-            MigrationContext (MigrationFile "s.sql" "share/test/script.sql") False con+        r <- runMigration $ MigrationContext migrationFile False con         r `shouldBe` MigrationSuccess      it "creates the table from the executed scripts" $ do         r <- existsTable con "t3"         r `shouldBe` True++    it "validates initialization" $ do+        r <- runMigration $ MigrationContext+            (MigrationValidation MigrationInitialization) False con+        r `shouldBe` MigrationSuccess++    it "validates an executed migration script" $ do+        r <- runMigration $ MigrationContext+            (MigrationValidation migrationScript) False con+        r `shouldBe` MigrationSuccess++    it "validates all scripts inside a folder" $ do+        r <- runMigration $ MigrationContext+            (MigrationValidation migrationDir) False con+        r `shouldBe` MigrationSuccess++    it "validates an executed migration file" $ do+        r <- runMigration $ MigrationContext+            (MigrationValidation migrationFile) False con+        r `shouldBe` MigrationSuccess++    it "gets a list of executed migrations" $ do+        r <- getMigrations con+        map schemaMigrationName r `shouldBe` ["test.sql", "1.sql", "s.sql"]+     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 = ?"