From 414f810c7c1d9aedeaa45e0998537395e7f4a907 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 29 Jun 2024 16:39:57 +0200
Subject: Move platform-specific code to separate directory

---
 src/Erebos/Storage/Internal.hs      | 35 ++++++++++++-----------------------
 src/unix/Erebos/Storage/Platform.hs | 20 ++++++++++++++++++++
 2 files changed, 32 insertions(+), 23 deletions(-)
 create mode 100644 src/unix/Erebos/Storage/Platform.hs

(limited to 'src')

diff --git a/src/Erebos/Storage/Internal.hs b/src/Erebos/Storage/Internal.hs
index a61e705..116d7fa 100644
--- a/src/Erebos/Storage/Internal.hs
+++ b/src/Erebos/Storage/Internal.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-
 module Erebos.Storage.Internal where
 
 import Codec.Compression.Zlib
@@ -38,8 +36,8 @@ import System.INotify (INotify)
 import System.IO
 import System.IO.Error
 import System.IO.Unsafe (unsafePerformIO)
-import System.Posix.Files
-import System.Posix.IO
+
+import Erebos.Storage.Platform
 
 
 data Storage' c = Storage
@@ -230,16 +228,7 @@ refPath spath rdgst = intercalate "/" [spath, "objects", BC.unpack alg, pref, re
 openLockFile :: FilePath -> IO Handle
 openLockFile path = do
     createDirectoryIfMissing True (takeDirectory path)
-    fd <- retry 10 $
-#if MIN_VERSION_unix(2,8,0)
-        openFd path WriteOnly defaultFileFlags
-            { creat = Just $ unionFileModes ownerReadMode ownerWriteMode
-            , exclusive = True
-            }
-#else
-        openFd path WriteOnly (Just $ unionFileModes ownerReadMode ownerWriteMode) (defaultFileFlags { exclusive = True })
-#endif
-    fdToHandle fd
+    retry 10 $ createFileExclusive path
   where
     retry :: Int -> IO a -> IO a
     retry 0 act = act
@@ -249,34 +238,34 @@ openLockFile path = do
 writeFileOnce :: FilePath -> BL.ByteString -> IO ()
 writeFileOnce file content = bracket (openLockFile locked)
     hClose $ \h -> do
-        fileExist file >>= \case
-            True  -> removeLink locked
+        doesFileExist file >>= \case
+            True  -> removeFile locked
             False -> do BL.hPut h content
                         hFlush h
-                        rename locked file
+                        renameFile locked file
     where locked = file ++ ".lock"
 
 writeFileChecked :: FilePath -> Maybe ByteString -> ByteString -> IO (Either (Maybe ByteString) ())
 writeFileChecked file prev content = bracket (openLockFile locked)
     hClose $ \h -> do
-        (prev,) <$> fileExist file >>= \case
+        (prev,) <$> doesFileExist file >>= \case
             (Nothing, True) -> do
                 current <- B.readFile file
-                removeLink locked
+                removeFile locked
                 return $ Left $ Just current
             (Nothing, False) -> do B.hPut h content
                                    hFlush h
-                                   rename locked file
+                                   renameFile locked file
                                    return $ Right ()
             (Just expected, True) -> do
                 current <- B.readFile file
                 if current == expected then do B.hPut h content
                                                hFlush h
-                                               rename locked file
+                                               renameFile locked file
                                                return $ return ()
-                                       else do removeLink locked
+                                       else do removeFile locked
                                                return $ Left $ Just current
             (Just _, False) -> do
-                removeLink locked
+                removeFile locked
                 return $ Left Nothing
     where locked = file ++ ".lock"
diff --git a/src/unix/Erebos/Storage/Platform.hs b/src/unix/Erebos/Storage/Platform.hs
new file mode 100644
index 0000000..2198f61
--- /dev/null
+++ b/src/unix/Erebos/Storage/Platform.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE CPP #-}
+
+module Erebos.Storage.Platform (
+    createFileExclusive,
+) where
+
+import System.IO
+import System.Posix.Files
+import System.Posix.IO
+
+createFileExclusive :: FilePath -> IO Handle
+createFileExclusive path = fdToHandle =<< do
+#if MIN_VERSION_unix(2,8,0)
+    openFd path WriteOnly defaultFileFlags
+        { creat = Just $ unionFileModes ownerReadMode ownerWriteMode
+        , exclusive = True
+        }
+#else
+    openFd path WriteOnly (Just $ unionFileModes ownerReadMode ownerWriteMode) (defaultFileFlags { exclusive = True })
+#endif
-- 
cgit v1.2.3