tmp-postgres 1.20.0.1 → 1.21.0.0
raw patch · 7 files changed
+90/−105 lines, 7 files
Files
- CHANGELOG.md +7/−4
- benchmark/Main.hs +11/−11
- src/Database/Postgres/Temp.hs +1/−1
- src/Database/Postgres/Temp/Internal.hs +40/−53
- src/Database/Postgres/Temp/Internal/Config.hs +4/−4
- test/Main.hs +26/−31
- tmp-postgres.cabal +1/−1
CHANGELOG.md view
@@ -1,18 +1,21 @@ Changelog for tmp-postgres +1.21.0.0+ #165 Make silent the default.+ 1.20.0.1 #164 Documentation fixes. 1.20.0.0- #144 Make a CacheResources type- #162 Make a Snapshot alias+ #144 Make a CacheResources type.+ #162 Make a Snapshot alias. 1.19.0.1- #146 Better version hashing for making cache directories+ #146 Better version hashing for making cache directories. Documentation fixes 1.19.0.0- #154 Change 'createDefaultCacheConfig` to `defaultCacheConfig`+ #154 Change 'createDefaultCacheConfig` to `defaultCacheConfig`. 1.18.0.0 #143 Remove the withNewDb API
benchmark/Main.hs view
@@ -2,7 +2,7 @@ import Control.DeepSeq import Control.Exception import Control.Monad-import Criterion.Main+import Criterion.Main hiding (defaultConfig) import Data.String import Database.Postgres.Temp.Internal import Database.Postgres.Temp.Internal.Config@@ -17,7 +17,7 @@ defaultConfigDefaultInitDb = mempty { plan = mempty { logger = pure mempty- , postgresConfigFile = defaultPostgresConfig+ , postgresConfigFile = fastPostgresConfig , initDbConfig = pure mempty } }@@ -46,21 +46,21 @@ setupCache :: IO CacheResources setupCache = do cacheInfo <- setupInitDbCache defaultCacheConfig- void (withConfig (silentConfig <> toCacheConfig cacheInfo) (const $ pure ()))+ void (withConfig (defaultConfig <> toCacheConfig cacheInfo) (const $ pure ())) pure cacheInfo setupWithCache :: (Config -> Benchmark) -> Benchmark-setupWithCache f = envWithCleanup setupCache cleanupInitDbCache $ f . (silentConfig <>) . toCacheConfig+setupWithCache f = envWithCleanup setupCache cleanupInitDbCache $ f . (defaultConfig <>) . toCacheConfig setupCacheAndSP :: IO (CacheResources, Snapshot, Once Config) setupCacheAndSP = do cacheInfo <- setupCache- let cacheConfig = silentConfig <> toCacheConfig cacheInfo+ let cacheConfig = defaultConfig <> toCacheConfig cacheInfo sp <- either throwIO pure <=< withConfig cacheConfig $ \db -> do migrateDb db either throwIO pure =<< takeSnapshot Temporary db - let theConfig = silentConfig <> snapshotConfig sp <> cacheConfig+ let theConfig = defaultConfig <> snapshotConfig sp <> cacheConfig pure (cacheInfo, sp, Once theConfig)@@ -81,12 +81,12 @@ -- withConfig defaultConfigDefaultInitDb $ const $ pure () {- bench "withConfig silent" $ whnfIO $- withConfig silentConfig $ const $ pure ()+ withConfig defaultConfig $ const $ pure () , setupWithCache $ \cacheConfig -> bench "withConfig silent cache" $ whnfIO $ withConfig cacheConfig $ const $ pure () - , bench "with migrate 10x" $ whnfIO $ replicateM 10 $ withConfig silentConfig $ \db ->+ , bench "with migrate 10x" $ whnfIO $ replicateM 10 $ withConfig defaultConfig $ \db -> migrateDb db >> testQuery db -}@@ -99,7 +99,7 @@ , setupWithCache $ \cacheConfig -> bench "withSnapshot migrate 10x and cache" $ whnfIO $ withConfig cacheConfig $ \db -> do migrateDb db void $ withSnapshot Temporary db $ \snapshotDir -> do- let theSnapshotConfig = silentConfig <> snapshotConfig snapshotDir+ let theSnapshotConfig = defaultConfig <> snapshotConfig snapshotDir replicateM_ 10 $ withConfig theSnapshotConfig testQuery {- , setupWithCacheAndSP $ \theConfig -> bench "withConfig pre-setup with withSnapshot" $ whnfIO $@@ -107,10 +107,10 @@ , setupWithCacheAndSP' $ \sp -> bench "snapshotConfig" $ whnfIO $ void $ snapshotConfig $ toFilePath sp - , bench "migrateDb" $ perRunEnvWithCleanup (either throwIO (pure . Once) =<< startConfig silentConfig) (stop . unOnce) $+ , bench "migrateDb" $ perRunEnvWithCleanup (either throwIO (pure . Once) =<< startConfig defaultConfig) (stop . unOnce) $ \ ~(Once db) -> migrateDb db -}- , bench "withSnapshot" $ perRunEnvWithCleanup (either throwIO (pure . Once) =<< startConfig silentConfig) (stop . unOnce) $+ , bench "withSnapshot" $ perRunEnvWithCleanup (either throwIO (pure . Once) =<< startConfig defaultConfig) (stop . unOnce) $ \ ~(Once db) -> void $ withSnapshot Temporary db $ const $ pure () ]
src/Database/Postgres/Temp.hs view
@@ -87,7 +87,7 @@ , defaultConfig , defaultPostgresConf , standardProcessConfig- , silentConfig+ , verboseConfig , silentProcessConfig , defaultCacheConfig , snapshotConfig
src/Database/Postgres/Temp/Internal.hs view
@@ -98,9 +98,9 @@ ------------------------------------------------------------------------------- -- | Default postgres options ----- @since 1.12.0.0-defaultPostgresConfig :: [String]-defaultPostgresConfig =+-- @since 1.21.0.0+verbosePostgresConfig :: [String]+verbosePostgresConfig = [ "shared_buffers = 12MB" , "fsync = off" , "synchronous_commit = off"@@ -108,7 +108,7 @@ , "log_min_duration_statement = 0" , "log_connections = on" , "log_disconnections = on"- , "client_min_messages = ERROR"+ , "client_min_messages = WARNING" ] {-|@@ -124,9 +124,9 @@ fsync = off synchronous_commit = off full_page_writes = off- log_min_duration_statement = 0- log_connections = on- log_disconnections = on+ log_min_messages = PANIC+ log_min_error_statement = PANIC+ log_statement = none client_min_messages = ERROR @ @@ -140,7 +140,8 @@ your @postgres@ might start and run faster if you use 'defaultConfig'. -The 'defaultConfig' also disables the logging of internal 'Event's.+The 'defaultConfig' redirects all output to @\/dev\/null@. See+'verboseConfig' for a version that logs more output. To append additional lines to \"postgresql.conf\" file create a custom 'Config' like the following.@@ -177,14 +178,12 @@ As an alternative to using 'defaultConfig' one could create a config from connections parameters using 'optionsToDefaultConfig'. --@since 1.12.0.0+@since 1.21.0.0 -} defaultConfig :: Config defaultConfig = mempty { plan = mempty- { logger = pure mempty- , postgresConfigFile = defaultPostgresConfig+ { postgresConfigFile = fastPostgresConfig , initDbConfig = pure mempty { commandLine = mempty { keyBased = Map.singleton "--no-sync" Nothing@@ -211,7 +210,7 @@ 'defaultPostgresConf' extra = 'defaultConfig' & 'planL' . 'postgresConfigFileL' <>~ extra @ -@since 1.12.0.0+@since 1.21.0.0 -} defaultPostgresConf :: [String] -> Config defaultPostgresConf extra = defaultConfig <> mempty@@ -222,12 +221,23 @@ {-|-A config that logs as little as possible.+The fastest config we can make. -@since 1.14.0.0+ @+ shared_buffers = 12MB+ fsync = off+ synchronous_commit = off+ full_page_writes = off+ log_min_messages = PANIC+ log_min_error_statement = PANIC+ log_statement = none+ client_min_messages = ERROR+ @++@since 1.21.0.0 -}-silentPostgresConfig :: [String]-silentPostgresConfig =+fastPostgresConfig :: [String]+fastPostgresConfig = [ "shared_buffers = 12MB" , "fsync = off" , "synchronous_commit = off"@@ -239,31 +249,18 @@ ] {-|-The similar to 'defaultConfig' but all the handles are set to @\/dev\/null@.-and uses a @postgresql.conf@ which disables logging:-- @- shared_buffers = 12MB- fsync = off- synchronous_commit = off- full_page_writes = off- log_min_messages = PANIC- log_min_error_statement = PANIC- log_statement = none- client_min_messages = ERROR- @--See 'silentProcessConfig' as well.+The similar to 'defaultConfig' log as much as possible. -@since 1.14.0.0+@since 1.21.0.0 -}-silentConfig :: Config-silentConfig = defaultConfig <> mempty+verboseConfig :: Config+verboseConfig = defaultConfig <> mempty { plan = mempty- { postgresConfigFile = silentPostgresConfig- , initDbConfig = pure silentProcessConfig+ { logger = pure print+ , postgresConfigFile = verbosePostgresConfig+ , initDbConfig = pure standardProcessConfig , postgresPlan = mempty- { postgresConfig = silentProcessConfig+ { postgresConfig = standardProcessConfig } } }@@ -323,7 +320,7 @@ -- | Default start behavior. Equivalent to calling 'startConfig' with the -- 'defaultConfig'. ----- @since 1.12.0.0+-- @since 1.21.0.0 start :: IO (Either StartError DB) start = startConfig defaultConfig @@ -380,7 +377,7 @@ Exception safe database create with options. See 'startConfig' for more details. Calls 'stop' even in the face of exceptions. -@since 1.15.0.0+@since 1.21.0.0 -} withConfig :: Config -- ^ @extra@. 'Config' combined with the generated 'Config'. See@@ -397,7 +394,7 @@ 'with' = 'withConfig' 'defaultConfig' @ -@since 1.15.0.0+@since 1.21.0.0 -} with :: (DB -> IO a) -- ^ @action@ continuation.@@ -415,19 +412,9 @@ -- want to create a database owned by a specific user you will also login -- with among other use cases. ----- @since 1.15.0.0+-- @since 1.21.0.0 optionsToDefaultConfig :: Client.Options -> Config-optionsToDefaultConfig opts@Client.Options {..} =- let generated = optionsToConfig opts- startingConfig =- if createDbConfig (plan generated) == mempty- then defaultConfig- else defaultConfig <> mempty- { plan = mempty- { createDbConfig = pure standardProcessConfig- }- }- in startingConfig <> generated+optionsToDefaultConfig opts = defaultConfig <> optionsToConfig opts ------------------------------------------------------------------------------- -- Pretty Printing
src/Database/Postgres/Temp/Internal/Config.hs view
@@ -721,9 +721,9 @@ { postgresConfigFile = socketDirectoryToConfig socketDirectory , dataDirectoryString = pure dataDirectoryString , connectionTimeout = pure (60 * 1000000) -- 1 minute- , logger = pure print+ , logger = pure $ const $ pure () , postgresPlan = mempty- { postgresConfig = standardProcessConfig+ { postgresConfig = silentProcessConfig { commandLine = mempty { keyBased = Map.fromList [ ("-p", Just $ show port)@@ -738,7 +738,7 @@ } } , createDbConfig = if makeCreateDb- then pure $ standardProcessConfig+ then pure $ silentProcessConfig { commandLine = mempty { keyBased = Map.fromList $ [ ("-h", Just socketDirectory)@@ -748,7 +748,7 @@ } else mempty - , initDbConfig = pure $ standardProcessConfig+ , initDbConfig = pure $ silentProcessConfig { commandLine = mempty { keyBased = Map.fromList [("--pgdata=", Just dataDirectoryString)]
test/Main.hs view
@@ -155,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@@ -163,8 +163,6 @@ , Client.host = pure expectedHost } - cConfig = cConfig' { plan = (plan cConfig') { logger = pure print }}- cAssert db = do let Client.Options {..} = toConnectionOptions db port `shouldBe` pure expectedPort@@ -226,9 +224,6 @@ in ConfigAndAssertion {..} -silentConfigAssert :: ConfigAndAssertion-silentConfigAssert = ConfigAndAssertion silentConfig mempty- defaultConfigAssert :: ConfigAndAssertion defaultConfigAssert = ConfigAndAssertion defaultConfig mempty @@ -272,7 +267,7 @@ it "postgres db name does not cause createdb failure" $ do testWithTemporaryDirectory- ( silentConfigAssert+ ( defaultConfigAssert <> memptyConfigAndAssertion <> ConfigAndAssertion (optionsToDefaultConfig mempty { Client.dbname = pure "postgres" }) mempty )@@ -280,7 +275,7 @@ it "template1 db name does not cause createdb failure" $ do testWithTemporaryDirectory- ( silentConfigAssert+ ( defaultConfigAssert <> memptyConfigAndAssertion' "template1" <> ConfigAndAssertion (optionsToDefaultConfig mempty { Client.dbname = pure "template1" }) mempty )@@ -300,26 +295,26 @@ it "default ip option works" $ testWithTemporaryDirectory- (silentConfigAssert <> defaultIpConfig)+ (defaultConfigAssert <> defaultIpConfig) testSuccessfulConfig it "specific unix socket works" $ withTempDirectory "/tmp" "tmp-postgres-spec-socket" $ \socketFilePath -> testWithTemporaryDirectory- (silentConfigAssert <> specificUnixSocket socketFilePath)+ (defaultConfigAssert <> specificUnixSocket socketFilePath) testSuccessfulConfig it "works with the default temporary directory to some degree at least" $- testSuccessfulConfigNoTmp $ silentConfigAssert <>+ testSuccessfulConfigNoTmp $ defaultConfigAssert <> memptyConfigAndAssertion <> createdbAndDescription it "works if on non-empty if initdb is disabled" $ withTempDirectory "/tmp" "tmp-postgres-preinitdb" $ \dirPath -> do throwIfNotSuccess id =<< system ("initdb " <> dirPath) let nonEmptyFolderConfig = memptyConfigAndAssertion- { cConfig = silentConfig+ { cConfig = defaultConfig { dataDirectory = Permanent dirPath- , plan = (plan silentConfig)+ , plan = (plan defaultConfig) { initDbConfig = Zlich } }@@ -328,7 +323,7 @@ it "makeResourcesDataDirPermanent works" $ withTempDirectory "/tmp" "tmp-postgres-make-premanent" $ \dirPath -> do- let config = silentConfig { temporaryDirectory = pure dirPath }+ let config = defaultConfig { temporaryDirectory = pure dirPath } pathToCheck <- bracket (either throwIO (pure . makeDataDirPermanent) =<< startConfig config) stop $ pure . toDataDirectory doesDirectoryExist pathToCheck >>= \case@@ -337,7 +332,7 @@ it "withDbCacheConfig actually caches the config and cleans up" $ withTempDirectory "/tmp" "tmp-postgres-cache-test" $ \dirPath -> do- let config = silentConfig { temporaryDirectory = pure dirPath }+ let config = defaultConfig { temporaryDirectory = pure dirPath } cacheConfig = CacheConfig { cacheTemporaryDirectory = dirPath , cacheDirectoryType = Temporary@@ -387,7 +382,7 @@ it "withDbCache seems to work" $ withDbCache $ \cacheInfo ->- either throwIO pure =<< withConfig (silentConfig <> toCacheConfig cacheInfo) assertConnection+ either throwIO pure =<< withConfig (defaultConfig <> toCacheConfig cacheInfo) assertConnection -- -- Error Plans. Can't be combined. Just list them out inline since they can't be combined@@ -408,7 +403,7 @@ } } }- withConfig (silentConfig <> invalidConfig) (const $ pure ())+ withConfig (defaultConfig <> invalidConfig) (const $ pure ()) `shouldReturn` Left ConnectionTimedOut it "does not timeout quickly with an invalid connection and large timeout" $ do@@ -422,7 +417,7 @@ } } }- timeout 100000 (withConfig (silentConfig <> invalidConfig) (const $ pure ()))+ timeout 100000 (withConfig (defaultConfig <> invalidConfig) (const $ pure ())) `shouldReturn` Nothing {- it "throws StartPostgresFailed if the port is taken" $@@ -468,8 +463,8 @@ `shouldReturn` Left (StartPostgresFailed $ ExitFailure 1) it "No initdb plan causes failure" $ do- let dontTimeout = silentConfig- { plan = (plan silentConfig)+ let dontTimeout = defaultConfig+ { plan = (plan defaultConfig) { connectionTimeout = pure maxBound , initDbConfig = Zlich }@@ -481,7 +476,7 @@ it "initdb with non-empty data directory fails with InitDbFailed" $ withTempDirectory "/tmp" "tmp-postgres-test" $ \dirPath -> do writeFile (dirPath <> "/PG_VERSION") "1 million"- let nonEmptyFolderPlan = silentConfig+ let nonEmptyFolderPlan = defaultConfig { dataDirectory = Permanent dirPath } @@ -494,8 +489,8 @@ Left err -> fail $ "Wrong type of error " <> show err it "invalid initdb options cause an error" $ do- let invalidConfig = silentConfig- { plan = (plan silentConfig)+ let invalidConfig = defaultConfig+ { plan = (plan defaultConfig) { initDbConfig = pure silentProcessConfig { commandLine = mempty { keyBased = Map.singleton "--super-sync" Nothing@@ -509,8 +504,8 @@ Left err -> fail $ "Wrong type of error " <> show err it "invalid createdb plan causes an error" $ do- let invalidConfig = silentConfig- { plan = (plan silentConfig)+ let invalidConfig = defaultConfig+ { plan = (plan defaultConfig) { createDbConfig = pure silentProcessConfig { commandLine = mempty { indexBased =@@ -529,7 +524,7 @@ path <- getEnv "PATH" bracket (setEnv "PATH" "/foo") (const $ setEnv "PATH" path) $ \_ ->- withConfig silentConfig (const $ pure ())+ withConfig defaultConfig (const $ pure ()) `shouldThrow` isDoesNotExistError it "throws if createdb is not on the path" $@@ -543,8 +538,8 @@ path <- getEnv "PATH" - let config = silentConfig- { plan = (plan silentConfig)+ let config = defaultConfig+ { plan = (plan defaultConfig) { createDbConfig = pure mempty } }@@ -582,12 +577,12 @@ withSnapshotSpecs - it "stopPostgres cannot be connected to" $ withConfig' silentConfig $ \db -> do+ it "stopPostgres cannot be connected to" $ withConfig' defaultConfig $ \db -> do stopPostgres db `shouldReturn` ExitSuccess PG.connectPostgreSQL (toConnectionString db) `shouldThrow` (\(_ :: IOError) -> True) - it "reloadConfig works" $ withConfig' silentConfig $ \db -> do+ it "reloadConfig works" $ withConfig' defaultConfig $ \db -> do let dataDir = toDataDirectory db expectedDuration = "100ms"@@ -627,7 +622,7 @@ shouldSatisfy (Set.fromList $ words configString) $ Set.isSubsetOf wordsToSearchFor - it "prettyPrintDB seems to work" $ withConfig' (createdbPlan <> silentConfig) $ \db -> do+ it "prettyPrintDB seems to work" $ withConfig' (createdbPlan <> defaultConfig) $ \db -> do let dbString = prettyPrintDB db wordsToSearchFor = Set.fromList
tmp-postgres.cabal view
@@ -1,5 +1,5 @@ name: tmp-postgres-version: 1.20.0.1+version: 1.21.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