tmp-postgres 1.3.0.0 → 1.4.0.0
raw patch · 3 files changed
+32/−26 lines, 3 files
Files
- src/Database/Postgres/Temp/Internal/Partial.hs +12/−10
- test/Spec.hs +19/−15
- tmp-postgres.cabal +1/−1
src/Database/Postgres/Temp/Internal/Partial.hs view
@@ -52,7 +52,7 @@ -- inherit from the running process or they -- can be specifically added. data PartialEnvVars = PartialEnvVars- { partialEnvVarsInherit :: Bool+ { partialEnvVarsInherit :: Last Bool , partialEnvVarsSpecific :: Map String String } deriving stock (Generic, Show, Eq)@@ -60,21 +60,22 @@ instance Semigroup PartialEnvVars where x <> y = PartialEnvVars { partialEnvVarsInherit =- partialEnvVarsInherit x || partialEnvVarsInherit y+ partialEnvVarsInherit x <> partialEnvVarsInherit y , partialEnvVarsSpecific = partialEnvVarsSpecific y <> partialEnvVarsSpecific x } instance Monoid PartialEnvVars where- mempty = PartialEnvVars False mempty+ mempty = PartialEnvVars mempty mempty -- | Combine the current environment -- (if indicated by 'partialEnvVarsInherit') -- with 'partialEnvVarsSpecific'-completePartialEnvVars :: [(String, String)] -> PartialEnvVars -> [(String, String)]-completePartialEnvVars envs PartialEnvVars {..}- = if partialEnvVarsInherit then envs else []- <> Map.toList partialEnvVarsSpecific+completePartialEnvVars :: [(String, String)] -> PartialEnvVars -> Either [String] [(String, String)]+completePartialEnvVars envs PartialEnvVars {..} = case getLast partialEnvVarsInherit of+ Nothing -> Left ["Inherit not specified"]+ Just x -> Right $ (if x then envs else [])+ <> Map.toList partialEnvVarsSpecific -- | A type to help combine command line arguments. data PartialCommandLineArgs = PartialCommandLineArgs@@ -142,7 +143,7 @@ standardProcessConfig :: PartialProcessConfig standardProcessConfig = mempty { partialProcessConfigEnvVars = mempty- { partialEnvVarsInherit = True+ { partialEnvVarsInherit = pure True } , partialProcessConfigStdIn = pure stdin , partialProcessConfigStdOut = pure stdout@@ -164,8 +165,9 @@ completeProcessConfig :: [(String, String)] -> PartialProcessConfig -> Either [String] ProcessConfig completeProcessConfig envs PartialProcessConfig {..} = validationToEither $ do- let processConfigEnvVars = completePartialEnvVars envs partialProcessConfigEnvVars- processConfigCmdLine = completeCommandLineArgs partialProcessConfigCmdLine+ let processConfigCmdLine = completeCommandLineArgs partialProcessConfigCmdLine+ processConfigEnvVars <- eitherToValidation $+ completePartialEnvVars envs partialProcessConfigEnvVars processConfigStdIn <- getOption "partialProcessConfigStdIn" partialProcessConfigStdIn processConfigStdOut <-
test/Spec.hs view
@@ -64,7 +64,6 @@ extraConfig = "log_min_duration_statement='" <> expectedDuration <> "'" it "returns the right client options for the plan" $ do- let initialCreateDbConfig = standardProcessConfig let customPlan = mempty { configPlan = mempty { partialPlanPostgres = mempty@@ -74,31 +73,36 @@ , Client.dbname = pure expectedDbName } }- , partialPlanInitDb = pure mempty+ , partialPlanInitDb = pure standardProcessConfig { partialProcessConfigCmdLine = mempty { partialCommandLineArgsKeyBased = Map.singleton "--username=" $ Just "user-name" }- , partialProcessConfigEnvVars =- mempty { partialEnvVarsSpecific = Map.singleton "PGPASSWORD" "password" }+ , partialProcessConfigEnvVars = mempty+ { partialEnvVarsSpecific = Map.singleton "PGPASSWORD" "password"+ , partialEnvVarsInherit = pure True+ } } , partialPlanConfig = [extraConfig] } } -- hmm maybe I should provide lenses- let combinedResources = defaultConfig <> customPlan- finalCombinedResources = setCreateDb combinedResources $ pure initialCreateDbConfig+ let createDb = pure standardProcessConfig { partialProcessConfigCmdLine = mempty- { partialCommandLineArgsKeyBased =- Map.singleton "--username=" $ Just "user-name"- , partialCommandLineArgsIndexBased =- Map.singleton 0 expectedDbName- }+ { partialCommandLineArgsKeyBased =+ Map.singleton "--username=" $ Just "user-name"+ , partialCommandLineArgsIndexBased =+ Map.singleton 0 expectedDbName+ } , partialProcessConfigEnvVars =- mempty { partialEnvVarsSpecific = Map.singleton "PGPASSWORD" "password" }+ mempty+ { partialEnvVarsSpecific = Map.singleton "PGPASSWORD" "password"+ , partialEnvVarsInherit = pure True+ } }+ combinedResources = setCreateDb defaultConfig createDb <> customPlan - action finalCombinedResources $ \db@DB {..} -> do+ action combinedResources $ \db@DB {..} -> do bracket (PG.connectPostgreSQL $ toConnectionString db) PG.close $ \conn -> do [PG.Only actualDuration] <- PG.query_ conn "SHOW log_min_duration_statement" actualDuration `shouldBe` expectedDuration@@ -206,7 +210,7 @@ let startAction plan = bracket (either throwIO pure =<< startConfig plan) stop pure throwsIfInitDbIsNotOnThePath $ startAction defaultConfig invalidConfigFailsQuickly $ void . startAction- customConfigWork $ \plan f ->+ customConfigWork $ \plan@Config{..} f -> bracket (either throwIO pure =<< startConfig plan) stop f describe "with" $ do let startAction = either throwIO pure =<< with (const $ pure ())@@ -360,7 +364,7 @@ Just host = getLast $ Client.host $ postgresProcessClientConfig dbPostgresProcess backupCommand = "pg_basebackup -D " ++ baseBackupFile ++ " --format=tar -p" ++ show port ++ " -h" ++ host- putStrLn backupCommand+ system backupCommand `shouldReturn` ExitSuccess bracket (PG.connectPostgreSQL $ toConnectionString db ) PG.close $ \conn -> do
tmp-postgres.cabal view
@@ -1,5 +1,5 @@ name: tmp-postgres-version: 1.3.0.0+version: 1.4.0.0 synopsis: Start and stop a temporary postgres description: @tmp-postgres@ provides functions creating a temporary @postgres@ instance.