tmp-postgres 0.1.2.0 → 0.1.2.1

raw patch · 3 files changed

+39/−12 lines, 3 filesdep +async

Dependencies added: async

Files

• src/Database/Postgres/Temp/Internal.hs +15/−9
• test/Database/Postgres/Temp/InternalSpec.hs +21/−1
• tmp-postgres.cabal +3/−2

@@ -17,6 +17,8 @@ import qualified Data.ByteString.Char8 as BSC import Control.Monad (void) import Network.Socket.Free (openFreePort)+import Data.Foldable+import Control.Concurrent.Async(race_)  getFreePort :: IO Int getFreePort = do@@ -82,6 +84,7 @@ data StartError   = InitDBFailed   ExitCode   | CreateDBFailed [String] ExitCode+  | StartPostgresFailed [String] ExitCode   deriving (Show, Eq, Typeable)  instance Exception StartError@@ -167,17 +170,20 @@       connectionString = makeConnectionString "test"   logger StartPostgres   let extraOptions = map (\(key, value) -> "--" ++ key ++ "=" ++ value) options+      postgresOptions = ["-D", dataDir, "-p", show port] ++ extraOptions   bracketOnError ( fmap (DB mainDir connectionString . fourth)                  $ createProcess_ "postgres"-                     ( procWith stdOut stdErr-                      "postgres"-                      $ ["-D", dataDir, "-p", show port] ++ extraOptions-                     )+                     (procWith stdOut stdErr "postgres" postgresOptions)                  )                  stop                  $ \result -> do++    let checkForCrash =+          getProcessExitCode (pid result) >>=+            traverse_ (throwIO . StartPostgresFailed postgresOptions)+     logger WaitForDB-    waitForDB $ makeConnectionString "template1"+    waitForDB (makeConnectionString "template1") `race_` checkForCrash      logger CreateDB     let createDBHostArgs = case socketType of@@ -210,18 +216,18 @@   e <- try $ bracket (PG.connectPostgreSQL $ BSC.pack connectionString)           PG.close           $ \conn -> do-            void $ PG.execute_ conn "select pg_terminate_backend(pid) from pg_stat_activity where datname='test';" +            void $ PG.execute_ conn "select pg_terminate_backend(pid) from pg_stat_activity where datname='test';"   case e of     Left (_ :: IOError) -> pure () -- expected-    Right _ -> pure () -- Surprising ... but I do not know yet if this is a failure of termination or not. +    Right _ -> pure () -- Surprising ... but I do not know yet if this is a failure of termination or not.  -- | Stop postgres and clean up the temporary database folder. stop :: DB -> IO ExitCode stop db@DB {..} = do    withProcessHandle pid (\case-         OpenHandle p   -> do -          -- try to terminate the connects first. If we can't terminate still +         OpenHandle p   -> do+          -- try to terminate the connects first. If we can't terminate still           -- keep shutting down           terminateConnections db 

@@ -12,9 +12,9 @@ import Database.PostgreSQL.Simple import qualified Data.ByteString.Char8 as BSC import System.Exit+import System.Timeout(timeout) import Data.Either - main :: IO () main = hspec spec @@ -69,6 +69,26 @@         conn <- connectPostgreSQL $ BSC.pack $ connectionString db         [Only actualDuration] <- query_ conn "SHOW log_min_duration_statement"         actualDuration `shouldBe` expectedDuration++    it "dies promptly when a bad setting is passed" $ \mainFilePath -> do+      stdOut <- mkDevNull+      stdErr <- mkDevNull+      r <- timeout 5000000 $ startWithLogger print Unix +            [ ("log_directory", "/this/does/not/exist")+            , ("logging_collector", "true")+            ] mainFilePath stdOut stdErr+      case r of+        Nothing ->+          -- bad test, shouldSatisfy is difficult because it wants Show on DB.+          -- anyway, point of this is to fail if we timed out.+          1 `shouldBe` (2 :: Int)+        Just (Right x) ->+          -- this would be very surprising but if it somehow manages to do something useful despite+          -- bad config ... ok i guess? regardless, should clean up.+          void $ stop x+        Just (Left _) -> do+          -- if it fails here that's fine & expected.+          pure ()      it "terminateConnections" $ \mainFilePath -> do       stdOut <- mkDevNull

@@ -1,5 +1,5 @@ name:                tmp-postgres-version:             0.1.2.0+version:             0.1.2.1 synopsis: Start and stop a temporary postgres for testing description:  This module provides functions creating a temporary postgres instance on a random port for testing.@@ -17,7 +17,7 @@  The start methods use a config based on the one used by pg_tmp (http://ephemeralpg.org/), but can be overriden  by different values to the first argument of the start functions.  .- MacOS and Linux are support. Windows is not. + MacOS and Linux are support. Windows is not.  .  Requires PostgreSQL 9.3+  .@@ -50,6 +50,7 @@                , bytestring                , postgresql-simple                , port-utils+               , async   ghc-options: -Wall   default-language:    Haskell2010