diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ Changelog for tmp-postgres +1.7.0.0 + #156 Deprecate `NewDb` functions. + #155 Better monoids for `initDbConfig` and `createDbConfig`. + #142 Cluster save points. + 1.16.1.0 #152 Add stopPostgresGracefully function. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -40,7 +40,7 @@ WARNING!! Ubuntu's PostgreSQL installation does not put `initdb` on the `PATH`. We need to add it manually. -The necessary binaries are in the `\/usr\/lib\/postgresql\/VERSION\/bin\/` directory, and should be added to the `PATH` +The necessary binaries are in the `/usr/lib/postgresql/VERSION/bin/` directory, and should be added to the `PATH` > echo "export PATH=$PATH:/usr/lib/postgresql/VERSION/bin/" >> /home/ubuntu/.bashrc diff --git a/benchmark/Main.hs b/benchmark/Main.hs --- a/benchmark/Main.hs +++ b/benchmark/Main.hs @@ -1,18 +1,23 @@ module Main where +import Control.DeepSeq import Control.Exception -import Control.Monad (void, replicateM) +import Control.Monad import Criterion.Main import Data.String import Database.Postgres.Temp.Internal import Database.Postgres.Temp.Internal.Config import qualified Database.PostgreSQL.Simple as PG +data Once a = Once { unOnce :: a } + +instance NFData (Once a) where + rnf x = seq x () + defaultConfigDefaultInitDb :: Config defaultConfigDefaultInitDb = mempty { plan = mempty { logger = pure mempty , postgresConfigFile = defaultPostgresConfig - , createDbConfig = Nothing , initDbConfig = pure mempty } } @@ -48,11 +53,35 @@ setupWithCache :: (Config -> Benchmark) -> Benchmark setupWithCache f = envWithCleanup setupCache cleanupInitDbCache $ f . (silentConfig <>) . toCacheConfig +setupCacheAndSP :: IO ((Bool, CompleteDirectoryType), CompleteDirectoryType, Once Config) +setupCacheAndSP = do + cacheInfo <- setupCache + let cacheConfig = silentConfig <> toCacheConfig cacheInfo + sp <- either throwIO pure <=< withConfig cacheConfig $ \db -> do + migrateDb db + either throwIO pure =<< takeSnapshot Temporary db + + snapshotConfig <- (silentConfig <>) + <$> configFromSavePoint (toFilePath sp) + let theConfig = snapshotConfig <> cacheConfig + + pure (cacheInfo, sp, Once theConfig) + +cleanupCacheAndSP :: ((Bool, CompleteDirectoryType), CompleteDirectoryType, Once Config) -> IO () +cleanupCacheAndSP (x, y, _) = cleanupSnapshot y >> cleanupInitDbCache x + +setupWithCacheAndSP :: (Config -> Benchmark) -> Benchmark +setupWithCacheAndSP f = envWithCleanup setupCacheAndSP cleanupCacheAndSP $ \ ~(_, _, Once x) -> f x + +setupWithCacheAndSP' :: (CompleteDirectoryType -> Benchmark) -> Benchmark +setupWithCacheAndSP' f = envWithCleanup setupCacheAndSP cleanupCacheAndSP $ \ ~(_, x, _) -> f x + main :: IO () main = defaultMain [ --bench "with" $ whnfIO $ with $ const $ pure () --, bench "withConfig no --no-sync" $ whnfIO $ -- withConfig defaultConfigDefaultInitDb $ const $ pure () +{- bench "withConfig silent" $ whnfIO $ withConfig silentConfig $ const $ pure () @@ -65,14 +94,32 @@ , bench "withNewDb migrate 10x" $ whnfIO $ withConfig silentConfig $ \db -> do migrateDb db replicateM 10 $ withNewDb db testQuery +-} + setupWithCache $ \cacheConfig -> bench "withNewDbConfig migrate 10x and cache" $ whnfIO $ withConfig cacheConfig + $ \db -> do + migrateDb db + replicateM 10 $ withNewDb db testQuery - , setupWithCache $ \cacheConfig -> do + , setupWithCache $ \cacheConfig -> do bench "with migrate 10x and cache" $ whnfIO $ withConfig cacheConfig $ \_ -> do - replicateM 10 $ withConfig cacheConfig $ \db -> + replicateM_ 10 $ withConfig cacheConfig $ \db -> migrateDb db >> testQuery db - , setupWithCache $ \cacheConfig -> bench "withNewDbConfig migrate 10x and cache" $ whnfIO $ withConfig cacheConfig - $ \db -> do + , setupWithCache $ \cacheConfig -> bench "withSnapshot migrate 10x and cache" $ whnfIO $ withConfig cacheConfig $ \db -> do migrateDb db - replicateM 10 $ withNewDb db testQuery + void $ withSnapshot Temporary db $ \snapshotDir -> do + snapshotConfig <- (silentConfig <>) <$> configFromSavePoint (toFilePath snapshotDir) + replicateM_ 10 $ withConfig snapshotConfig testQuery +{- + , setupWithCacheAndSP $ \theConfig -> bench "withConfig pre-setup with withSnapshot" $ whnfIO $ + void $ withConfig theConfig $ const $ pure () + + , setupWithCacheAndSP' $ \sp -> bench "configFromSavePoint" $ whnfIO $ void $ configFromSavePoint $ toFilePath sp + + , bench "migrateDb" $ perRunEnvWithCleanup (either throwIO (pure . Once) =<< startConfig silentConfig) (stop . unOnce) $ + \ ~(Once db) -> migrateDb db +-} + , bench "withSnapshot" $ perRunEnvWithCleanup (either throwIO (pure . Once) =<< startConfig silentConfig) (stop . unOnce) $ + \ ~(Once db) -> void $ withSnapshot Temporary db $ const $ pure () + ] diff --git a/src/Database/Postgres/Temp.hs b/src/Database/Postgres/Temp.hs --- a/src/Database/Postgres/Temp.hs +++ b/src/Database/Postgres/Temp.hs @@ -50,10 +50,9 @@ with , withConfig , withRestart - , withNewDb - , withNewDbConfig - , withDbCacheConfig , withDbCache + , withDbCacheConfig + , withSnapshot -- * Separate start and stop interface. , start , startConfig @@ -61,11 +60,10 @@ , restart , stopPostgres , stopPostgresGracefully - , startNewDb - , startNewDbConfig - , stopNewDb , setupInitDbCache , cleanupInitDbCache + , takeSnapshot + , cleanupSnapshot -- * Main resource handle , DB -- ** 'DB' accessors @@ -87,10 +85,17 @@ , standardProcessConfig , silentConfig , silentProcessConfig + , configFromSavePoint -- ** Custom Config builder helpers , optionsToDefaultConfig -- ** Configuration Types , module Database.Postgres.Temp.Config + -- * Deprecated NewDb Functions. Use 'withSnapshot'. + , withNewDb + , withNewDbConfig + , startNewDb + , startNewDbConfig + , stopNewDb ) where import Database.Postgres.Temp.Internal import Database.Postgres.Temp.Internal.Core diff --git a/src/Database/Postgres/Temp/Config.hs b/src/Database/Postgres/Temp/Config.hs --- a/src/Database/Postgres/Temp/Config.hs +++ b/src/Database/Postgres/Temp/Config.hs @@ -59,6 +59,8 @@ , keyBasedL -- ** 'DirectoryType' , DirectoryType (..) + -- ** 'Accum' + , Accum (..) -- ** 'Logger' , Logger -- * Internal events passed to the 'logger' . diff --git a/src/Database/Postgres/Temp/Internal.hs b/src/Database/Postgres/Temp/Internal.hs --- a/src/Database/Postgres/Temp/Internal.hs +++ b/src/Database/Postgres/Temp/Internal.hs @@ -187,7 +187,6 @@ { plan = mempty { logger = pure mempty , postgresConfigFile = defaultPostgresConfig - , createDbConfig = Nothing , initDbConfig = pure mempty { commandLine = mempty { keyBased = Map.singleton "--no-sync" Nothing @@ -484,7 +483,7 @@ -- in it's connection options. -> IO (Either StartError a) withNewDb = withNewDbConfig mempty - +{-# DEPRECATED withNewDb "Use withSnapshot" #-} {-| Exception safe version of 'startNewDbConfig'. Creates a temporary database using the current database as a template. @@ -507,6 +506,7 @@ withNewDbConfig extra db f = bracket (startNewDbConfig extra db) (either mempty stopNewDb) $ either (pure . Left) (fmap Right . f) +{-# DEPRECATED withNewDbConfig "Use withSnapshot" #-} {-| Use the current database as a template and make a copy. Give the @@ -529,6 +529,7 @@ -- is used as the template for the @generated@ 'ProcessConfig'. -> IO (Either StartError DB) startNewDb = startNewDbConfig mempty +{-# DEPRECATED startNewDb "Use takeSnapshot" #-} {-| Use the current database as a template and make a copy. Give the @@ -607,7 +608,7 @@ terminateConnections oldOptions executeCreateDb final pure newDb - +{-# DEPRECATED startNewDbConfig "Use takeSnapshot" #-} -- | Cleanup the temporary database created by 'startNewDbConfig' -- or 'startNewDb'. -- @@ -624,6 +625,7 @@ { Client.dbname = pure "template1" } dropDbIfExists template1Options newDbName +{-# DEPRECATED stopNewDb "Use cleanupSnapshot" #-} ------------------------------------------------------------------------------- -- initdb cache @@ -737,3 +739,86 @@ toCacheConfig cacheInfo = mempty { initDbCache = pure $ pure $ fmap toFilePath cacheInfo } + +------------------------------------------------------------------------------- +-- withSnapshot +------------------------------------------------------------------------------- +{- | +Shutdown the database and copy the directory to a folder. + +@since 1.17.0.0 +-} +takeSnapshot + :: DirectoryType + -- ^ Either a 'Temporary' or preexisting 'Permanent' directory. + -> DB + -- ^ The handle. The @postgres@ is shutdown and the data directory is copied. + -> IO (Either StartError CompleteDirectoryType) +takeSnapshot directoryType db = try $ do + throwIfNotSuccess id =<< stopPostgresGracefully db + cow <- cacheUseCopyOnWrite <$> createDefaultCacheConfig + let +#ifdef darwin_HOST_OS + cpFlags = if cow then "cp -Rc " else "cp -R " +#else + cpFlags = if cow then "cp -R --reflink=auto " else "cp -R " +#endif + bracketOnError + (setupDirectoryType + (toTemporaryDirectory db) + "tmp-postgres-snapshot" + directoryType + ) + cleanupDirectoryType $ \snapShotDir -> do + let snapshotCopyCmd = cpFlags <> + toDataDirectory db <> "/* " <> toFilePath snapShotDir + throwIfNotSuccess (SnapshotCopyFailed snapshotCopyCmd) =<< + system snapshotCopyCmd + + pure snapShotDir + +{-| +Cleanup any temporary resources used for the snapshot. + +@since 1.17.0.0 +-} +cleanupSnapshot :: CompleteDirectoryType -> IO () +cleanupSnapshot = cleanupDirectoryType + +{- | +Exception safe method for taking a file system level copy of the database cluster. + +Snapshots are useful if you would like to start every test from a migrated database +and the migration process is more time consuming then copying the additional data. + +@since 1.17.0.0 +-} +withSnapshot + :: DirectoryType + -> DB + -> (CompleteDirectoryType -> IO a) + -> IO (Either StartError a) +withSnapshot dirType db f = bracket + (takeSnapshot dirType db) + (either mempty cleanupSnapshot) + (either (pure . Left) (fmap Right . f)) + +{-| +Convert a snapshot into a 'Config' that includes a 'copyConfig' for copying the +snapshot directory to a temporary directory. + +@since 1.17.0.0 +-} +configFromSavePoint :: FilePath -> IO Config +configFromSavePoint savePointPath = do + cow <- cacheUseCopyOnWrite <$> createDefaultCacheConfig + pure mempty + { plan = mempty + { copyConfig = pure $ pure CopyDirectoryCommand + { sourceDirectory = savePointPath + , destinationDirectory = Nothing + , useCopyOnWrite = cow + } + , initDbConfig = Zlich + } + } diff --git a/src/Database/Postgres/Temp/Internal/Config.hs b/src/Database/Postgres/Temp/Internal/Config.hs --- a/src/Database/Postgres/Temp/Internal/Config.hs +++ b/src/Database/Postgres/Temp/Internal/Config.hs @@ -45,6 +45,49 @@ import System.Process import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) +{-| + +'Accum' is a monoid. + +It's '<>' behavior is analogous to 1 and 0 with '*'. Think of 'DontCare' +as 1 and 'Zlich' as 0. + +The behavior of 'Merge' is like 'Just's. + +@since 1.17.0.0 +-} +data Accum a = DontCare | Zlich | Merge a + deriving stock (Show, Eq, Ord, Functor) + +instance Applicative Accum where + pure = Merge + af <*> ax = case (af, ax) of + (Merge f, Merge x) -> Merge $ f x + + (DontCare, _) -> DontCare + (_, DontCare) -> DontCare + + (Zlich, _) -> Zlich + (_, Zlich) -> Zlich + +instance Semigroup a => Semigroup (Accum a) where + x <> y = case (x, y) of + (DontCare, b) -> b + (a , DontCare ) -> a + + (Zlich , _ ) -> Zlich + (_ , Zlich) -> Zlich + + (Merge a, Merge b) -> Merge $ a <> b + +getAccum :: Accum a -> Maybe a +getAccum = \case + Merge a -> Just a + _ -> Nothing + +instance Monoid a => Monoid (Accum a) where + mempty = DontCare + prettyMap :: (Pretty a, Pretty b) => Map a b -> Doc prettyMap theMap = let xs = Map.toList theMap @@ -395,9 +438,9 @@ -- @since 1.16.0.0 data Plan = Plan { logger :: Last Logger - , initDbConfig :: Maybe ProcessConfig + , initDbConfig :: Accum ProcessConfig , copyConfig :: Last (Maybe CopyDirectoryCommand) - , createDbConfig :: Maybe ProcessConfig + , createDbConfig :: Accum ProcessConfig , postgresPlan :: PostgresPlan , postgresConfigFile :: [String] , dataDirectoryString :: Last String @@ -413,11 +456,11 @@ pretty Plan {..} = text "initDbConfig:" <> softline - <> indent 2 (pretty initDbConfig) + <> indent 2 (pretty $ getAccum initDbConfig) <> hardline <> text "initDbConfig:" <> softline - <> indent 2 (pretty createDbConfig) + <> indent 2 (pretty $ getAccum createDbConfig) <> text "copyConfig:" <> softline <> indent 2 (pretty (getLast copyConfig)) @@ -447,16 +490,16 @@ $ (,,,,,) <$> getOption "logger" logger <*> eitherToErrors (addErrorContext "initDbConfig: " $ - traverse (completeProcessConfig envs) initDbConfig) + traverse (completeProcessConfig envs) $ getAccum initDbConfig) <*> eitherToErrors (addErrorContext "createDbConfig: " $ - traverse (completeProcessConfig envs) createDbConfig) + traverse (completeProcessConfig envs) $ getAccum createDbConfig) <*> eitherToErrors (addErrorContext "postgresPlan: " (completePostgresPlan envs postgresPlan)) <*> getOption "dataDirectoryString" dataDirectoryString <*> getOption "connectionTimeout" connectionTimeout let completePlanConfig = unlines postgresConfigFile - completePlanCopy =completeCopyDirectory completePlanDataDirectory <$> + completePlanCopy = completeCopyDirectory completePlanDataDirectory <$> join (getLast copyConfig) pure CompletePlan {..} @@ -464,12 +507,12 @@ -- Returns 'True' if the 'Plan' has a -- 'Just' 'initDbConfig'. hasInitDb :: Plan -> Bool -hasInitDb Plan {..} = isJust initDbConfig +hasInitDb Plan {..} = isJust $ getAccum initDbConfig -- Returns 'True' if the 'Plan' has a -- 'Just' 'createDbConfig'. hasCreateDb :: Plan -> Bool -hasCreateDb Plan {..} = isJust createDbConfig +hasCreateDb Plan {..} = isJust $ getAccum createDbConfig -- | The high level options for overriding default behavior. -- @@ -672,7 +715,7 @@ -> FilePath -- ^ The @postgres@ data directory. -> Plan -toPlan makeInitDb makeCreateDb port socketDirectory dataDirectoryString = mempty +toPlan _makeInitDb makeCreateDb port socketDirectory dataDirectoryString = mempty { postgresConfigFile = socketDirectoryToConfig socketDirectory , dataDirectoryString = pure dataDirectoryString , connectionTimeout = pure (60 * 1000000) -- 1 minute @@ -701,18 +744,33 @@ ] } } - else Nothing - , initDbConfig = if makeInitDb - then pure $ standardProcessConfig + else mempty + + , initDbConfig = pure $ standardProcessConfig { commandLine = mempty { keyBased = Map.fromList [("--pgdata=", Just dataDirectoryString)] } } - else Nothing , copyConfig = pure Nothing } + +-- | 'combinePlans' is almost '<>'. However the 'Last' monoid for +-- @createdb@ and @initdb@ plans are not used. Instead something +-- like Lastoid is. +combinePlans :: Plan -> Plan -> Plan +combinePlans x y = Plan + { logger = logger x <> logger y + , initDbConfig = initDbConfig x <> initDbConfig y + , copyConfig = copyConfig x <> copyConfig y + , createDbConfig = createDbConfig x <> createDbConfig y + , postgresPlan = postgresPlan x <> postgresPlan y + , postgresConfigFile = postgresConfigFile x <> postgresConfigFile y + , dataDirectoryString = dataDirectoryString x <> dataDirectoryString y + , connectionTimeout = connectionTimeout x <> connectionTimeout y + } + -- | Create all the temporary resources from a 'Config'. This also combines the -- 'Plan' from 'toPlan' with the @extra@ 'Config' passed in. setupConfig @@ -734,7 +792,7 @@ thePort (toFilePath resourcesSocketDirectory) (toFilePath resourcesDataDir) - finalPlan = hostAndDir <> plan + finalPlan = combinePlans hostAndDir plan uncachedPlan <- lift $ either (throwIO . CompletePlanFailed (show $ pretty finalPlan)) pure $ completePlan envs finalPlan @@ -827,7 +885,7 @@ -- Create a 'Plan' given a user. userToPlan :: String -> Plan userToPlan user = mempty - { initDbConfig = pure $ mempty + { initDbConfig = pure mempty { commandLine = mempty { keyBased = Map.singleton "--username=" $ Just user } @@ -842,7 +900,7 @@ dbnameToPlan muser mpassword dbName | dbName == "template1" || dbName == "postgres" = mempty | otherwise = mempty - { createDbConfig = pure $ mempty + { createDbConfig = pure mempty { commandLine = mempty { indexBased = Map.singleton 0 dbName , keyBased = maybe mempty (Map.singleton "--username=" . Just) muser @@ -1005,9 +1063,9 @@ -- | Lens for 'createDbConfig'. -- --- @since 1.12.0.0 +-- @since 1.17.0.0 createDbConfigL :: - Lens' Plan (Maybe ProcessConfig) + Lens' Plan (Accum ProcessConfig) createDbConfigL f (plan@Plan{..}) = fmap (\x -> plan { createDbConfig = x }) (f createDbConfig) @@ -1034,7 +1092,7 @@ -- | Lens for 'initDbConfig'. -- -- @since 1.12.0.0 -initDbConfigL :: Lens' Plan (Maybe ProcessConfig) +initDbConfigL :: Lens' Plan (Accum ProcessConfig) initDbConfigL f (plan@Plan{..}) = fmap (\x -> plan { initDbConfig = x }) (f initDbConfig) diff --git a/src/Database/Postgres/Temp/Internal/Core.hs b/src/Database/Postgres/Temp/Internal/Core.hs --- a/src/Database/Postgres/Temp/Internal/Core.hs +++ b/src/Database/Postgres/Temp/Internal/Core.hs @@ -86,6 +86,8 @@ | FailedToFindDataDirectory String -- ^ Failed to find a data directory when trying to get -- a cached @initdb@ folder. + | SnapshotCopyFailed String ExitCode + -- ^ We tried to copy a data directory to a snapshot folder and it failed deriving (Show, Eq, Typeable) instance Exception StartError @@ -360,6 +362,10 @@ = text "completePlanInitDb:" <> softline <> indent 2 (pretty completePlanInitDb) + <> hardline + <> text "completePlanCopy:" + <> softline + <> indent 2 (pretty completePlanCopy) <> hardline <> text "completePlanCreateDb:" <> softline diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -6,6 +6,7 @@ import Data.Maybe import Data.Monoid import Data.Monoid.Generic +-- import Data.Int import Data.List import qualified Data.Set as Set import Data.String @@ -35,10 +36,6 @@ withConfig' :: Config -> (DB -> IO a) -> IO a withConfig' config = either throwIO pure <=< withConfig config -withNewDbConfig' :: ProcessConfig -> DB -> (DB -> IO a) -> IO a -withNewDbConfig' config db = either throwIO pure <=< - withNewDbConfig config db - countPostgresProcesses :: IO Int countPostgresProcesses = countProcesses "postgres" @@ -158,7 +155,7 @@ expectedPassword = "password" expectedHost = "localhost" - cConfig = optionsToDefaultConfig mempty + cConfig' = optionsToDefaultConfig mempty { Client.port = pure expectedPort , Client.dbname = pure expectedDbName , Client.user = pure expectedUser @@ -166,6 +163,8 @@ , Client.host = pure expectedHost } + cConfig = cConfig' { plan = (plan cConfig') { logger = pure print }} + cAssert db = do let Client.Options {..} = toConnectionOptions db port `shouldBe` pure expectedPort @@ -321,7 +320,7 @@ { cConfig = silentConfig { dataDirectory = Permanent dirPath , plan = (plan silentConfig) - { initDbConfig = Nothing + { initDbConfig = Zlich } } } @@ -472,7 +471,7 @@ let dontTimeout = silentConfig { plan = (plan silentConfig) { connectionTimeout = pure maxBound - , initDbConfig = Nothing + , initDbConfig = Zlich } } @@ -559,54 +558,31 @@ happyPaths errorPaths --- I nest the db creation to make sure I can do that -withNewDbSpecs :: Spec -withNewDbSpecs = describe "withNewDb" $ do - it "works" $ withConfig' silentConfig $ \db -> do +withSnapshotSpecs :: Spec +withSnapshotSpecs = describe "withSnapshot" $ do + it "works" $ withConfig' defaultConfig $ \db -> do + -- TODO create a table withConn db $ \conn -> do - _ <- PG.execute_ conn "CREATE TABLE foo ( id int );" - void $ PG.execute_ conn "INSERT INTO foo (id) VALUES (1);" - - withNewDbConfig' mempty db $ \newDb -> do - one <- fmap (PG.fromOnly . head) $ - withConn newDb $ \conn -> PG.query_ conn "SELECT id FROM foo" - - one `shouldBe` (1 :: Int) - - let expectedDbName = "newname" - specificDbName = mempty - { commandLine = mempty - { indexBased = - Map.singleton 0 expectedDbName - } - } - - withNewDbConfig' specificDbName db $ \newerDb -> do - Client.dbname (toConnectionOptions newerDb) `shouldBe` - pure expectedDbName - - oneAgain <- fmap (PG.fromOnly . head) $ - withConn newerDb $ \conn -> PG.query_ conn "SELECT id FROM foo" + _ <- PG.execute_ conn "BEGIN; CREATE TABLE foo ( id int );" + void $ PG.execute_ conn "INSERT INTO foo (id) VALUES (1); END;" - oneAgain `shouldBe` (1 :: Int) + either throwIO pure <=< withSnapshot Temporary db $ \snapshotDir -> do + snapshotConfig <- (defaultConfig <>) + <$> configFromSavePoint (toFilePath snapshotDir) - let invalidConfig = silentProcessConfig - { commandLine = mempty - { indexBased = - Map.singleton 0 "template1" - } - } + let snapshotConfigAndAssert = ConfigAndAssertion snapshotConfig $ flip withConn $ \conn -> do + oneAgain <- fmap (PG.fromOnly . head) $ PG.query_ conn "SELECT id FROM foo" + oneAgain `shouldBe` (1 :: Int) - withNewDbConfig invalidConfig db (const $ pure ()) >>= \case - Right () -> fail "Should not succeed" - Left (CreateDbFailed {}) -> pure () - Left err -> fail $ "Wrong type of error " <> show err + testWithTemporaryDirectory + snapshotConfigAndAssert + testSuccessfulConfig spec :: Spec spec = do withConfigSpecs - withNewDbSpecs + withSnapshotSpecs it "stopPostgres cannot be connected to" $ withConfig' silentConfig $ \db -> do stopPostgres db `shouldReturn` ExitSuccess diff --git a/tmp-postgres.cabal b/tmp-postgres.cabal --- a/tmp-postgres.cabal +++ b/tmp-postgres.cabal @@ -1,5 +1,5 @@ name: tmp-postgres -version: 1.16.1.0 +version: 1.17.0.0 synopsis: Start and stop a temporary postgres description: Start and stop a temporary postgres. See README.md homepage: https://github.com/jfischoff/tmp-postgres#readme @@ -104,6 +104,7 @@ ghc-options: -O2 -Wall build-depends: base , criterion + , deepseq , postgres-options , postgresql-simple , tmp-postgres