From d91afd37deb0eb8494400be90072edf0dc493fc4 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Wed, 14 Feb 2018 13:12:50 +0200
Subject: [PATCH] Use file instead of dir locking #187 (#203)

* Use file instead of dir locking #187

This commit simply imports the code from the filelock package verbatim
into a subdirectory, filelock. Depending on filelock as an external
package instead would be more straightforward, but I'm not sure what the
rules for external dependencies are here.

* Switch to upstream filelock

Given that the extra dependency doesn't seem to be a problem, remove the
inlined code. If in fact the dependency should be avoided, just ignore
this commit and use the parent.
---
 hackage-security/hackage-security.cabal       |  1 +
 .../src/Hackage/Security/Util/IO.hs           | 24 +++++++++----------
 stack.yaml                                    |  1 +
 3 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/hackage-security/hackage-security.cabal b/hackage-security/hackage-security.cabal
index 03efc8da..802c244d 100644
--- a/hackage-security/hackage-security.cabal
+++ b/hackage-security/hackage-security.cabal
@@ -103,6 +103,7 @@ library
                        Cabal             >= 1.14    && < 2.2,
                        containers        >= 0.4     && < 0.6,
                        ed25519           >= 0.0     && < 0.1,
+                       filelock          >= 0.1.1   && < 0.2,
                        filepath          >= 1.2     && < 1.5,
                        mtl               >= 2.2     && < 2.3,
                        parsec            >= 3.1     && < 3.2,
diff --git a/hackage-security/src/Hackage/Security/Util/IO.hs b/hackage-security/src/Hackage/Security/Util/IO.hs
index 1601b7b4..f5101acf 100644
--- a/hackage-security/src/Hackage/Security/Util/IO.hs
+++ b/hackage-security/src/Hackage/Security/Util/IO.hs
@@ -11,6 +11,7 @@ import Control.Exception
 import Data.Time
 import System.IO hiding (openTempFile, withFile)
 import System.IO.Error
+import qualified System.FileLock as FL
 
 import Hackage.Security.Util.Path
 
@@ -30,22 +31,19 @@ handleDoesNotExist act =
         then return Nothing
         else throwIO e
 
--- | Attempt to create a filesystem lock in the specified directory
+-- | Attempt to create a filesystem lock in the specified directory.
 --
--- Given a file @/path/to@, we do this by attempting to create the directory
--- @//path/to/hackage-security-lock@, and deleting the directory again
--- afterwards. Creating a directory that already exists will throw an exception
--- on most OSs (certainly Linux, OSX and Windows) and is a reasonably common way
--- to implement a lock file.
+-- This will use OS-specific file locking primitives, and throw an
+-- exception if the lock is already present.
 withDirLock :: Path Absolute -> IO a -> IO a
-withDirLock dir = bracket_ takeLock releaseLock
+withDirLock dir act = do
+    res <- FL.withTryFileLock lock FL.Exclusive (const act)
+    case res of
+        Just a -> return a
+        Nothing -> error $ "withFileLock: lock already exists: " ++ lock
   where
-    lock :: Path Absolute
-    lock = dir </> fragment "hackage-security-lock"
-
-    takeLock, releaseLock :: IO ()
-    takeLock    = createDirectory lock
-    releaseLock = removeDirectory lock
+    lock :: FilePath
+    lock = toFilePath $ dir </> fragment "hackage-security-lock"
 
 {-------------------------------------------------------------------------------
   Debugging
diff --git a/stack.yaml b/stack.yaml
index 53cb73e2..3263628a 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -10,3 +10,4 @@ packages:
 - precompute-fileinfo
 extra-deps:
 - http-client-0.5.5
+- filelock-0.1.1.2