tmp-postgres 1.21.1.0 → 1.21.1.1
raw patch · 6 files changed
+64/−55 lines, 6 files
Files
- CHANGELOG.md +3/−0
- src/Database/Postgres/Temp/Internal.hs +3/−2
- src/Database/Postgres/Temp/Internal/Config.hs +4/−23
- src/Database/Postgres/Temp/Internal/Core.hs +41/−22
- test/Main.hs +12/−7
- tmp-postgres.cabal +1/−1
CHANGELOG.md view
@@ -1,5 +1,8 @@ Changelog for tmp-postgres +1.21.1.1+ #172 Fix verboseLogging not working+ 1.21.1.0 #135 Add defaultConfig_9_3_10 #170 Expose cacheResourcesToConfig
src/Database/Postgres/Temp/Internal.hs view
@@ -196,7 +196,7 @@ defaultConfig :: Config defaultConfig = mempty { plan = mempty- { postgresConfigFile = fastPostgresConfig+ { postgresConfigFile = verbosePostgresConfig , initDbConfig = pure mempty { commandLine = mempty { keyBased = Map.singleton "--no-sync" Nothing@@ -217,7 +217,7 @@ defaultConfig_9_3_10 :: Config defaultConfig_9_3_10 = mempty { plan = mempty- { postgresConfigFile = fastPostgresConfig+ { postgresConfigFile = verbosePostgresConfig , initDbConfig = pure mempty { commandLine = mempty { keyBased = Map.singleton "--nosync" Nothing@@ -279,6 +279,7 @@ { logger = pure print , postgresConfigFile = verbosePostgresConfig , initDbConfig = pure standardProcessConfig+ , createDbConfig = pure standardProcessConfig , postgresPlan = mempty { postgresConfig = standardProcessConfig }
src/Database/Postgres/Temp/Internal/Config.hs view
@@ -215,9 +215,6 @@ deriving Semigroup via GenericSemigroup ProcessConfig deriving Monoid via GenericMonoid ProcessConfig -prettyHandle :: Handle -> Doc-prettyHandle _ = text "[HANDLE]"- instance Pretty ProcessConfig where pretty ProcessConfig {..} = text "environmentVariables:"@@ -562,7 +559,7 @@ socketDirectoryToConfig :: FilePath -> [String] socketDirectoryToConfig dir =- [ "listen_addresses = '127.0.0.1, ::1'"+ [ "listen_addresses = '127.0.0.1,::1'" , "unix_socket_directories = '" <> dir <> "'" ] @@ -738,7 +735,7 @@ } } , createDbConfig = if makeCreateDb- then pure $ silentProcessConfig+ then pure silentProcessConfig { commandLine = mempty { keyBased = Map.fromList [ ("-h", Just socketDirectory)@@ -748,7 +745,7 @@ } else mempty - , initDbConfig = pure $ silentProcessConfig+ , initDbConfig = pure silentProcessConfig { commandLine = mempty { keyBased = Map.fromList [("--pgdata=", Just dataDirectoryString)]@@ -757,22 +754,6 @@ , 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@@ -794,7 +775,7 @@ thePort (toFilePath resourcesSocketDirectory) (toFilePath resourcesDataDir)- finalPlan = combinePlans hostAndDir plan+ finalPlan = hostAndDir <> plan uncachedPlan <- lift $ either (throwIO . CompletePlanFailed (show $ pretty finalPlan)) pure $ completePlan envs finalPlan
src/Database/Postgres/Temp/Internal/Core.hs view
@@ -44,8 +44,15 @@ -- ^ The fourth event and (possibly all subsequent events). -- We are looping trying to successfully connect to the @postgres@ -- process.- deriving (Show, Eq, Ord)+ deriving (Eq, Ord) +instance Show Event where+ show = \case+ StartPlan x -> "StartPlan:\n" <> x+ StartPostgres -> "StartPostgres"+ WaitForDB -> "WaitForDB"+ TryToConnect -> "TryToConnect"+ -- | A list of failures that can occur when starting. This is not -- and exhaustive list but covers the errors that the system -- catches for the user.@@ -97,6 +104,12 @@ -- @since 1.12.0.0 type Logger = Event -> IO () +-- A simple helper to throw 'ExitCode's when they are 'ExitFailure'.+throwIfNotSuccess :: Exception e => (ExitCode -> e) -> ExitCode -> IO ()+throwIfNotSuccess f = \case+ ExitSuccess -> pure ()+ e -> throwIO $ f e+ -- | @postgres@ is not ready until we are able to successfully connect. -- 'waitForDB' attempts to connect over and over again and returns -- after the first successful connection.@@ -138,6 +151,9 @@ -- ^ The 'Handle' for standard error } +prettyHandle :: Handle -> Doc+prettyHandle _ = text "HANDLE"+ prettyKeyPair ::(Pretty a, Pretty b) => a -> b -> Doc prettyKeyPair k v = pretty k <> text ": " <> pretty v @@ -150,6 +166,15 @@ <> text "completeProcessConfigCmdLine:" <> softline <> text (unwords completeProcessConfigCmdLine)+ <> hardline+ <> text "completeProcessConfigStdIn:"+ <+> prettyHandle completeProcessConfigStdIn+ <> hardline+ <> text "completeProcessConfigStdOut:"+ <+> prettyHandle completeProcessConfigStdOut+ <> hardline+ <> text "completeProcessConfigStdErr:"+ <+> prettyHandle completeProcessConfigStdErr -- | Start a process interactively and return the 'ProcessHandle' startProcess@@ -198,8 +223,8 @@ ------------------------------------------------------------------------------- -- PostgresProcess Life cycle management ---------------------------------------------------------------------------------- | 'CompletePostgresPlan' is used be 'startPostgresProcess' to start the @postgres@--- and then attempt to connect to it.+-- | 'CompletePostgresPlan' is used be 'startPostgresProcess' to start the+-- @postgres@ and then attempt to connect to it. data CompletePostgresPlan = CompletePostgresPlan { completePostgresPlanProcessConfig :: CompleteProcessConfig -- ^ The process config for @postgres@@@ -300,7 +325,7 @@ return result ---------------------------------------------------------------------------------- Init command+-- Non interactive subcommands ------------------------------------------------------------------------------- executeInitDb :: CompleteProcessConfig -> IO () executeInitDb config = do@@ -337,15 +362,23 @@ copyCommand = cpFlags <> copyDirectoryCommandSrc <> "/* " <> copyDirectoryCommandDst throwIfNotSuccess (CopyCachedInitDbFailed copyCommand) =<< system copyCommand +-- | Call @createdb@ and tee the output to return if there is an+-- an exception. Throws 'CreateDbFailed'.+executeCreateDb :: CompleteProcessConfig -> IO ()+executeCreateDb config = do+ (res, stdOut, stdErr) <- executeProcessAndTee "createdb" config+ throwIfNotSuccess (CreateDbFailed stdOut stdErr) res ------------------------------------------------------------------------------- -- CompletePlan ---------------------------------------------------------------------------------- | 'CompletePlan' is the low level configuration necessary for creating a database+-- | 'CompletePlan' is the low level configuration necessary for initializing+-- a database cluster -- starting @postgres@ and creating a database. There is no validation done--- on the 'CompletePlan'. It is recommend that one use the higher level functions+-- on the 'CompletePlan'. It is recommend that one use the higher level+-- functions -- such as 'Database.Postgres.Temp.start' which will generate plans that--- are valid. 'CompletePlan's are used internally but are exposed if the higher--- level plan generation is not sufficent.+-- are valid. 'CompletePlan's are used internally but are exposed if the+-- higher level plan generation is not sufficent. data CompletePlan = CompletePlan { completePlanLogger :: Logger , completePlanInitDb :: Maybe CompleteProcessConfig@@ -382,19 +415,6 @@ <> text "completePlanDataDirectory:" <+> pretty completePlanDataDirectory --- A simple helper to throw 'ExitCode's when they are 'ExitFailure'.-throwIfNotSuccess :: Exception e => (ExitCode -> e) -> ExitCode -> IO ()-throwIfNotSuccess f = \case- ExitSuccess -> pure ()- e -> throwIO $ f e---- | Call @createdb@ and tee the output to return if there is an--- an exception. Throws 'CreateDbFailed'.-executeCreateDb :: CompleteProcessConfig -> IO ()-executeCreateDb config = do- (res, stdOut, stdErr) <- executeProcessAndTee "createdb" config- throwIfNotSuccess (CreateDbFailed stdOut stdErr) res- -- | 'startPlan' optionally calls @initdb@, optionally calls @createdb@ and -- unconditionally calls @postgres@. -- Additionally it writes a \"postgresql.conf\" and does not return until@@ -426,4 +446,3 @@ -- | Stop the @postgres@ process. See 'stopPostgresProcess' for more details. stopPlan :: PostgresProcess -> IO ExitCode stopPlan = stopPostgresProcess False-
test/Main.hs view
@@ -6,7 +6,6 @@ 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@@ -310,7 +309,8 @@ it "works if on non-empty if initdb is disabled" $ withTempDirectory "/tmp" "tmp-postgres-preinitdb" $ \dirPath -> do- throwIfNotSuccess id =<< system ("initdb " <> dirPath)+ throwIfNotSuccess id . (\(x, _, _) -> x) =<<+ readProcessWithExitCode "initdb" [dirPath] "" let nonEmptyFolderConfig = memptyConfigAndAssertion { cConfig = defaultConfig { dataDirectory = Permanent dirPath@@ -382,7 +382,7 @@ it "withDbCache seems to work" $ withDbCache $ \cacheInfo ->- either throwIO pure =<< withConfig (defaultConfig <> cacheResourcesToConfig cacheInfo) assertConnection+ either throwIO pure =<< withConfig (cacheResourcesToConfig cacheInfo) assertConnection -- -- Error Plans. Can't be combined. Just list them out inline since they can't be combined@@ -422,10 +422,17 @@ {- it "throws StartPostgresFailed if the port is taken" $ bracket openFreePort (N.close . snd) $ \(thePort, _) -> do- let invalidConfig = optionsToDefaultConfig mempty+ let invalidConfig' = optionsToDefaultConfig mempty { Client.port = pure thePort , Client.host = pure "127.0.0.1"+ } <> verboseConfig++ invalidConfig = invalidConfig'+ { plan = (plan invalidConfig')+ { connectionTimeout = pure 1000000+ } }+ withConfig invalidConfig (const $ pure ()) `shouldReturn` Left (StartPostgresFailed $ ExitFailure 1) -}@@ -591,7 +598,7 @@ reloadConfig db - bracket (PG.connectPostgreSQL $ toConnectionString db) PG.close $ \conn -> do+ withConn db $ \conn -> do [PG.Only actualDuration] <- PG.query_ conn "SHOW log_min_duration_statement" actualDuration `shouldBe` expectedDuration @@ -640,8 +647,6 @@ [ "wal_level=replica" , "archive_mode=on" , "max_wal_senders=2"- , "fsync=on"- , "synchronous_commit=on" ] backupResources = justBackupResources
tmp-postgres.cabal view
@@ -1,5 +1,5 @@ name: tmp-postgres-version: 1.21.1.0+version: 1.21.1.1 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