hasql-migration 0.1.3 → 0.2.0

raw patch · 5 files changed

+72/−79 lines, 5 filesdep +cryptonitedep +memorydep −base64-bytestringdep −cryptohashdep ~hasqldep ~hasql-transactionPVP ok

version bump matches the API change (PVP)

Dependencies added: cryptonite, memory

Dependencies removed: base64-bytestring, cryptohash

Dependency ranges changed: hasql, hasql-transaction

API changes (from Hackage documentation)

Files

• hasql-migration.cabal +23/−22
• src/Hasql/Migration.hs +27/−35
• src/Hasql/Migration/Util.hs +5/−5
• test/Hasql/MigrationTest.hs +13/−13
• test/Main.hs +4/−4

@@ -1,5 +1,5 @@ name:                       hasql-migration-version:                    0.1.3+version:                    0.2.0 synopsis:                   PostgreSQL Schema Migrations homepage:                   https://github.com/tvh/hasql-migration Bug-reports:                https://github.com/tvh/hasql-migration/issues@@ -7,12 +7,12 @@ license-file:               License author:                     Timo von Holtz <tvh@tvholtz.de> maintainer:                 Timo von Holtz <tvh@tvholtz.de>-copyright:                  Timo von Holtz, Andreas Meingast+copyright:                  Timo von Holtz, Andreas Meingast, Sumit Raja category:                   Database build-type:                 Simple cabal-version:              >= 1.10 description:                A PostgreSQL-simple schema migration utility-+tested-with:                GHC==8.0.1, GHC==8.2.2, GHC==8.4.3 extra-source-files:         License                             Readme.markdown @@ -26,34 +26,35 @@     type:                   git     location:               git://github.com/tvh/hasql-migration -Library+library     exposed-modules:        Hasql.Migration                             Hasql.Migration.Util     hs-source-dirs:         src     ghc-options:            -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns     default-language:       Haskell2010-    build-depends:          base                        >= 4.7      && < 5.0,-                            base64-bytestring           >= 1.0      && < 1.1,-                            bytestring                  >= 0.10     && < 0.11,-                            contravariant               >= 1.3      && < 1.5,-                            cryptohash                  >= 0.11     && < 0.12,-                            data-default-class          >= 0.0.1    && < 0.2,-                            directory                   >= 1.2      && < 1.4,-                            hasql                       >= 0.19     && < 0.20,-                            hasql-transaction           >= 0.5      && < 0.6,-                            text                        >= 1.2      && < 1.3,-                            time                        >= 1.4      && < 1.7+    build-depends:          base                        >= 4.7 && < 5,+                            bytestring                  >= 0.10,+                            contravariant               >= 1.3,+                            cryptonite                  >= 0.11,+                            data-default-class          >= 0.0.1,+                            directory                   >= 1.2,+                            hasql                       >= 1.3,+                            hasql-transaction           >= 0.7,+                            memory,+                            text                        >= 1.2,+                            time                        >= 1.4 -test-suite tests+test-suite hasql-migration-test     main-is:                Main.hs     hs-source-dirs:         test     ghc-options:            -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns+    other-modules:          Hasql.MigrationTest     default-language:       Haskell2010     type:                   exitcode-stdio-1.0-    build-depends:          base                        >= 4.7      && < 5.0,-                            bytestring                  >= 0.10     && < 0.11,-                            hasql                       >= 0.19     && < 0.20,+    build-depends:          base                        >= 4.7 && < 5,+                            bytestring                  >= 0.10,+                            hasql                       >= 0.19,                             hasql-migration,-                            hasql-transaction           >= 0.5      && < 0.6,-                            hspec                       >= 2.2      && < 2.4,-                            transformers                >= 0.3      && < 0.6+                            hasql-transaction           >= 0.5,+                            hspec                       >= 2.2,+                            transformers                >= 0.3

