tmp-postgres 1.33.0.0 → 1.34.0.0
raw patch · 4 files changed
+54/−27 lines, 4 filesdep −filepath
Dependencies removed: filepath
Files
- CHANGELOG.md +4/−0
- src/Database/Postgres/Temp/Internal.hs +39/−19
- test/Main.hs +10/−6
- tmp-postgres.cabal +1/−2
CHANGELOG.md view
@@ -1,5 +1,9 @@ Changelog for tmp-postgres +1.34.0.0+ #235 Take two to solve deadlocking on cacheAction. This time it is still possible but fixes #239+ #239 First time action cache is made get cp failure+ 1.33.0.0 #240 cacheAction should create the parent directories
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@@ -23,8 +24,6 @@ import System.Process import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) import System.Directory-import System.Directory.Internal.Prelude-import System.FilePath -- | Handle for holding temporary resources, the @postgres@ process handle -- and @postgres@ connection information. The 'DB' also includes the@@ -663,7 +662,20 @@ ------------------------------------------------------------------------------- -- cacheAction -------------------------------------------------------------------------------+cacheActionLocks :: MVar (Map.Map FilePath (MVar ()))+cacheActionLocks = unsafePerformIO $ newMVar mempty+{-# NOINLINE cacheActionLocks #-} +withActionLock :: FilePath -> IO a -> IO a+withActionLock filePath action = do+ theLock <- modifyMVar cacheActionLocks $ \theMap -> do+ theLock <- case Map.lookup filePath theMap of+ Nothing -> newMVar ()+ Just x -> pure x+ pure (Map.insert filePath theLock theMap, theLock)++ withMVar theLock $ \_ -> action+ {-| Check to see if a cached data directory exists. @@ -682,7 +694,19 @@ remigrate as long as the migration does not change. See 'withSnapshot' for a ephemeral version of taking snapshots. -@since 1.33.0.0+You can nest calls to cacheAction and safe to call it from several threads.+However 'cacheAction' uses locks internal to prevent multiple threads from+stomping on each other.++If one makes a nested call and accidently uses the same cache directory+in both calls the calls will deadlock. If this occurs on the same thread+RTS will throw an exception. However do not rely on this and just be+careful to not reuse the same cache path when nesting calls.++There is no good reuse the cache path when nesting so one is unlikely to+run into this.++@since 1.34.0.0 -} cacheAction :: FilePath@@ -695,22 +719,18 @@ cacheAction cachePath action config = do fixCachePath <- fixPath cachePath let result = config <> fromFilePathConfig fixCachePath- parentPath = joinPath $ init $ splitPath fixCachePath - createDirectoryIfMissing True parentPath-- preexisting <- try (createDirectory fixCachePath) >>= \case- Left e | isAlreadyExistsError e -> pure True- Left e -> throwIO e- Right () -> pure False+ withActionLock fixCachePath $ do+ nonEmpty <- doesFileExist $ fixCachePath <> "/PG_VERSION" - if preexisting then pure $ pure result else fmap join $ withConfig config $ \db -> do- -- TODO see if parallel is better- action db `onException` removeDirectoryRecursive fixCachePath- throwIfNotSuccess id =<< stopPostgresGracefully db+ 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+ let snapshotCopyCmd = cpFlags <>+ toDataDirectory db <> "/* " <> fixCachePath+ system snapshotCopyCmd >>= \case+ ExitSuccess -> pure $ pure result+ x -> pure $ Left $ SnapshotCopyFailed snapshotCopyCmd x
test/Main.hs view
@@ -567,6 +567,10 @@ cacheActionSpecs :: Spec cacheActionSpecs = describe "cacheAction" $ do+ let configTest config = testWithTemporaryDirectory+ (ConfigAndAssertion config mempty)+ testSuccessfulConfig+ it "creates the cache if it does not exist" $ do let action db = withConn db $ \conn -> do _ <- PG.execute_ conn "BEGIN; CREATE TABLE foo ( id int );"@@ -652,35 +656,35 @@ let differentCachePath = cachePath <> "/cached1" cacheAction differentCachePath (const $ pure ()) defaultConfig >>= \case Left err -> fail $ "Second call should succeed but failed with " <> show err- Right _ -> pure ()+ Right config -> configTest config theFinalCachePath = cachePath <> "/cached" cacheAction theFinalCachePath action defaultConfig >>= \case Left err -> fail $ "First call should succeed but failed with " <> show err- Right _ -> pure ()+ Right config -> configTest config it "doesnt deadlock if the parent directory is missing" $ do withTempDirectory "/tmp" "tmp-postgres-cache-action" $ \cachePath -> do let theFinalCachePath = cachePath <> "/parent/child" cacheAction theFinalCachePath (const $ pure ()) defaultConfig >>= \case Left err -> fail $ "First call should succeed but failed with " <> show err- Right _ -> pure ()+ Right config -> configTest config it "doesnt deadlock if the parent directory is missing multithreaded version" $ do withTempDirectory "/tmp" "tmp-postgres-cache-action" $ \cachePath -> do let theFinalCachePath = cachePath <> "/parent/child"- threadBody = cacheAction theFinalCachePath (const $ pure ()) defaultConfig+ threadBody = cacheAction theFinalCachePath mempty defaultConfig thread1 <- Async.async threadBody thread2 <- Async.async threadBody Async.wait thread1 >>= \case Left err -> fail $ "First call should succeed but failed with " <> show err- Right _ -> pure ()+ Right config -> configTest config Async.wait thread2 >>= \case Left err -> fail $ "Second call should succeed but failed with " <> show err- Right _ -> pure ()+ Right config -> configTest config spec :: Spec spec = do
tmp-postgres.cabal view
@@ -1,5 +1,5 @@ name: tmp-postgres-version: 1.33.0.0+version: 1.34.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@@ -47,7 +47,6 @@ , cryptohash-sha1 , deepseq , directory- , filepath , generic-monoid , port-utils , postgres-options >= 0.2.0.0