diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2024-06-29 16:39:57 +0200 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2024-06-29 17:58:42 +0200 |
commit | 414f810c7c1d9aedeaa45e0998537395e7f4a907 (patch) | |
tree | d01b84764ecc32843da60ef6bcb5a311e3ef1be7 /src/Erebos/Storage/Internal.hs | |
parent | 15f7d82c37cb1b0e12a1eade91e0db2e132d4c60 (diff) |
Move platform-specific code to separate directory
Diffstat (limited to 'src/Erebos/Storage/Internal.hs')
-rw-r--r-- | src/Erebos/Storage/Internal.hs | 35 |
1 files changed, 12 insertions, 23 deletions
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" |