@@ -23,7 +23,7 @@      -- * Migration types     , MigrationCommand(..)-    , MigrationResult(..)+    , MigrationError(..)     , ScriptName     , Checksum @@ -35,20 +35,18 @@     ) where  import Control.Arrow-import Control.Applicative+import Crypto.Hash (hashWith, MD5(..))+import Data.ByteArray.Encoding import Data.Default.Class import Data.Functor.Contravariant import Data.List (isPrefixOf, sort)-import Data.Monoid-import Data.Traversable (forM) import Data.Time (LocalTime)+import Data.Traversable (forM) import Hasql.Migration.Util (existsTable)-import Hasql.Query+import Hasql.Statement import Hasql.Transaction import System.Directory (getDirectoryContents)-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 qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Hasql.Decoders as Decoders@@ -59,10 +57,10 @@ -- Returns 'MigrationSuccess' if the provided 'MigrationCommand' executes -- without error. If an error occurs, execution is stopped and -- a 'MigrationError' is returned.-runMigration :: MigrationCommand -> Transaction (MigrationResult String)+runMigration :: MigrationCommand -> Transaction (Maybe MigrationError) runMigration cmd = case cmd of     MigrationInitialization ->-        initializeSchema >> return MigrationSuccess+        initializeSchema >> return Nothing     MigrationScript name contents ->         executeMigration name contents     MigrationValidation validationCmd ->@@ -87,21 +85,20 @@ scriptsInDirectory dir =     fmap (sort . filter (\x -> not $ "." `isPrefixOf` x))         (getDirectoryContents dir)- -- | Executes a generic SQL migration for the provided script 'name' with -- content 'contents'.-executeMigration :: ScriptName -> BS.ByteString -> Transaction (MigrationResult String)+executeMigration :: ScriptName -> BS.ByteString -> Transaction (Maybe MigrationError) executeMigration name contents = do     let checksum = md5Hash contents     checkScript name checksum >>= \case         ScriptOk -> do-            return MigrationSuccess+            return Nothing         ScriptNotExecuted -> do             sql contents-            query (name, checksum) (statement q (contramap (first T.pack) def) Decoders.unit False)-            return MigrationSuccess+            statement (name, checksum) (Statement q (contramap (first T.pack) def) Decoders.unit False)+            return Nothing         ScriptModified _ -> do-            return (MigrationError name)+            return (Just $ ScriptChanged name)     where         q = "insert into schema_migrations(filename, checksum) values($1, $2)" @@ -123,25 +120,25 @@ -- * 'MigrationInitialization': validate the presence of the meta-information -- table. -- * 'MigrationValidation': always succeeds.-executeValidation :: MigrationCommand -> Transaction (MigrationResult String)+executeValidation :: MigrationCommand -> Transaction (Maybe MigrationError) executeValidation cmd = case cmd of     MigrationInitialization ->         existsTable "schema_migrations" >>= \r -> return $ if r-            then MigrationSuccess-            else MigrationError "No such table: schema_migrations"+            then Nothing+            else (Just NotInitialised)     MigrationScript name contents ->         validate name contents     MigrationValidation _ ->-        return MigrationSuccess+        return Nothing     where         validate name contents =             checkScript name (md5Hash contents) >>= \case                 ScriptOk -> do-                    return MigrationSuccess+                    return Nothing                 ScriptNotExecuted -> do-                    return (MigrationError $ "Missing: " ++ name)+                    return (Just $ ScriptMissing name)                 ScriptModified _ -> do-                    return (MigrationError $ "Checksum mismatch: " ++ name)+                    return (Just $ ChecksumMismatch name)  -- | Checks the status of the script with the given name 'name'. -- If the script has already been executed, the checksum of the script@@ -150,7 +147,7 @@ -- will be executed and its meta-information will be recorded. checkScript :: ScriptName -> Checksum -> Transaction CheckScriptResult checkScript name checksum =-    query name (statement q (contramap T.pack (Encoders.value def)) (Decoders.maybeRow (Decoders.value def)) False) >>= \case+    statement name (Statement q (contramap T.pack (Encoders.param def)) (Decoders.rowMaybe (Decoders.column def)) False) >>= \case         Nothing ->             return ScriptNotExecuted         Just actualChecksum | checksum == actualChecksum ->@@ -166,7 +163,7 @@ -- | Calculates the MD5 checksum of the provided bytestring in base64 -- encoding. md5Hash :: BS.ByteString -> Checksum-md5Hash = T.decodeUtf8 . B64.encode . MD5.hash+md5Hash = T.decodeUtf8 . convertToBase Base64 . hashWith MD5  -- | The checksum type of a migration script. type Checksum = T.Text@@ -198,18 +195,13 @@     -- ^ 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)+-- | Errors that could occur when a migration is validated or performed+data MigrationError = ScriptChanged String | NotInitialised | ScriptMissing String | ChecksumMismatch String deriving (Show, Eq, Read, Ord)  -- | Produces a list of all executed 'SchemaMigration's. getMigrations :: Transaction [SchemaMigration] getMigrations =-    query () $ statement q def (Decoders.rowsList decodeSchemaMigration) False+    statement () $ Statement q def (Decoders.rowList decodeSchemaMigration) False     where         q = mconcat             [ "select filename, checksum, executed_at "@@ -233,6 +225,6 @@ decodeSchemaMigration :: Decoders.Row SchemaMigration decodeSchemaMigration =     SchemaMigration-    <$> Decoders.value def-    <*> Decoders.value def-    <*> Decoders.value def+    <$> Decoders.column def+    <*> Decoders.column def+    <*> Decoders.column def

@@ -16,17 +16,17 @@     ( existsTable     ) where -import           Hasql.Query+import           Hasql.Statement import qualified Hasql.Encoders as Encoders import qualified Hasql.Decoders as Decoders-import           Hasql.Transaction (query, Transaction)+import           Hasql.Transaction (statement, Transaction) import Data.Text (Text) import Data.Default.Class  -- | Checks if the table with the given name exists in the database. existsTable :: Text -> Transaction Bool existsTable table =-    fmap (not . null) $ query table q+    fmap (not . null) $ statement table q     where-        q = statement sql (Encoders.value def) (Decoders.rowsList (Decoders.value Decoders.int8)) False-        sql = "select count(relname) from pg_class where relname = $1"+        q = Statement sql (Encoders.param def) (Decoders.rowList (Decoders.column Decoders.int8)) False+        sql = "select relname from pg_class where relname = $1"

@@ -14,7 +14,7 @@  module Hasql.MigrationTest where -import           Hasql.Session                        (run, Error)+import           Hasql.Session                        (run, QueryError) import           Hasql.Connection import qualified Hasql.Transaction                    as Tx import qualified Hasql.Transaction.Sessions           as Tx@@ -23,7 +23,7 @@ import           Test.Hspec                           (Spec, describe, it,                                                        shouldBe, runIO) -runTx :: Connection -> Tx.Transaction a -> IO (Either Error a)+runTx :: Connection -> Tx.Transaction a -> IO (Either QueryError a) runTx con act = do     run (Tx.transaction Tx.ReadCommitted Tx.Write act) con @@ -36,15 +36,15 @@      it "initializes a database" $ do         r <- runTx con $ runMigration $ MigrationInitialization-        r `shouldBe` Right MigrationSuccess+        r `shouldBe` Right Nothing      it "creates the schema_migrations table" $ do-        r <- runTx con $ existsTable "schema_migration"+        r <- runTx con $ existsTable "schema_migrations"         r `shouldBe` Right True      it "executes a migration script" $ do         r <- runTx con $ runMigration $ migrationScript-        r `shouldBe` Right MigrationSuccess+        r `shouldBe` Right Nothing      it "creates the table from the executed script" $ do         r <- runTx con $ existsTable "t1"@@ -52,15 +52,15 @@      it "skips execution of the same migration script" $ do         r <- runTx con $ runMigration $ migrationScript-        r `shouldBe` Right MigrationSuccess+        r `shouldBe` Right Nothing      it "reports an error on a different checksum for the same script" $ do         r <- runTx con $ runMigration $ migrationScriptAltered-        r `shouldBe` Right (MigrationError "test.sql")+        r `shouldBe` Right (Just (ScriptChanged "test.sql"))      it "executes migration scripts inside a folder" $ do         r <- runTx con $ runMigration $ migrationDir-        r `shouldBe` Right MigrationSuccess+        r `shouldBe` Right Nothing      it "creates the table from the executed scripts" $ do         r <- runTx con $ existsTable "t2"@@ -68,7 +68,7 @@      it "executes a file based migration script" $ do         r <- runTx con $ runMigration $ migrationFile-        r `shouldBe` Right MigrationSuccess+        r `shouldBe` Right Nothing      it "creates the table from the executed scripts" $ do         r <- runTx con $ existsTable "t3"@@ -76,19 +76,19 @@      it "validates initialization" $ do         r <- runTx con $ runMigration $ (MigrationValidation MigrationInitialization)-        r `shouldBe` Right MigrationSuccess+        r `shouldBe` Right Nothing      it "validates an executed migration script" $ do         r <- runTx con $ runMigration $ (MigrationValidation migrationScript)-        r `shouldBe` Right MigrationSuccess+        r `shouldBe` Right Nothing      it "validates all scripts inside a folder" $ do         r <- runTx con $ runMigration $ (MigrationValidation migrationDir)-        r `shouldBe` Right MigrationSuccess+        r `shouldBe` Right Nothing      it "validates an executed migration file" $ do         r <- runTx con $ runMigration $ (MigrationValidation migrationFile)-        r `shouldBe` Right MigrationSuccess+        r `shouldBe` Right Nothing      it "gets a list of executed migrations" $ do         r <- runTx con getMigrations

@@ -8,7 +8,7 @@ -- Stability   : experimental -- Portability : GHC ----- The test entry-point for postgresql-simple-migration.+-- The test entry-point for hasql-migration.  {-# LANGUAGE OverloadedStrings #-} @@ -18,11 +18,11 @@  import Hasql.Connection import Hasql.MigrationTest-import           Test.Hspec                               (hspec)+import Test.Hspec (hspec)  main :: IO () main = do-    con <- acquire "dbname=test"-    case con of+    conE <- acquire "dbname=test"+    case conE of       Right con -> hspec (migrationSpec con)       Left err -> putStrLn $ show err