diff options
| -rw-r--r-- | erebos.cabal | 9 | ||||
| -rw-r--r-- | src/Erebos/Storage/Internal.hs | 35 | ||||
| -rw-r--r-- | src/unix/Erebos/Storage/Platform.hs | 20 |
3 files changed, 39 insertions, 25 deletions
diff --git a/erebos.cabal b/erebos.cabal index bc3000d..45e6526 100644 --- a/erebos.cabal +++ b/erebos.cabal @@ -1,4 +1,4 @@ -Cabal-Version: 2.2 +Cabal-Version: 3.0 Name: erebos Version: 0.1.4 @@ -117,6 +117,7 @@ library other-modules: Erebos.Flow Erebos.Storage.List + Erebos.Storage.Platform Erebos.Util c-sources: @@ -157,10 +158,14 @@ library stm >=2.5 && <2.6, text >= 1.2 && <2.2, time >= 1.8 && <1.14, - unix >=2.7 && <2.9, uuid >=1.3 && <1.4, zlib >=0.6 && <0.8 + if true + hs-source-dirs: src/unix + build-depends: + unix ^>= { 2.7, 2.8 }, + executable erebos import: common default-language: Haskell2010 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 |