rio 0.1.5.0 → 0.1.6.0
raw patch · 7 files changed
+563/−14 lines, 7 files
Files
- ChangeLog.md +7/−0
- rio.cabal +7/−5
- src/RIO/File.hs +472/−0
- src/RIO/Prelude/IO.hs +8/−6
- src/RIO/Prelude/Logger.hs +14/−1
- src/RIO/Prelude/RIO.hs +2/−2
- test/RIO/FileSpec.hs +53/−0
ChangeLog.md view
@@ -1,5 +1,12 @@ # Changelog for rio +## 0.1.6.0++* Changed `logUseColor` to default to `False` on Windows, even when verbose and on the terminal+* Add `RIO.File` module which offers a family of file handling functions+ (`withBinaryFileDurable`, `withBinaryFileDurableAtomic`, among others.) with+ better durability and atomicity guarantees+ ## 0.1.5.0 * Re-export `Numeric.Natural.Natural` [#119](https://github.com/commercialhaskell/rio/issues/119)
rio.cabal view
@@ -1,13 +1,13 @@-cabal-version: >= 1.10+cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.29.0.+-- This file has been generated from package.yaml by hpack version 0.30.0. -- -- see: https://github.com/sol/hpack ----- hash: 065129e1a5740200c161b7c7db66dfdea6edee782d518b17f86ccd1a8defb48c+-- hash: bbb48d8141804c3559dabe44ac2317e1d0fae65893cea408ee1fb4297e974f6a name: rio-version: 0.1.5.0+version: 0.1.6.0 synopsis: A standard library for Haskell description: See README and Haddocks at <https://www.stackage.org/package/rio> category: Control@@ -19,8 +19,8 @@ license-file: LICENSE build-type: Simple extra-source-files:- ChangeLog.md README.md+ ChangeLog.md source-repository head type: git@@ -36,6 +36,7 @@ RIO.Char RIO.Char.Partial RIO.Directory+ RIO.File RIO.FilePath RIO.HashMap RIO.HashMap.Partial@@ -117,6 +118,7 @@ type: exitcode-stdio-1.0 main-is: Spec.hs other-modules:+ RIO.FileSpec RIO.ListSpec RIO.LoggerSpec RIO.Prelude.ExtraSpec
+ src/RIO/File.hs view
@@ -0,0 +1,472 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-|++== Rationale++This module offers functions to handle files that offer better durability and/or+atomicity.++== When to use the functions on this module?++Given the usage of this functions comes at a cost in performance, it is important+to consider what are the use cases that are ideal for each of the functions.++=== Not Durable and not Atomic++For this use case, you want to use the regular functions:++* 'System.IO.withBinaryFile'+* 'RIO.writeFileBinary'++The regular use case for this scenario happens when your program is dealing with+outputs that are never going to be consumed again by your program. For example,+imagine you have a program that generates sales reports for the last month, this+is a report that can be generated quickly; you don't really care if the output+file gets corrupted or lost at one particular execution of your program given+that is cheap to execute the data export program a second time. In other words,+your program doesn't /rely/ on the data contained in this file in order to work.++=== Atomic but not Durable++ Imagine a scenario where your program builds a temporary file that serves as an+intermediate step to a bigger task, like Object files (@.o@) in a compilation+process. The program will use an existing @.o@ file if it is present, or it will+build one from scratch if it is not. The file is not really required, but if it+is present, it *must* be valid and consistent. In this situation, you care about+atomicity, but not durability.++There is no function exported by this module that provides /only/ atomicity.++=== Durable but not Atomic++For this use case, you want to use the functions:++* 'withBinaryFileDurable'+* 'writeBinaryFileDurable'++The regular use case for this scenario happens when your program deals with file+modifications that must be guaranteed to be durable, but you don't care that+changes are consistent. If you use this function, more than likely your program+is ensuring consistency guarantees through other means, for example, SQLite uses+ the Write Ahead Log (WAL) algorithm to ensure changes are atomic at an+application level.++=== Durable and Atomic++For this use case, you can use the functions:++* 'withBinaryFileDurableAtomic'+* 'writeBinaryFileDurableAtomic'++The regular use case for this scenario happens when you want to ensure that+after a program is executed, the modifications done to a file are guaranteed to+be saved, and also that changes are rolled-back in case there is a failure (e.g.+hard reboot, shutdown, etc).++@since 0.1.6+-}+module RIO.File+ (+ writeBinaryFileDurable+ , writeBinaryFileDurableAtomic+ , withBinaryFileDurable+ , withBinaryFileDurableAtomic+ , ensureFileDurable+ )+ where++import RIO.Prelude.Reexports++#ifdef WINDOWS+import RIO.Prelude.IO++#else++import RIO.Directory (doesFileExist)+import RIO.ByteString (hPut)+import Data.Bits ((.|.))+import Data.Typeable (cast)+import Foreign.C (CInt (..), throwErrnoIfMinus1,+ throwErrnoIfMinus1Retry)+import GHC.IO.Device (IODeviceType (RegularFile))+import qualified GHC.IO.Device as Device+import qualified GHC.IO.FD as FD+import qualified GHC.IO.Handle.FD as HandleFD+import System.Directory (copyFile)+import System.FilePath (takeDirectory, takeFileName, (</>))+import System.Posix.Internals (CFilePath, c_close, c_safe_open,+ withFilePath)+import System.Posix.Types (CMode (..), Fd (..))+import System.IO (openBinaryTempFile)++#if MIN_VERSION_base(4,9,0)+import qualified GHC.IO.Handle.Types as HandleFD (Handle (..), Handle__ (..))+#endif+++-- TODO: Add a ticket/pull request to export this symbols from+-- System.Internal.Posix+--+-- NOTE: System.Posix.Internal doesn't re-export this constants so we have to+-- recreate-them here+foreign import ccall unsafe "HsBase.h __hscore_o_rdonly" o_RDONLY :: CInt+foreign import ccall unsafe "HsBase.h __hscore_o_wronly" o_WRONLY :: CInt+foreign import ccall unsafe "HsBase.h __hscore_o_rdwr" o_RDWR :: CInt+foreign import ccall unsafe "HsBase.h __hscore_o_append" o_APPEND :: CInt+foreign import ccall unsafe "HsBase.h __hscore_o_creat" o_CREAT :: CInt+foreign import ccall unsafe "HsBase.h __hscore_o_noctty" o_NOCTTY :: CInt++-- After here, we have our own imports+foreign import ccall safe "fcntl.h openat"+ c_safe_openat :: CInt -> CFilePath -> CInt -> CMode -> IO CInt++foreign import ccall safe "fcntl.h renameat"+ c_safe_renameat :: CInt -> CFilePath -> CInt -> CFilePath -> IO CInt++foreign import ccall safe "unistd.h fsync"+ c_safe_fsync :: CInt -> IO CInt++std_flags, output_flags, read_flags, write_flags, rw_flags,+ append_flags :: CInt+std_flags = o_NOCTTY+output_flags = std_flags .|. o_CREAT+read_flags = std_flags .|. o_RDONLY+write_flags = output_flags .|. o_WRONLY+rw_flags = output_flags .|. o_RDWR+append_flags = write_flags .|. o_APPEND++ioModeToFlags :: IOMode -> CInt+ioModeToFlags iomode =+ case iomode of+ ReadMode -> read_flags+ WriteMode -> write_flags+ ReadWriteMode -> rw_flags+ AppendMode -> append_flags++-- | Returns a low-level file descriptor for a directory path. This function+-- exists given the fact that 'openFile' does not work with directories.+--+-- If you use this function, make sure you are working on a masked state,+-- otherwise async exceptions may leave file descriptors open.+--+-- @since 0.1.6+openDir :: MonadIO m => FilePath -> m Fd+openDir fp+ -- TODO: Investigate what is the situation with Windows FS in regards to non_blocking+ -- NOTE: File operations _do not support_ non_blocking on various kernels, more+ -- info can be found here: https://ghc.haskell.org/trac/ghc/ticket/15153+ =+ liftIO $+ withFilePath fp $ \cFp ->+ Fd <$>+ (throwErrnoIfMinus1Retry "openDir" $+ c_safe_open cFp (ioModeToFlags ReadMode) 0o660)++-- | Closes a 'Fd' that points to a Directory.+--+-- @since 0.1.6+closeDirectory :: MonadIO m => Fd -> m ()+closeDirectory (Fd dirFd) =+ liftIO $+ void $+ throwErrnoIfMinus1Retry "closeDirectory" $ c_close dirFd++-- | Executes the low-level C function fsync on a C file descriptor+--+-- @since 0.1.6+fsyncFileDescriptor+ :: MonadIO m+ => String -- ^ Meta-description for error messages+ -> CInt -- ^ C File Descriptor+ -> m ()+fsyncFileDescriptor name cFd =+ liftIO $+ void $+ throwErrnoIfMinus1 ("fsync - " <> name) $+ c_safe_fsync cFd++-- | Opens a file from a directory, using this function in favour of a regular+-- 'openFile' guarantees that any file modifications are kept in the same+-- directory where the file was opened. An edge case scenario is a mount+-- happening in the directory where the file was opened while your program is+-- running.+--+-- If you use this function, make sure you are working on an masked state,+-- otherwise async exceptions may leave file descriptors open.+--+openFileFromDir :: (MonadIO m) => Fd -> FilePath -> IOMode -> m Handle+openFileFromDir (Fd dirFd) fp iomode =+ liftIO $+ withFilePath fp $ \f -> do+ bracketOnError+ (do fileFd <- throwErrnoIfMinus1Retry "openFileFromDir" $+ c_safe_openat dirFd f (ioModeToFlags iomode)+ 0o666 {- Can open directory with read only -}+ FD.mkFD+ fileFd+ iomode+ Nothing {- no stat -}+ False {- not a socket -}+ False {- non_blocking -}+ `onException` c_close fileFd)+ (liftIO . Device.close . fst)+ (\(fD, fd_type) -> do+ -- we want to truncate() if this is an open in WriteMode, but only if the+ -- target is a RegularFile. ftruncate() fails on special files like+ -- /dev/null.+ when (iomode == WriteMode && fd_type == RegularFile) $+ Device.setSize fD 0+ HandleFD.mkHandleFromFD fD fd_type fp iomode False Nothing)++-- | Opens a file using the openat C low-level API. This approach allows us to+-- get a file descriptor for the directory that contains the file, which we can+-- use later on to fsync the directory with.+--+-- If you use this function, make sure you are working on an masked state,+-- otherwise async exceptions may leave file descriptors open.+--+-- @since 0.1.6+openFileAndDirectory :: MonadUnliftIO m => FilePath -> IOMode -> m (Fd, Handle)+openFileAndDirectory absFp iomode = do+ let dir = takeDirectory absFp+ fp = takeFileName absFp++ bracketOnError (openDir dir) closeDirectory $ \dirFd -> do+ fileHandle <- openFileFromDir dirFd fp iomode+ return (dirFd, fileHandle)++-- | This sub-routine does the following tasks:+--+-- * It calls fsync and then closes the given Handle (mapping to a temporal/backup filepath)+-- * It calls fsync and then closes the containing directory of the file+--+-- These steps guarantee that the file changes are durable.+--+-- @since 0.1.6+closeFileDurable :: MonadIO m => Fd -> Handle -> m ()+closeFileDurable dirFd@(Fd cDirFd) h =+ liftIO $+ finally+ (do (withHandleFd h $ \fileFd ->+ fsyncFileDescriptor "closeFileDurable/File" (FD.fdFD fileFd))+ `finally` hClose h+ -- NOTE: Here we are purposefully not fsyncing the directory if the file fails to fsync+ fsyncFileDescriptor "closeFileDurable/Directory" cDirFd)+ (closeDirectory dirFd)++buildTemporaryFilePath :: MonadUnliftIO m => FilePath -> m FilePath+buildTemporaryFilePath filePath = do+ let+ dirFp = takeDirectory filePath+ fileFp = takeFileName filePath+ bracket (liftIO $ openBinaryTempFile dirFp fileFp)+ (hClose . snd)+ (return . fst)++toTmpFilePath :: MonadUnliftIO m => FilePath -> m FilePath+toTmpFilePath filePath =+ buildTemporaryFilePath (dirPath </> tmpFilename)+ where+ dirPath = takeDirectory filePath+ filename = takeFileName filePath+ tmpFilename = "." <> filename <> ".tmp"++withHandleFd :: Handle -> (FD.FD -> IO a) -> IO a+withHandleFd h cb =+ case h of+ HandleFD.FileHandle _ mv -> do+ withMVar mv $ \HandleFD.Handle__{HandleFD.haDevice = dev} ->+ case cast dev of+ Just fd -> cb fd+ Nothing -> error "withHandleFd: not a file handle"+ HandleFD.DuplexHandle {} -> error "withHandleFd: not a file handle"+++-- | This sub-routine does the following tasks:+--+-- * It calls fsync and then closes the given Handle (mapping to a temporal/backup filepath)+-- * It renames the file to the original path (using renameat)+-- * It calls fsync and then closes the containing directory of the file+--+-- These steps guarantee that the file is durable, and that the backup mechanism+-- for catastrophic failure is discarded after no error is thrown.+--+-- @since 0.1.6+closeFileDurableAtomic ::+ MonadUnliftIO m => FilePath -> FilePath -> Fd -> Handle -> m ()+closeFileDurableAtomic tmpFilePath filePath dirFd@(Fd cDirFd) fileHandle = do+ liftIO $+ finally+ (withFilePath tmpFilePath $ \tmpFp ->+ withFilePath filePath $ \fp -> do+ (withHandleFd fileHandle $ \fileFd ->+ fsyncFileDescriptor "closeFileDurableAtomic/File" (FD.fdFD fileFd))+ `finally` hClose fileHandle+ renameFile tmpFp fp+ fsyncFileDescriptor "closeFileDurableAtomic/Directory" cDirFd)+ (closeDirectory dirFd)+ where+ renameFile tmpFp origFp =+ void $+ throwErrnoIfMinus1Retry "closeFileDurableAtomic - renameFile" $+ c_safe_renameat cDirFd tmpFp cDirFd origFp++#endif++-- | After a file is closed, it opens it again and executes fsync internally on+-- both the file and the directory that contains it. Note this function is+-- intended to work around the non-durability of existing file APIs, as opposed+-- to being necessary for the API functions provided in 'RIO.File' module.+--+-- [The effectiveness of calling this function is+-- debatable](https://stackoverflow.com/questions/37288453/calling-fsync2-after-close2/50158433#50158433),+-- as it relies on internal implementation details at the Kernel level that+-- might change. We argue that, despite this fact, calling this function may+-- bring benefits in terms of durability.+--+-- === Cross-Platform support+--+-- This function is a noop on Windows platforms.+--+-- @since 0.1.6+ensureFileDurable :: MonadUnliftIO m => FilePath -> m ()+ensureFileDurable absFp =+#if WINDOWS+ absFp `seq` return ()+#else+ bracket (openFileAndDirectory absFp ReadMode)+ (uncurry closeFileDurable)+ (const $ return ())+#endif+++-- | Similar to 'writeFileBinary', but it also ensures that changes executed to+-- the file are guaranteed to be durable. It internally uses fsync and makes+-- sure it synchronizes the file on disk.+--+-- === Cross-Platform support+--+-- This function behaves the same as 'RIO.writeFileBinary' on Windows platforms.+--+-- @since 0.1.6+writeBinaryFileDurable :: MonadUnliftIO m => FilePath -> ByteString -> m ()+writeBinaryFileDurable absFp bytes =+#if WINDOWS+ writeFileBinary absFp bytes+#else+ withBinaryFileDurable absFp WriteMode (liftIO . (`hPut` bytes))+#endif++-- | Similar to 'writeFileBinary', but it also guarantes that changes executed+-- to the file are durable, also, in case of failure, the modified file is never+-- going to get corrupted. It internally uses fsync and makes sure it+-- synchronizes the file on disk.+--+-- === Cross-Platform support+--+-- This function behaves the same as 'RIO.writeFileBinary' on Windows platforms.+--+-- @since 0.1.6+writeBinaryFileDurableAtomic :: MonadUnliftIO m => FilePath -> ByteString -> m ()+writeBinaryFileDurableAtomic fp bytes =+#if WINDOWS+ writeFileBinary fp bytes+#else+ withBinaryFileDurableAtomic fp WriteMode (liftIO . (`hPut` bytes))+#endif++-- | Opens a file with the following guarantees:+--+-- * It successfully closes the file in case of an asynchronous exception+--+-- * It reliably saves the file in the correct directory; including edge case+-- situations like a different device being mounted to the current directory,+-- or the current directory being renamed to some other name while the file is+-- being used.+--+-- * It ensures durability by executing an fsync call before closing the file+-- handle+--+-- === Cross-Platform support+--+-- This function behaves the same as 'System.IO.withBinaryFile' on Windows platforms.+--+-- @since 0.1.6+withBinaryFileDurable ::+ MonadUnliftIO m => FilePath -> IOMode -> (Handle -> m r) -> m r+withBinaryFileDurable absFp iomode cb =+#if WINDOWS+ withBinaryFile absFp iomode cb+#else+ withRunInIO $ \run ->+ bracket+ (openFileAndDirectory absFp iomode)+ (uncurry closeFileDurable)+ (run . cb . snd)+#endif++-- | Opens a file with the following guarantees:+--+-- * It successfully closes the file in case of an asynchronous exception+--+-- * It reliably saves the file in the correct directory; including edge case+-- situations like a different device being mounted to the current directory,+-- or the current directory being renamed to some other name while the file is+-- being used.+--+-- * It ensures durability by executing an fsync call before closing the file+-- handle+--+ -- * It keeps all changes in a temporary file, and after it is closed it atomically+-- moves the temporal file to the original filepath, in case of catastrophic+-- failure, the original file stays unaffected.+--+--+-- === Performance Considerations+--+-- When using a writable but non-truncating 'IOMode' (i.e. 'ReadWriteMode' and+-- 'AppendMode'), this function performs a copy operation of the specified input+-- file to guarantee the original file is intact in case of a catastrophic+-- failure (no partial writes). This approach may be prohibitive in scenarios+-- where the input file is expected to be large in size.+--+-- === Cross-Platform support+--+-- This function behaves the same as 'System.IO.withBinaryFile' on Windows+-- platforms.+--+-- @since 0.1.6+withBinaryFileDurableAtomic ::+ MonadUnliftIO m => FilePath -> IOMode -> (Handle -> m r) -> m r+withBinaryFileDurableAtomic absFp iomode cb = do+#if WINDOWS+ withBinaryFile absFp iomode cb+#else+ withRunInIO $ \run ->+ case iomode of+ -- We need to consider an atomic operation only when we are on 'WriteMode', lets+ -- use a regular withBinaryFile+ ReadMode -> run (withBinaryFile absFp iomode cb)+ -- Given we are not going to read contents from the original file, we+ -- can create a temporal file and then do an atomic move+ WriteMode -> do+ tmpFp <- toTmpFilePath absFp+ withDurableAtomic tmpFp run+ _ {- ReadWriteMode, AppendMode -}+ -> do+ -- copy original file for read purposes+ fileExists <- doesFileExist absFp+ tmpFp <- toTmpFilePath absFp+ when fileExists $ copyFile absFp tmpFp++ withDurableAtomic tmpFp run+ where+ withDurableAtomic tmpFp run = do+ bracket+ (openFileAndDirectory tmpFp iomode)+ (uncurry $ closeFileDurableAtomic tmpFp absFp)+ (run . cb . snd)+#endif
src/RIO/Prelude/IO.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module RIO.Prelude.IO ( withLazyFile , readFileBinary@@ -7,12 +8,13 @@ , hPutBuilder ) where -import RIO.Prelude.Reexports-import qualified Data.ByteString.Builder as BB-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.Text.IO as T-import System.IO (hSetEncoding, utf8)+import RIO.Prelude.Reexports+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Lazy as BL+import qualified Data.Text.IO as T+import System.IO (hSetEncoding, utf8)+ -- | Lazily get the contents of a file. Unlike 'BL.readFile', this -- ensures that if an exception is thrown, the file handle is closed
src/RIO/Prelude/Logger.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} module RIO.Prelude.Logger@@ -292,11 +293,19 @@ -- to perform verbose logging or not. Individiual settings can be -- overridden using appropriate @set@ functions. --+-- When Verbose Flag is @True@, the following happens:+--+-- * @setLogVerboseFormat@ is called with @True@+-- * @setLogUseColor@ is called with @True@ (except on Windows)+-- * @setLogUseLoc@ is called with @True@+-- * @setLogUseTime@ is called with @True@+-- * @setLogMinLevel@ is called with 'Debug' log level+-- -- @since 0.0.0.0 logOptionsHandle :: MonadIO m => Handle- -> Bool -- ^ verbose?+ -> Bool -- ^ Verbose Flag -> m LogOptions logOptionsHandle handle' verbose = liftIO $ do terminal <- hIsTerminalDevice handle'@@ -307,7 +316,11 @@ , logVerboseFormat = return verbose , logTerminal = terminal , logUseTime = verbose+#if WINDOWS+ , logUseColor = False+#else , logUseColor = verbose && terminal+#endif , logUseLoc = verbose , logSend = \builder -> if useUtf8 && unicode
src/RIO/Prelude/RIO.hs view
@@ -78,8 +78,8 @@ -- -- @since 0.1.4.0 modifySomeRef :: MonadIO m => SomeRef a -> (a -> a) -> m ()-modifySomeRef (SomeRef read write) f =- liftIO $ (f <$> read) >>= write+modifySomeRef (SomeRef read' write) f =+ liftIO $ (f <$> read') >>= write ioRefToSomeRef :: IORef a -> SomeRef a ioRefToSomeRef ref = do
+ test/RIO/FileSpec.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}+module RIO.FileSpec where++import Test.Hspec+import System.FilePath ((</>))+import UnliftIO.Temporary (withSystemTempDirectory)++import RIO+import qualified RIO.ByteString as BS+import qualified RIO.File as SUT++spec :: Spec+spec = do+ describe "ensureFileDurable" $ do+ it "ensures a file is durable with an fsync" $+ withSystemTempDirectory "rio" $ \dir -> do+ let fp = dir </> "ensure_file_durable"+ writeFileUtf8 fp "Hello World"+ SUT.ensureFileDurable fp+ contents <- BS.readFile fp+ contents `shouldBe` "Hello World"++ describe "withBinaryFileDurableAtomic" $ do+ context "read/write" $ do+ it "works correctly" $ do+ withSystemTempDirectory "rio" $ \dir -> do+ let fp = dir </> "ensure_file_durable_atomic"+ writeFileUtf8 fp "Hello World"+ SUT.withBinaryFileDurableAtomic fp ReadWriteMode $ \h -> do+ input <- BS.hGetLine h+ input `shouldBe` "Hello World"+ BS.hPut h "Goodbye World"++ context "happy path" $ do+ it "works the same as withFile" $ do+ withSystemTempDirectory "rio" $ \dir -> do+ let fp = dir </> "with_file_durable_atomic"+ SUT.withBinaryFileDurableAtomic fp WriteMode $ \h ->+ BS.hPut h "Hello World"+ contents <- BS.readFile fp+ contents `shouldBe` "Hello World"++ describe "withBinaryFileDurable" $ do+ context "happy path" $ do+ it "works the same as withFile" $ do+ withSystemTempDirectory "rio" $ \dir -> do+ let fp = dir </> "with_file_durable"+ SUT.withBinaryFileDurable fp WriteMode $ \h ->+ BS.hPut h "Hello World"+ contents <- BS.readFile fp+ contents `shouldBe` "Hello World"