From e78e8b1726962511f8ab49d10b4994d0000f0446 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Christian=20L=C3=BCtke-Stetzkamp?= <christian@lkamp.de>
Date: Sat, 2 May 2020 11:00:39 +0200
Subject: [PATCH] Implementation of durable file rename

---
 unliftio/ChangeLog.md                  |  4 ++++
 unliftio/package.yaml                  |  2 +-
 unliftio/src/UnliftIO/IO/File.hs       | 26 ++++++++++++++++++++++++++
 unliftio/src/UnliftIO/IO/File/Posix.hs | 12 ++++++++++++
 4 files changed, 43 insertions(+), 1 deletion(-)

diff --git a/unliftio/ChangeLog.md b/unliftio/ChangeLog.md
index 6e07d57..bd98a60 100644
--- a/unliftio/ChangeLog.md
+++ b/unliftio/ChangeLog.md
@@ -1,5 +1,9 @@
 # Changelog for unliftio
 
+## 0.2.14
+
+* Add `UnliftIO.IO.File.renameFileDurable`
+
 ## 0.2.13
 
 * Add `UnliftIO.STM.orElse`
diff --git a/unliftio/package.yaml b/unliftio/package.yaml
index 286d953..2b62197 100644
--- a/unliftio/package.yaml
+++ b/unliftio/package.yaml
@@ -1,5 +1,5 @@
 name:                unliftio
-version:             0.2.12.1
+version:             0.2.14
 synopsis:            The MonadUnliftIO typeclass for unlifting monads to IO (batteries included)
 description:         Please see the documentation and README at <https://www.stackage.org/package/unliftio>
 homepage:            https://github.com/fpco/unliftio/tree/master/unliftio#readme
diff --git a/unliftio/src/UnliftIO/IO/File.hs b/unliftio/src/UnliftIO/IO/File.hs
index 192f523..39bb538 100644
--- a/unliftio/src/UnliftIO/IO/File.hs
+++ b/unliftio/src/UnliftIO/IO/File.hs
@@ -82,12 +82,14 @@ module UnliftIO.IO.File
   , withBinaryFileDurable
   , withBinaryFileDurableAtomic
   , ensureFileDurable
+  , renameFileDurable
   )
   where
 
 import Data.ByteString as B (ByteString, writeFile)
 import Control.Monad.IO.Unlift
 import UnliftIO.IO (Handle, IOMode(..), withBinaryFile)
+import UnliftIO.Directory (renameFile)
 
 #if WINDOWS
 
@@ -102,6 +104,8 @@ withBinaryFileDurable = withBinaryFile
 withBinaryFileDurableAtomic = withBinaryFile
 withBinaryFileAtomic = withBinaryFile
 
+renameFileDurable = renameFile
+
 #else
 
 import qualified Data.ByteString as B (hPut)
@@ -119,8 +123,30 @@ writeBinaryFileAtomic fp bytes =
 withBinaryFileDurable = Posix.withBinaryFileDurable
 withBinaryFileDurableAtomic = Posix.withBinaryFileDurableAtomic
 withBinaryFileAtomic = Posix.withBinaryFileAtomic
+
+renameFileDurable = Posix.renameFileDurable
 #endif
 
+-- | When a file is renamed, it is necessary to execute @fsync()@ on the
+-- directory that contains the file now and afterwards on the directory where
+-- the file was before, so that the rename is durable.
+--
+-- Remark: This is also atomic if both locations of the file are on the same
+-- filesystem. However, it could happen that the operation leads to data loss,
+-- if a crash happens after the rename and before the first fsync finishes. This
+-- is because on an async filesystem the write of the old directory might
+-- already written to disk and the change on the new directory is not. It the
+-- function call returns, the change is durable. Nevertheless, this will not
+-- happen on filesystems using journaling, that is, allmost all modern filesystems.
+--
+-- === Cross-Platform support 
+--
+-- This function is a noop on Windows platforms.
+--
+-- @since 0.2.14
+renameFileDurable :: MonadIO m => FilePath -> FilePath -> m ()
+-- Implementation is at the top of the module
+
 -- | After a file is closed, this function opens it again and executes @fsync()@
 -- internally on both the file and the directory that contains it. Note that this function
 -- is intended to work around the non-durability of existing file APIs, as opposed to
diff --git a/unliftio/src/UnliftIO/IO/File/Posix.hs b/unliftio/src/UnliftIO/IO/File/Posix.hs
index ed0008a..cbce87a 100644
--- a/unliftio/src/UnliftIO/IO/File/Posix.hs
+++ b/unliftio/src/UnliftIO/IO/File/Posix.hs
@@ -9,6 +9,7 @@ module UnliftIO.IO.File.Posix
   , withBinaryFileDurableAtomic
   , withBinaryFileAtomic
   , ensureFileDurable
+  , renameFileDurable
   )
   where
 
@@ -39,6 +40,7 @@ import System.IO.Error (ioeGetErrorType, isAlreadyExistsError,
 import qualified System.Posix.Files as Posix
 import System.Posix.Internals (CFilePath, c_close, c_safe_open, withFilePath)
 import System.Posix.Types (CMode(..), Fd(..), FileMode)
+import UnliftIO.Directory (renameFile)
 import UnliftIO.Exception
 import UnliftIO.IO
 import UnliftIO.MVar
@@ -580,3 +582,13 @@ withBinaryFileAtomic filePath iomode action =
       liftIO $ atomicTempFileRename Nothing mFileMode eTmpFile filePath
       pure res
 
+
+-- | See `renameFileDurable`
+renameFileDurable ::
+     MonadIO m => FilePath -> FilePath -> m ()
+renameFileDurable oldName newName =
+     liftIO $ withDirectory (takeDirectory oldName) $ \oldDirFd ->
+                withDirectory (takeDirectory newName) $ \newDirFd -> do
+                  renameFile oldName newName
+                  fsyncDirectoryFd "renameFileDurable" newDirFd
+                  fsyncDirectoryFd "renameFileDurable" oldDirFd