tmp-postgres 1.31.0.1 → 1.31.0.2
raw patch · 4 files changed
+41/−12 lines, 4 files
Files
- CHANGELOG.md +3/−0
- src/Database/Postgres/Temp/Internal.hs +17/−11
- test/Main.hs +19/−0
- tmp-postgres.cabal +2/−1
CHANGELOG.md view
@@ -1,5 +1,8 @@ Changelog for tmp-postgres +1.31.0.2+ #230 Fix bug when the same cache is built concurrently.+ 1.31.0.1 #227 remove mention of defaultPostgresConf in doc #228 add track_io_timing = on to verboseConfig
src/Database/Postgres/Temp/Internal.hs view
@@ -9,6 +9,7 @@ import Database.Postgres.Temp.Internal.Core import Database.Postgres.Temp.Internal.Config +import Control.Concurrent import qualified Control.Concurrent.Async as Async import Control.DeepSeq import Control.Exception@@ -661,6 +662,9 @@ ------------------------------------------------------------------------------- -- cacheAction -------------------------------------------------------------------------------+cacheLock :: MVar ()+cacheLock = unsafePerformIO $ newMVar ()+ {-| Check to see if a cached data directory exists. @@ -692,16 +696,18 @@ cacheAction cachePath action config = do fixCachePath <- fixPath cachePath let result = config <> fromFilePathConfig fixCachePath- nonEmpty <- doesFileExist $ fixCachePath <> "/PG_VERSION" - if nonEmpty then pure $ pure result else fmap join $ withConfig config $ \db -> do- action db- -- TODO see if parallel is better- throwIfNotSuccess id =<< stopPostgresGracefully db- createDirectoryIfMissing True fixCachePath+ withMVar cacheLock $ \_ -> do+ nonEmpty <- doesFileExist $ fixCachePath <> "/PG_VERSION" - let snapshotCopyCmd = cpFlags <>- toDataDirectory db <> "/* " <> fixCachePath- system snapshotCopyCmd >>= \case- ExitSuccess -> pure $ pure result- x -> pure $ Left $ SnapshotCopyFailed snapshotCopyCmd x+ if nonEmpty then pure $ pure result else fmap join $ withConfig config $ \db -> do+ action db+ -- TODO see if parallel is better+ throwIfNotSuccess id =<< stopPostgresGracefully db+ createDirectoryIfMissing True fixCachePath++ let snapshotCopyCmd = cpFlags <>+ toDataDirectory db <> "/* " <> fixCachePath+ system snapshotCopyCmd >>= \case+ ExitSuccess -> pure $ pure result+ x -> pure $ Left $ SnapshotCopyFailed snapshotCopyCmd x
test/Main.hs view
@@ -1,4 +1,5 @@ import Control.Concurrent+import qualified Control.Concurrent.Async as Async import Control.Exception import Control.Monad ((<=<), void, unless) import Data.Function@@ -27,6 +28,7 @@ import System.Process import System.Timeout import Test.Hspec+import Data.Either withConn :: DB -> (PG.Connection -> IO a) -> IO a withConn db f = do@@ -382,6 +384,8 @@ either throwIO pure <=< withConfig (cacheConfig cacheInfo <> verboseConfig) $ \db -> do assertConnection db withConn db $ \conn -> countDbs conn `shouldReturn` 3++ -- -- Error Plans. Can't be combined. Just list them out inline since they can't be combined --@@ -625,6 +629,21 @@ cacheAction theFinalCachePath action (defaultConfig { dataDirectory = Permanent theFinalCachePath } ) >>= \case Left (SnapshotCopyFailed {}) -> pure () _ -> fail $ "cacheAction should have failed with SnapshotCopyFailed"++ it "works if two threads try to create a cache at the same time" $ do+ withTempDirectory "/tmp" "tmp-postgres-parallel-cache-test" $ \dirPath -> do+ -- let dirPath = "/tmp/tmp-postgres-parallel-cache-test-1"+ withDbCache $ \cacheInfo -> do+ lock <- newEmptyMVar+ let+ theConfig = defaultConfig <> cacheConfig cacheInfo+ waitIfSecond _ = do+ tryPutMVar lock () >>= \case+ True -> pure ()+ False -> threadDelay 100000+ theCacheAction = cacheAction dirPath waitIfSecond theConfig+ res <- Async.replicateConcurrently 3 theCacheAction+ if all isRight res then pure () else fail "Failed to create caches concurrently" spec :: Spec spec = do
tmp-postgres.cabal view
@@ -1,5 +1,5 @@ name: tmp-postgres-version: 1.31.0.1+version: 1.31.0.2 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@@ -65,6 +65,7 @@ hs-source-dirs: test main-is: Main.hs build-depends: base+ , async , containers , directory , generic-monoid