{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module UnliftIO.IO.File.Posix
  ( withBinaryFileDurable
  , withBinaryFileDurableAtomic
  , withBinaryFileAtomic
  , ensureFileDurable
  )
  where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Monad (forM_, guard, unless, void, when)
import Control.Monad.IO.Unlift
import Data.Bits (Bits, (.|.))
import Data.ByteString (ByteString)
import Data.Maybe (fromMaybe)
import Data.Typeable (cast)
import Foreign (allocaBytes)
import Foreign.C (CInt(..), throwErrnoIfMinus1, throwErrnoIfMinus1Retry,
                  throwErrnoIfMinus1Retry_)
import GHC.IO.Device (IODeviceType(RegularFile))
import qualified GHC.IO.Device as Device
import GHC.IO.Exception (IOErrorType(UnsupportedOperation))
import qualified GHC.IO.FD as FD
import qualified GHC.IO.Handle.FD as HandleFD
import qualified GHC.IO.Handle.Types as HandleFD (Handle(..), Handle__(..))
import System.Directory (removeFile)
import System.FilePath (takeDirectory, takeFileName)
import System.IO (Handle, IOMode(..), SeekMode(..), hGetBuf, hPutBuf,
                  openBinaryTempFile)
import System.IO.Error (ioeGetErrorType, isAlreadyExistsError,
                        isDoesNotExistError)
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.Exception
import UnliftIO.IO
import UnliftIO.MVar

-- NOTE: System.Posix.Internal doesn't re-export this constants so we have to
-- recreate-them here

newtype CFlag =
  CFlag CInt
  deriving (CFlag -> CFlag -> Bool
(CFlag -> CFlag -> Bool) -> (CFlag -> CFlag -> Bool) -> Eq CFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CFlag -> CFlag -> Bool
$c/= :: CFlag -> CFlag -> Bool
== :: CFlag -> CFlag -> Bool
$c== :: CFlag -> CFlag -> Bool
Eq, Int -> CFlag -> ShowS
[CFlag] -> ShowS
CFlag -> String
(Int -> CFlag -> ShowS)
-> (CFlag -> String) -> ([CFlag] -> ShowS) -> Show CFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CFlag] -> ShowS
$cshowList :: [CFlag] -> ShowS
show :: CFlag -> String
$cshow :: CFlag -> String
showsPrec :: Int -> CFlag -> ShowS
$cshowsPrec :: Int -> CFlag -> ShowS
Show, Eq CFlag
CFlag
Eq CFlag
-> (CFlag -> CFlag -> CFlag)
-> (CFlag -> CFlag -> CFlag)
-> (CFlag -> CFlag -> CFlag)
-> (CFlag -> CFlag)
-> (CFlag -> Int -> CFlag)
-> (CFlag -> Int -> CFlag)
-> CFlag
-> (Int -> CFlag)
-> (CFlag -> Int -> CFlag)
-> (CFlag -> Int -> CFlag)
-> (CFlag -> Int -> CFlag)
-> (CFlag -> Int -> Bool)
-> (CFlag -> Maybe Int)
-> (CFlag -> Int)
-> (CFlag -> Bool)
-> (CFlag -> Int -> CFlag)
-> (CFlag -> Int -> CFlag)
-> (CFlag -> Int -> CFlag)
-> (CFlag -> Int -> CFlag)
-> (CFlag -> Int -> CFlag)
-> (CFlag -> Int -> CFlag)
-> (CFlag -> Int)
-> Bits CFlag
Int -> CFlag
CFlag -> Bool
CFlag -> Int
CFlag -> Maybe Int
CFlag -> CFlag
CFlag -> Int -> Bool
CFlag -> Int -> CFlag
CFlag -> CFlag -> CFlag
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: CFlag -> Int
$cpopCount :: CFlag -> Int
rotateR :: CFlag -> Int -> CFlag
$crotateR :: CFlag -> Int -> CFlag
rotateL :: CFlag -> Int -> CFlag
$crotateL :: CFlag -> Int -> CFlag
unsafeShiftR :: CFlag -> Int -> CFlag
$cunsafeShiftR :: CFlag -> Int -> CFlag
shiftR :: CFlag -> Int -> CFlag
$cshiftR :: CFlag -> Int -> CFlag
unsafeShiftL :: CFlag -> Int -> CFlag
$cunsafeShiftL :: CFlag -> Int -> CFlag
shiftL :: CFlag -> Int -> CFlag
$cshiftL :: CFlag -> Int -> CFlag
isSigned :: CFlag -> Bool
$cisSigned :: CFlag -> Bool
bitSize :: CFlag -> Int
$cbitSize :: CFlag -> Int
bitSizeMaybe :: CFlag -> Maybe Int
$cbitSizeMaybe :: CFlag -> Maybe Int
testBit :: CFlag -> Int -> Bool
$ctestBit :: CFlag -> Int -> Bool
complementBit :: CFlag -> Int -> CFlag
$ccomplementBit :: CFlag -> Int -> CFlag
clearBit :: CFlag -> Int -> CFlag
$cclearBit :: CFlag -> Int -> CFlag
setBit :: CFlag -> Int -> CFlag
$csetBit :: CFlag -> Int -> CFlag
bit :: Int -> CFlag
$cbit :: Int -> CFlag
zeroBits :: CFlag
$czeroBits :: CFlag
rotate :: CFlag -> Int -> CFlag
$crotate :: CFlag -> Int -> CFlag
shift :: CFlag -> Int -> CFlag
$cshift :: CFlag -> Int -> CFlag
complement :: CFlag -> CFlag
$ccomplement :: CFlag -> CFlag
xor :: CFlag -> CFlag -> CFlag
$cxor :: CFlag -> CFlag -> CFlag
.|. :: CFlag -> CFlag -> CFlag
$c.|. :: CFlag -> CFlag -> CFlag
.&. :: CFlag -> CFlag -> CFlag
$c.&. :: CFlag -> CFlag -> CFlag
$cp1Bits :: Eq CFlag
Bits)

foreign import ccall unsafe "HsBase.h __hscore_o_rdonly" o_RDONLY :: CFlag
foreign import ccall unsafe "HsBase.h __hscore_o_wronly" o_WRONLY :: CFlag
foreign import ccall unsafe "HsBase.h __hscore_o_rdwr"   o_RDWR   :: CFlag
foreign import ccall unsafe "HsBase.h __hscore_o_append" o_APPEND :: CFlag
foreign import ccall unsafe "HsBase.h __hscore_o_creat"  o_CREAT  :: CFlag
foreign import ccall unsafe "HsBase.h __hscore_o_noctty" o_NOCTTY :: CFlag

-- After here, we have our own imports

-- On non-Linux operating systems that do not support `O_TMPFILE` the value of
-- `o_TMPFILE` will be 0, which is then used to fallback onto a different
-- implementation of temporary files.
foreign import ccall unsafe "file-posix.c unliftio_o_tmpfile" o_TMPFILE :: CFlag


-- | Whenever Operating System does not support @O_TMPFILE@ flag and anonymous
-- temporary files then `o_TMPFILE` flag will be set to @0@
o_TMPFILE_not_supported :: CFlag
o_TMPFILE_not_supported :: CFlag
o_TMPFILE_not_supported = CInt -> CFlag
CFlag CInt
0

newtype CAt = CAt
  { CAt -> CInt
unCAt :: CInt
  } deriving (CAt -> CAt -> Bool
(CAt -> CAt -> Bool) -> (CAt -> CAt -> Bool) -> Eq CAt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CAt -> CAt -> Bool
$c/= :: CAt -> CAt -> Bool
== :: CAt -> CAt -> Bool
$c== :: CAt -> CAt -> Bool
Eq, Int -> CAt -> ShowS
[CAt] -> ShowS
CAt -> String
(Int -> CAt -> ShowS)
-> (CAt -> String) -> ([CAt] -> ShowS) -> Show CAt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CAt] -> ShowS
$cshowList :: [CAt] -> ShowS
show :: CAt -> String
$cshow :: CAt -> String
showsPrec :: Int -> CAt -> ShowS
$cshowsPrec :: Int -> CAt -> ShowS
Show, Eq CAt
CAt
Eq CAt
-> (CAt -> CAt -> CAt)
-> (CAt -> CAt -> CAt)
-> (CAt -> CAt -> CAt)
-> (CAt -> CAt)
-> (CAt -> Int -> CAt)
-> (CAt -> Int -> CAt)
-> CAt
-> (Int -> CAt)
-> (CAt -> Int -> CAt)
-> (CAt -> Int -> CAt)
-> (CAt -> Int -> CAt)
-> (CAt -> Int -> Bool)
-> (CAt -> Maybe Int)
-> (CAt -> Int)
-> (CAt -> Bool)
-> (CAt -> Int -> CAt)
-> (CAt -> Int -> CAt)
-> (CAt -> Int -> CAt)
-> (CAt -> Int -> CAt)
-> (CAt -> Int -> CAt)
-> (CAt -> Int -> CAt)
-> (CAt -> Int)
-> Bits CAt
Int -> CAt
CAt -> Bool
CAt -> Int
CAt -> Maybe Int
CAt -> CAt
CAt -> Int -> Bool
CAt -> Int -> CAt
CAt -> CAt -> CAt
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
popCount :: CAt -> Int
$cpopCount :: CAt -> Int
rotateR :: CAt -> Int -> CAt
$crotateR :: CAt -> Int -> CAt
rotateL :: CAt -> Int -> CAt
$crotateL :: CAt -> Int -> CAt
unsafeShiftR :: CAt -> Int -> CAt
$cunsafeShiftR :: CAt -> Int -> CAt
shiftR :: CAt -> Int -> CAt
$cshiftR :: CAt -> Int -> CAt
unsafeShiftL :: CAt -> Int -> CAt
$cunsafeShiftL :: CAt -> Int -> CAt
shiftL :: CAt -> Int -> CAt
$cshiftL :: CAt -> Int -> CAt
isSigned :: CAt -> Bool
$cisSigned :: CAt -> Bool
bitSize :: CAt -> Int
$cbitSize :: CAt -> Int
bitSizeMaybe :: CAt -> Maybe Int
$cbitSizeMaybe :: CAt -> Maybe Int
testBit :: CAt -> Int -> Bool
$ctestBit :: CAt -> Int -> Bool
complementBit :: CAt -> Int -> CAt
$ccomplementBit :: CAt -> Int -> CAt
clearBit :: CAt -> Int -> CAt
$cclearBit :: CAt -> Int -> CAt
setBit :: CAt -> Int -> CAt
$csetBit :: CAt -> Int -> CAt
bit :: Int -> CAt
$cbit :: Int -> CAt
zeroBits :: CAt
$czeroBits :: CAt
rotate :: CAt -> Int -> CAt
$crotate :: CAt -> Int -> CAt
shift :: CAt -> Int -> CAt
$cshift :: CAt -> Int -> CAt
complement :: CAt -> CAt
$ccomplement :: CAt -> CAt
xor :: CAt -> CAt -> CAt
$cxor :: CAt -> CAt -> CAt
.|. :: CAt -> CAt -> CAt
$c.|. :: CAt -> CAt -> CAt
.&. :: CAt -> CAt -> CAt
$c.&. :: CAt -> CAt -> CAt
$cp1Bits :: Eq CAt
Bits)

foreign import ccall unsafe "file-posix.c unliftio_at_fdcwd" at_FDCWD :: CAt
foreign import ccall unsafe "file-posix.c unliftio_at_symlink_follow" at_SYMLINK_FOLLOW :: CAt
foreign import ccall unsafe "file-posix.c unliftio_s_irusr" s_IRUSR :: CMode
foreign import ccall unsafe "file-posix.c unliftio_s_iwusr" s_IWUSR :: CMode

c_open :: CFilePath -> CFlag -> CMode -> IO CInt
c_open :: CFilePath -> CFlag -> CMode -> IO CInt
c_open CFilePath
fp (CFlag CInt
flags) = CFilePath -> CInt -> CMode -> IO CInt
c_safe_open CFilePath
fp CInt
flags

foreign import ccall safe "fcntl.h openat"
  c_safe_openat :: CInt -> CFilePath -> CInt -> CMode -> IO CInt

c_openat :: DirFd -> CFilePath -> CFlag -> CMode -> IO CInt
c_openat :: DirFd -> CFilePath -> CFlag -> CMode -> IO CInt
c_openat (DirFd (Fd CInt
fd)) CFilePath
fp (CFlag CInt
flags) = CInt -> CFilePath -> CInt -> CMode -> IO CInt
c_safe_openat CInt
fd CFilePath
fp CInt
flags

foreign import ccall safe "fcntl.h renameat"
  c_safe_renameat :: CInt -> CFilePath -> CInt -> CFilePath -> IO CInt

c_renameat :: DirFd -> CFilePath -> DirFd -> CFilePath -> IO CInt
c_renameat :: DirFd -> CFilePath -> DirFd -> CFilePath -> IO CInt
c_renameat (DirFd (Fd CInt
fdFrom)) CFilePath
cFpFrom (DirFd (Fd CInt
fdTo)) CFilePath
cFpTo =
  CInt -> CFilePath -> CInt -> CFilePath -> IO CInt
c_safe_renameat CInt
fdFrom CFilePath
cFpFrom CInt
fdTo CFilePath
cFpTo

foreign import ccall safe "unistd.h fsync"
  c_safe_fsync :: CInt -> IO CInt

c_fsync :: Fd -> IO CInt
c_fsync :: Fd -> IO CInt
c_fsync (Fd CInt
fd) = CInt -> IO CInt
c_safe_fsync CInt
fd

foreign import ccall safe "unistd.h linkat"
  c_safe_linkat :: CInt -> CFilePath -> CInt -> CFilePath -> CInt -> IO CInt

c_linkat :: CAt -> CFilePath -> Either DirFd CAt -> CFilePath -> CAt -> IO CInt
c_linkat :: CAt -> CFilePath -> Either DirFd CAt -> CFilePath -> CAt -> IO CInt
c_linkat CAt
cat CFilePath
oldPath Either DirFd CAt
eNewDir CFilePath
newPath (CAt CInt
flags) =
  CInt -> CFilePath -> CInt -> CFilePath -> CInt -> IO CInt
c_safe_linkat (CAt -> CInt
unCAt CAt
cat) CFilePath
oldPath CInt
newDir CFilePath
newPath CInt
flags
  where
    unFd :: Fd -> CInt
unFd (Fd CInt
fd) = CInt
fd
    newDir :: CInt
newDir = (DirFd -> CInt) -> (CAt -> CInt) -> Either DirFd CAt -> CInt
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Fd -> CInt
unFd (Fd -> CInt) -> (DirFd -> Fd) -> DirFd -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirFd -> Fd
unDirFd) CAt -> CInt
unCAt Either DirFd CAt
eNewDir

std_flags, output_flags, read_flags, write_flags, rw_flags,
    append_flags :: CFlag
std_flags :: CFlag
std_flags    = CFlag
o_NOCTTY
output_flags :: CFlag
output_flags = CFlag
std_flags    CFlag -> CFlag -> CFlag
forall a. Bits a => a -> a -> a
.|. CFlag
o_CREAT
read_flags :: CFlag
read_flags   = CFlag
std_flags    CFlag -> CFlag -> CFlag
forall a. Bits a => a -> a -> a
.|. CFlag
o_RDONLY
write_flags :: CFlag
write_flags  = CFlag
output_flags CFlag -> CFlag -> CFlag
forall a. Bits a => a -> a -> a
.|. CFlag
o_WRONLY
rw_flags :: CFlag
rw_flags     = CFlag
output_flags CFlag -> CFlag -> CFlag
forall a. Bits a => a -> a -> a
.|. CFlag
o_RDWR
append_flags :: CFlag
append_flags = CFlag
write_flags  CFlag -> CFlag -> CFlag
forall a. Bits a => a -> a -> a
.|. CFlag
o_APPEND

ioModeToFlags :: IOMode -> CFlag
ioModeToFlags :: IOMode -> CFlag
ioModeToFlags IOMode
iomode =
  case IOMode
iomode of
    IOMode
ReadMode      -> CFlag
read_flags
    IOMode
WriteMode     -> CFlag
write_flags
    IOMode
ReadWriteMode -> CFlag
rw_flags
    IOMode
AppendMode    -> CFlag
append_flags

newtype DirFd = DirFd
  { DirFd -> Fd
unDirFd :: Fd
  }

-- | 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.
openDir :: MonadIO m => FilePath -> m Fd
openDir :: String -> m Fd
openDir String
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
 =
  IO Fd -> m Fd
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Fd -> m Fd) -> IO Fd -> m Fd
forall a b. (a -> b) -> a -> b
$
  String -> (CFilePath -> IO Fd) -> IO Fd
forall a. String -> (CFilePath -> IO a) -> IO a
withFilePath String
fp ((CFilePath -> IO Fd) -> IO Fd) -> (CFilePath -> IO Fd) -> IO Fd
forall a b. (a -> b) -> a -> b
$ \CFilePath
cFp ->
    CInt -> Fd
Fd (CInt -> Fd) -> IO CInt -> IO Fd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1Retry
      String
"openDir"
      (CFilePath -> CFlag -> CMode -> IO CInt
c_open CFilePath
cFp (IOMode -> CFlag
ioModeToFlags IOMode
ReadMode) CMode
0o660)

-- | Closes a 'Fd' that points to a Directory.
closeDirectory :: MonadIO m => DirFd -> m ()
closeDirectory :: DirFd -> m ()
closeDirectory (DirFd (Fd CInt
dirFd)) =
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"closeDirectory" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> IO CInt
c_close CInt
dirFd

-- | Executes the low-level C function fsync on a C file descriptor
fsyncFileDescriptor
  :: MonadIO m
  => String -- ^ Meta-description for error messages
  -> Fd   -- ^ C File Descriptor
  -> m ()
fsyncFileDescriptor :: String -> Fd -> m ()
fsyncFileDescriptor String
name Fd
fd =
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 (String
"fsync - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name) (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ Fd -> IO CInt
c_fsync Fd
fd

-- | Call @fsync@ on the file handle. Accepts an arbitary string for error reporting.
fsyncFileHandle :: String -> Handle -> IO ()
fsyncFileHandle :: String -> Handle -> IO ()
fsyncFileHandle String
fname Handle
hdl = Handle -> (Fd -> IO ()) -> IO ()
forall a. Handle -> (Fd -> IO a) -> IO a
withHandleFd Handle
hdl (String -> Fd -> IO ()
forall (m :: * -> *). MonadIO m => String -> Fd -> m ()
fsyncFileDescriptor (String
fname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/File"))


-- | Call @fsync@ on the opened directory file descriptor. Accepts an arbitary
-- string for error reporting.
fsyncDirectoryFd :: String -> DirFd -> IO ()
fsyncDirectoryFd :: String -> DirFd -> IO ()
fsyncDirectoryFd String
fname = String -> Fd -> IO ()
forall (m :: * -> *). MonadIO m => String -> Fd -> m ()
fsyncFileDescriptor (String
fname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/Directory") (Fd -> IO ()) -> (DirFd -> Fd) -> DirFd -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirFd -> Fd
unDirFd


-- | 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 => DirFd -> FilePath -> IOMode -> m Handle
openFileFromDir :: DirFd -> String -> IOMode -> m Handle
openFileFromDir DirFd
dirFd filePath :: String
filePath@(ShowS
takeFileName -> String
fileName) IOMode
iomode =
  IO Handle -> m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$
  String -> (CFilePath -> IO Handle) -> IO Handle
forall a. String -> (CFilePath -> IO a) -> IO a
withFilePath String
fileName ((CFilePath -> IO Handle) -> IO Handle)
-> (CFilePath -> IO Handle) -> IO Handle
forall a b. (a -> b) -> a -> b
$ \CFilePath
cFileName ->
    IO (FD, IODeviceType)
-> ((FD, IODeviceType) -> IO ())
-> ((FD, IODeviceType) -> IO Handle)
-> IO Handle
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError
      (do CInt
fileFd <-
            String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1Retry String
"openFileFromDir" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
            DirFd -> CFilePath -> CFlag -> CMode -> IO CInt
c_openat DirFd
dirFd CFilePath
cFileName (IOMode -> CFlag
ioModeToFlags IOMode
iomode) CMode
0o666
            {- Can open directory with read only -}
          CInt
-> IOMode
-> Maybe (IODeviceType, CDev, CIno)
-> Bool
-> Bool
-> IO (FD, IODeviceType)
FD.mkFD
            CInt
fileFd
            IOMode
iomode
            Maybe (IODeviceType, CDev, CIno)
forall a. Maybe a
Nothing {- no stat -}
            Bool
False {- not a socket -}
            Bool
False {- non_blocking -}
           IO (FD, IODeviceType) -> IO CInt -> IO (FD, IODeviceType)
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
`onException`
            CInt -> IO CInt
c_close CInt
fileFd)
      (IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ())
-> ((FD, IODeviceType) -> IO ()) -> (FD, IODeviceType) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FD -> IO ()
forall a. IODevice a => a -> IO ()
Device.close (FD -> IO ())
-> ((FD, IODeviceType) -> FD) -> (FD, IODeviceType) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FD, IODeviceType) -> FD
forall a b. (a, b) -> a
fst)
      (\(FD
fD, IODeviceType
fd_type)
         -- 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.
        -> do
         Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IOMode
iomode IOMode -> IOMode -> Bool
forall a. Eq a => a -> a -> Bool
== IOMode
WriteMode Bool -> Bool -> Bool
&& IODeviceType
fd_type IODeviceType -> IODeviceType -> Bool
forall a. Eq a => a -> a -> Bool
== IODeviceType
RegularFile) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
           FD -> Integer -> IO ()
forall a. IODevice a => a -> Integer -> IO ()
Device.setSize FD
fD Integer
0
         FD
-> IODeviceType
-> String
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
HandleFD.mkHandleFromFD FD
fD IODeviceType
fd_type String
filePath IOMode
iomode Bool
False Maybe TextEncoding
forall a. Maybe a
Nothing)


-- | Similar to `openFileFromDir`, but will open an anonymous (nameless)
-- temporary file in the supplied directory
openAnonymousTempFileFromDir ::
     MonadIO m =>
     Maybe DirFd
     -- ^ If a file descriptor is given for the directory where the target file is/will be
     -- located in, then it will be used for opening an anonymous file. Otherwise
     -- anonymous will be opened unattached to any file path.
     -> FilePath
     -- ^ File path of the target file that we are working on.
     -> IOMode
     -> m Handle
openAnonymousTempFileFromDir :: Maybe DirFd -> String -> IOMode -> m Handle
openAnonymousTempFileFromDir Maybe DirFd
mDirFd String
filePath IOMode
iomode =
  IO Handle -> m Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$
  case Maybe DirFd
mDirFd of
    Just DirFd
dirFd -> String -> (CFilePath -> IO Handle) -> IO Handle
forall a. String -> (CFilePath -> IO a) -> IO a
withFilePath String
"." ((CFlag -> CMode -> IO CInt) -> IO Handle
openAnonymousWith ((CFlag -> CMode -> IO CInt) -> IO Handle)
-> (CFilePath -> CFlag -> CMode -> IO CInt)
-> CFilePath
-> IO Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirFd -> CFilePath -> CFlag -> CMode -> IO CInt
c_openat DirFd
dirFd)
    Maybe DirFd
Nothing ->
      String -> (CFilePath -> IO Handle) -> IO Handle
forall a. String -> (CFilePath -> IO a) -> IO a
withFilePath (ShowS
takeDirectory String
filePath) ((CFlag -> CMode -> IO CInt) -> IO Handle
openAnonymousWith ((CFlag -> CMode -> IO CInt) -> IO Handle)
-> (CFilePath -> CFlag -> CMode -> IO CInt)
-> CFilePath
-> IO Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFilePath -> CFlag -> CMode -> IO CInt
c_open)
  where
    fdName :: String
fdName = String
"openAnonymousTempFileFromDir - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
filePath
    ioModeToTmpFlags :: IOMode -> CFlag
    ioModeToTmpFlags :: IOMode -> CFlag
ioModeToTmpFlags =
      \case
        IOMode
ReadMode -> CFlag
o_RDWR -- It is an error to create a O_TMPFILE with O_RDONLY
        IOMode
ReadWriteMode -> CFlag
o_RDWR
        IOMode
_ -> CFlag
o_WRONLY
    openAnonymousWith :: (CFlag -> CMode -> IO CInt) -> IO Handle
openAnonymousWith CFlag -> CMode -> IO CInt
fopen =
      IO (FD, IODeviceType)
-> ((FD, IODeviceType) -> IO ())
-> ((FD, IODeviceType) -> IO Handle)
-> IO Handle
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError
        (do CInt
fileFd <-
              String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1Retry String
"openAnonymousTempFileFromDir" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
              CFlag -> CMode -> IO CInt
fopen (CFlag
o_TMPFILE CFlag -> CFlag -> CFlag
forall a. Bits a => a -> a -> a
.|. IOMode -> CFlag
ioModeToTmpFlags IOMode
iomode) (CMode
s_IRUSR CMode -> CMode -> CMode
forall a. Bits a => a -> a -> a
.|. CMode
s_IWUSR)
            CInt
-> IOMode
-> Maybe (IODeviceType, CDev, CIno)
-> Bool
-> Bool
-> IO (FD, IODeviceType)
FD.mkFD
              CInt
fileFd
              IOMode
iomode
              Maybe (IODeviceType, CDev, CIno)
forall a. Maybe a
Nothing {- no stat -}
              Bool
False {- not a socket -}
              Bool
False {- non_blocking -}
             IO (FD, IODeviceType) -> IO CInt -> IO (FD, IODeviceType)
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
`onException`
              CInt -> IO CInt
c_close CInt
fileFd)
        (IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ())
-> ((FD, IODeviceType) -> IO ()) -> (FD, IODeviceType) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FD -> IO ()
forall a. IODevice a => a -> IO ()
Device.close (FD -> IO ())
-> ((FD, IODeviceType) -> FD) -> (FD, IODeviceType) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FD, IODeviceType) -> FD
forall a b. (a, b) -> a
fst)
        (\(FD
fD, IODeviceType
fd_type) ->
           FD
-> IODeviceType
-> String
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
HandleFD.mkHandleFromFD FD
fD IODeviceType
fd_type String
fdName IOMode
iomode Bool
False Maybe TextEncoding
forall a. Maybe a
Nothing)


atomicDurableTempFileRename ::
     DirFd -> Maybe FileMode -> Handle -> Maybe FilePath -> FilePath -> IO ()
atomicDurableTempFileRename :: DirFd -> Maybe CMode -> Handle -> Maybe String -> String -> IO ()
atomicDurableTempFileRename DirFd
dirFd Maybe CMode
mFileMode Handle
tmpFileHandle Maybe String
mTmpFilePath String
filePath = do
  String -> Handle -> IO ()
fsyncFileHandle String
"atomicDurableTempFileCreate" Handle
tmpFileHandle
  -- at this point we know that the content has been persisted to the storage it
  -- is safe to do the atomic move/replace
  let eTmpFile :: Either Handle String
eTmpFile = Either Handle String
-> (String -> Either Handle String)
-> Maybe String
-> Either Handle String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Handle -> Either Handle String
forall a b. a -> Either a b
Left Handle
tmpFileHandle) String -> Either Handle String
forall a b. b -> Either a b
Right Maybe String
mTmpFilePath
  Maybe DirFd
-> Maybe CMode -> Either Handle String -> String -> IO ()
atomicTempFileRename (DirFd -> Maybe DirFd
forall a. a -> Maybe a
Just DirFd
dirFd) Maybe CMode
mFileMode Either Handle String
eTmpFile String
filePath
  -- Important to close the handle, so the we can fsync the directory
  Handle -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hClose Handle
tmpFileHandle
  -- file path is updated, now we can fsync the directory
  String -> DirFd -> IO ()
fsyncDirectoryFd String
"atomicDurableTempFileCreate" DirFd
dirFd


-- | There will be an attempt to atomically convert an invisible temporary file
-- into a target file at the supplied file path. In case when there is already a
-- file at that file path, a new visible temporary file will be created in the
-- same folder and then atomically renamed into the target file path, replacing
-- any existing file. This is necessary since `c_safe_linkat` cannot replace
-- files atomically and we have to fall back onto `c_safe_renameat`. This should
-- not be a problem in practice, since lifetime of such visible file is
-- extremely short and it will be cleaned up regardless of the outcome of the
-- rename.
--
-- It is important to note, that whenever a file descriptor for the containing
-- directory is supplied, renaming and linking will be done in its context,
-- thus allowing to do proper fsyncing if durability is necessary.
--
-- __NOTE__: this function will work only on Linux.
--
atomicTempFileCreate ::
     Maybe DirFd
  -- ^ Possible handle for the directory where the target file is located. Which
  -- means that the file is already in that directory, just without a name. In other
  -- words it was opened before with `openAnonymousTempFileFromDir`
  -> Maybe FileMode
  -- ^ If file permissions are supplied they will be set on the new file prior
  -- to atomic rename.
  -> Handle
  -- ^ Handle to the anonymous temporary file created with `c_openat` and
  -- `o_TMPFILE`
  -> FilePath
  -- ^ File path for the target file.
  -> IO ()
atomicTempFileCreate :: Maybe DirFd -> Maybe CMode -> Handle -> String -> IO ()
atomicTempFileCreate Maybe DirFd
mDirFd Maybe CMode
mFileMode Handle
tmpFileHandle String
filePath =
  Handle -> (Fd -> IO ()) -> IO ()
forall a. Handle -> (Fd -> IO a) -> IO a
withHandleFd Handle
tmpFileHandle ((Fd -> IO ()) -> IO ()) -> (Fd -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \fd :: Fd
fd@(Fd CInt
cFd) ->
    String -> (CFilePath -> IO ()) -> IO ()
forall a. String -> (CFilePath -> IO a) -> IO a
withFilePath (String
"/proc/self/fd/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
cFd) ((CFilePath -> IO ()) -> IO ()) -> (CFilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CFilePath
cFromFilePath ->
      String -> (CFilePath -> IO ()) -> IO ()
forall a. String -> (CFilePath -> IO a) -> IO a
withFilePath String
filePathName ((CFilePath -> IO ()) -> IO ()) -> (CFilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CFilePath
cToFilePath -> do
        let fileMode :: CMode
fileMode = CMode -> Maybe CMode -> CMode
forall a. a -> Maybe a -> a
fromMaybe CMode
Posix.stdFileMode Maybe CMode
mFileMode
        -- work around for the glibc bug: https://sourceware.org/bugzilla/show_bug.cgi?id=17523
        Fd -> CMode -> IO ()
Posix.setFdMode Fd
fd CMode
fileMode
        let safeLink :: String -> CFilePath -> IO ()
safeLink String
which CFilePath
to =
              String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_
                (String
"atomicFileCreate - c_safe_linkat - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
which) (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
              -- see `man linkat` and `man openat` for more info
              CAt -> CFilePath -> Either DirFd CAt -> CFilePath -> CAt -> IO CInt
c_linkat CAt
at_FDCWD CFilePath
cFromFilePath Either DirFd CAt
cDirFd CFilePath
to CAt
at_SYMLINK_FOLLOW
        Either () ()
eExc <-
          (IOError -> Maybe ()) -> IO () -> IO (Either () ())
forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isAlreadyExistsError) (IO () -> IO (Either () ())) -> IO () -> IO (Either () ())
forall a b. (a -> b) -> a -> b
$
          String -> CFilePath -> IO ()
safeLink String
"anonymous" CFilePath
cToFilePath
        case Either () ()
eExc of
          Right () -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Left () ->
            String -> (String -> Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (String -> Handle -> m a) -> m a
withBinaryTempFileFor String
filePath ((String -> Handle -> IO ()) -> IO ())
-> (String -> Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
visTmpFileName Handle
visTmpFileHandle -> do
              Handle -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hClose Handle
visTmpFileHandle
              String -> IO ()
removeFile String
visTmpFileName
              case Maybe DirFd
mDirFd of
                Maybe DirFd
Nothing -> do
                  String -> (CFilePath -> IO ()) -> IO ()
forall a. String -> (CFilePath -> IO a) -> IO a
withFilePath String
visTmpFileName (String -> CFilePath -> IO ()
safeLink String
"visible")
                  String -> String -> IO ()
Posix.rename String
visTmpFileName String
filePath
                Just DirFd
dirFd ->
                  String -> (CFilePath -> IO ()) -> IO ()
forall a. String -> (CFilePath -> IO a) -> IO a
withFilePath (ShowS
takeFileName String
visTmpFileName) ((CFilePath -> IO ()) -> IO ()) -> (CFilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CFilePath
cVisTmpFile -> do
                    String -> CFilePath -> IO ()
safeLink String
"visible" CFilePath
cVisTmpFile
                    String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_
                        String
"atomicFileCreate - c_safe_renameat" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
                      DirFd -> CFilePath -> DirFd -> CFilePath -> IO CInt
c_renameat DirFd
dirFd CFilePath
cVisTmpFile DirFd
dirFd CFilePath
cToFilePath
  where
    (Either DirFd CAt
cDirFd, String
filePathName) =
      case Maybe DirFd
mDirFd of
        Maybe DirFd
Nothing    -> (CAt -> Either DirFd CAt
forall a b. b -> Either a b
Right CAt
at_FDCWD, String
filePath)
        Just DirFd
dirFd -> (DirFd -> Either DirFd CAt
forall a b. a -> Either a b
Left DirFd
dirFd, ShowS
takeFileName String
filePath)

atomicTempFileRename ::
     Maybe DirFd
     -- ^ Possible handle for the directory where the target file is located.
  -> Maybe FileMode
  -- ^ If file permissions are supplied they will be set on the new file prior
  -- to atomic rename.
  -> Either Handle FilePath
  -- ^ Temporary file. If a handle is supplied, it means it was opened with
  -- @O_TMPFILE@ flag and thus we are on the Linux OS and can safely call
  -- `atomicTempFileCreate`
  -> FilePath
  -- ^ File path for the target file. Whenever `DirFd` is supplied, it must be
  -- the containgin directory fo this file, but that invariant is not enforced
  -- within this function.
  -> IO ()
atomicTempFileRename :: Maybe DirFd
-> Maybe CMode -> Either Handle String -> String -> IO ()
atomicTempFileRename Maybe DirFd
mDirFd Maybe CMode
mFileMode Either Handle String
eTmpFile String
filePath =
  case Either Handle String
eTmpFile of
    Left Handle
tmpFileHandle ->
      Maybe DirFd -> Maybe CMode -> Handle -> String -> IO ()
atomicTempFileCreate Maybe DirFd
mDirFd Maybe CMode
mFileMode Handle
tmpFileHandle String
filePath
    Right String
tmpFilePath -> do
      Maybe CMode -> (CMode -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe CMode
mFileMode ((CMode -> IO ()) -> IO ()) -> (CMode -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CMode
fileMode -> String -> CMode -> IO ()
Posix.setFileMode String
tmpFilePath CMode
fileMode
      case Maybe DirFd
mDirFd of
        Maybe DirFd
Nothing -> String -> String -> IO ()
Posix.rename String
tmpFilePath String
filePath
        Just DirFd
dirFd ->
          String -> (CFilePath -> IO ()) -> IO ()
forall a. String -> (CFilePath -> IO a) -> IO a
withFilePath (ShowS
takeFileName String
filePath) ((CFilePath -> IO ()) -> IO ()) -> (CFilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CFilePath
cToFilePath ->
            String -> (CFilePath -> IO ()) -> IO ()
forall a. String -> (CFilePath -> IO a) -> IO a
withFilePath (ShowS
takeFileName String
tmpFilePath) ((CFilePath -> IO ()) -> IO ()) -> (CFilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CFilePath
cTmpFilePath ->
              String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1Retry_ String
"atomicFileCreate - c_safe_renameat" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
              DirFd -> CFilePath -> DirFd -> CFilePath -> IO CInt
c_renameat DirFd
dirFd CFilePath
cTmpFilePath DirFd
dirFd CFilePath
cToFilePath


withDirectory :: MonadUnliftIO m => FilePath -> (DirFd -> m a) -> m a
withDirectory :: String -> (DirFd -> m a) -> m a
withDirectory String
dirPath = m DirFd -> (DirFd -> m ()) -> (DirFd -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (Fd -> DirFd
DirFd (Fd -> DirFd) -> m Fd -> m DirFd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m Fd
forall (m :: * -> *). MonadIO m => String -> m Fd
openDir String
dirPath) DirFd -> m ()
forall (m :: * -> *). MonadIO m => DirFd -> m ()
closeDirectory

withFileInDirectory ::
     MonadUnliftIO m => DirFd -> FilePath -> IOMode -> (Handle -> m a) -> m a
withFileInDirectory :: DirFd -> String -> IOMode -> (Handle -> m a) -> m a
withFileInDirectory DirFd
dirFd String
filePath IOMode
iomode =
  m Handle -> (Handle -> m ()) -> (Handle -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (DirFd -> String -> IOMode -> m Handle
forall (m :: * -> *).
MonadIO m =>
DirFd -> String -> IOMode -> m Handle
openFileFromDir DirFd
dirFd String
filePath IOMode
iomode) Handle -> m ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hClose


-- | Create a temporary file for a matching possibly exiting target file that
-- will be replaced in the future. Temporary file is meant to be renamed
-- afterwards, thus it is only deleted upon error.
--
-- __Important__: Temporary file is not removed and file handle is not closed if
-- there was no exception thrown by the supplied action.
withBinaryTempFileFor ::
     MonadUnliftIO m
  => FilePath
  -- ^ "For" file. It may exist or may not.
  -> (FilePath -> Handle -> m a)
  -> m a
withBinaryTempFileFor :: String -> (String -> Handle -> m a) -> m a
withBinaryTempFileFor String
filePath String -> Handle -> m a
action =
  m (String, Handle)
-> ((String, Handle) -> m (Either IOError ()))
-> ((String, Handle) -> m a)
-> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError
    (IO (String, Handle) -> m (String, Handle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> String -> IO (String, Handle)
openBinaryTempFile String
dirPath String
tmpFileName))
    (\(String
tmpFilePath, Handle
tmpFileHandle) ->
        Handle -> m ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hClose Handle
tmpFileHandle m () -> m (Either IOError ()) -> m (Either IOError ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Either IOError ()) -> m (Either IOError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO (Either IOError ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOError a)
tryIO (String -> IO ()
removeFile String
tmpFilePath)))
    ((String -> Handle -> m a) -> (String, Handle) -> m a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Handle -> m a
action)
  where
    dirPath :: String
dirPath = ShowS
takeDirectory String
filePath
    fileName :: String
fileName = ShowS
takeFileName String
filePath
    tmpFileName :: String
tmpFileName = String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fileName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".tmp"

-- | Returns `Nothing` if anonymous temporary file is not supported by the OS or
-- the underlying file system can't handle that feature.
withAnonymousBinaryTempFileFor ::
     MonadUnliftIO m
  => Maybe DirFd
  -- ^ It is possible to open the temporary file in the context of a directory,
  -- in such case supply its file descriptor. i.e. @openat@ will be used instead
  -- of @open@
  -> FilePath
  -- ^ "For" file. The file may exist or may not.
  -> IOMode
  -> (Handle -> m a)
  -> m (Maybe a)
withAnonymousBinaryTempFileFor :: Maybe DirFd -> String -> IOMode -> (Handle -> m a) -> m (Maybe a)
withAnonymousBinaryTempFileFor Maybe DirFd
mDirFd String
filePath IOMode
iomode Handle -> m a
action
  | CFlag
o_TMPFILE CFlag -> CFlag -> Bool
forall a. Eq a => a -> a -> Bool
== CFlag
o_TMPFILE_not_supported = Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise =
    m a -> m (Maybe a)
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Maybe a)
trySupported (m a -> m (Maybe a)) -> m a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$
    m Handle -> (Handle -> m ()) -> (Handle -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (Maybe DirFd -> String -> IOMode -> m Handle
forall (m :: * -> *).
MonadIO m =>
Maybe DirFd -> String -> IOMode -> m Handle
openAnonymousTempFileFromDir Maybe DirFd
mDirFd String
filePath IOMode
iomode) Handle -> m ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hClose Handle -> m a
action
  where
    trySupported :: m a -> m (Maybe a)
trySupported m a
m =
      m a -> m (Either IOError a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOError a)
tryIO m a
m m (Either IOError a)
-> (Either IOError a -> m (Maybe a)) -> m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right a
res -> Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
res
        Left IOError
exc
          | IOError -> IOErrorType
ioeGetErrorType IOError
exc IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
UnsupportedOperation -> Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
        Left IOError
exc -> IOError -> m (Maybe a)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO IOError
exc

withNonAnonymousBinaryTempFileFor ::
     MonadUnliftIO m
  => Maybe DirFd
  -- ^ It is possible to open the temporary file in the context of a directory,
  -- in such case supply its file descriptor. i.e. @openat@ will be used instead
  -- of @open@
  -> FilePath
  -- ^ "For" file. The file may exist or may not.
  -> IOMode
  -> (FilePath -> Handle -> m a)
  -> m a
withNonAnonymousBinaryTempFileFor :: Maybe DirFd -> String -> IOMode -> (String -> Handle -> m a) -> m a
withNonAnonymousBinaryTempFileFor Maybe DirFd
mDirFd String
filePath IOMode
iomode String -> Handle -> m a
action =
  String -> (String -> Handle -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (String -> Handle -> m a) -> m a
withBinaryTempFileFor String
filePath ((String -> Handle -> m a) -> m a)
-> (String -> Handle -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \String
tmpFilePath Handle
tmpFileHandle -> do
    Handle -> m ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hClose Handle
tmpFileHandle
    case Maybe DirFd
mDirFd of
      Maybe DirFd
Nothing -> String -> IOMode -> (Handle -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> IOMode -> (Handle -> m a) -> m a
withBinaryFile String
tmpFilePath IOMode
iomode (String -> Handle -> m a
action String
tmpFilePath)
      Just DirFd
dirFd -> DirFd -> String -> IOMode -> (Handle -> m a) -> m a
forall (m :: * -> *) a.
MonadUnliftIO m =>
DirFd -> String -> IOMode -> (Handle -> m a) -> m a
withFileInDirectory DirFd
dirFd String
tmpFilePath IOMode
iomode (String -> Handle -> m a
action String
tmpFilePath)

-- | Copy the contents of the file into the handle, but only if that file exists
-- and either `ReadWriteMode` or `AppendMode` is specified. Returned are the
-- file permissions of the original file so it can be set later when original
-- gets overwritten atomically.
copyFileHandle ::
     MonadUnliftIO f => IOMode -> FilePath -> Handle -> f (Maybe FileMode)
copyFileHandle :: IOMode -> String -> Handle -> f (Maybe CMode)
copyFileHandle IOMode
iomode String
fromFilePath Handle
toHandle =
  (() -> Maybe CMode)
-> (CMode -> Maybe CMode) -> Either () CMode -> Maybe CMode
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe CMode -> () -> Maybe CMode
forall a b. a -> b -> a
const Maybe CMode
forall a. Maybe a
Nothing) CMode -> Maybe CMode
forall a. a -> Maybe a
Just (Either () CMode -> Maybe CMode)
-> f (Either () CMode) -> f (Maybe CMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (IOError -> Maybe ()) -> f CMode -> f (Either () CMode)
forall (m :: * -> *) e b a.
(MonadUnliftIO m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust
    (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError)
    (do FileStatus
fileStatus <- IO FileStatus -> f FileStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileStatus -> f FileStatus) -> IO FileStatus -> f FileStatus
forall a b. (a -> b) -> a -> b
$ String -> IO FileStatus
Posix.getFileStatus String
fromFilePath
        -- Whenever we are not overwriting an existing file, we also need a
        -- copy of the file's contents
        Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (IOMode
iomode IOMode -> IOMode -> Bool
forall a. Eq a => a -> a -> Bool
== IOMode
WriteMode) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$ do
          String -> IOMode -> (Handle -> f ()) -> f ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> IOMode -> (Handle -> m a) -> m a
withBinaryFile String
fromFilePath IOMode
ReadMode (Handle -> Handle -> f ()
forall (m :: * -> *). MonadIO m => Handle -> Handle -> m ()
`copyHandleData` Handle
toHandle)
          Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (IOMode
iomode IOMode -> IOMode -> Bool
forall a. Eq a => a -> a -> Bool
== IOMode
AppendMode) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$ Handle -> SeekMode -> Integer -> f ()
forall (m :: * -> *).
MonadIO m =>
Handle -> SeekMode -> Integer -> m ()
hSeek Handle
toHandle SeekMode
AbsoluteSeek Integer
0
        -- Get the copy of source file permissions, but only whenever it exists
        CMode -> f CMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CMode -> f CMode) -> CMode -> f CMode
forall a b. (a -> b) -> a -> b
$ FileStatus -> CMode
Posix.fileMode FileStatus
fileStatus)


-- This is a copy of the internal function from `directory-1.3.3.2`. It became
-- available only in directory-1.3.3.0 and is still internal, hence the
-- duplication.
copyHandleData :: MonadIO m => Handle -> Handle -> m ()
copyHandleData :: Handle -> Handle -> m ()
copyHandleData Handle
hFrom Handle
hTo = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Any -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bufferSize Ptr Any -> IO ()
forall a. Ptr a -> IO ()
go
  where
    bufferSize :: Int
bufferSize = Int
131072 -- 128 KiB, as coreutils `cp` uses as of May 2014 (see ioblksize.h)
    go :: Ptr a -> IO ()
go Ptr a
buffer = do
      Int
count <- Handle -> Ptr a -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
hFrom Ptr a
buffer Int
bufferSize
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Handle -> Ptr a -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
hTo Ptr a
buffer Int
count
        Ptr a -> IO ()
go Ptr a
buffer

-- | Thread safe access to the file descriptor in the file handle
withHandleFd :: Handle -> (Fd -> IO a) -> IO a
withHandleFd :: Handle -> (Fd -> IO a) -> IO a
withHandleFd Handle
h Fd -> IO a
cb =
  case Handle
h of
    HandleFD.FileHandle String
_ MVar Handle__
mv ->
      MVar Handle__ -> (Handle__ -> IO a) -> IO a
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m b) -> m b
withMVar MVar Handle__
mv ((Handle__ -> IO a) -> IO a) -> (Handle__ -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \HandleFD.Handle__{haDevice :: ()
HandleFD.haDevice = dev
dev} ->
        case dev -> Maybe FD
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dev
dev of
          Just FD
fd -> Fd -> IO a
cb (Fd -> IO a) -> Fd -> IO a
forall a b. (a -> b) -> a -> b
$ CInt -> Fd
Fd (CInt -> Fd) -> CInt -> Fd
forall a b. (a -> b) -> a -> b
$ FD -> CInt
FD.fdFD FD
fd
          Maybe FD
Nothing -> String -> IO a
forall a. HasCallStack => String -> a
error String
"withHandleFd: not a file handle"
    HandleFD.DuplexHandle {} -> String -> IO a
forall a. HasCallStack => String -> a
error String
"withHandleFd: not a file handle"

-- | See `ensureFileDurable`
ensureFileDurable :: MonadIO m => FilePath -> m ()
ensureFileDurable :: String -> m ()
ensureFileDurable String
filePath =
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
  String -> (DirFd -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (DirFd -> m a) -> m a
withDirectory (ShowS
takeDirectory String
filePath) ((DirFd -> IO ()) -> IO ()) -> (DirFd -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DirFd
dirFd ->
    DirFd -> String -> IOMode -> (Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
DirFd -> String -> IOMode -> (Handle -> m a) -> m a
withFileInDirectory DirFd
dirFd String
filePath IOMode
ReadMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
fileHandle ->
      IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        String -> Handle -> IO ()
fsyncFileHandle String
"ensureFileDurablePosix" Handle
fileHandle
        -- NOTE: Here we are purposefully not fsyncing the directory if the file fails to fsync
        String -> DirFd -> IO ()
fsyncDirectoryFd String
"ensureFileDurablePosix" DirFd
dirFd



-- | See `withBinaryFileDurable`
withBinaryFileDurable ::
     MonadUnliftIO m => FilePath -> IOMode -> (Handle -> m r) -> m r
withBinaryFileDurable :: String -> IOMode -> (Handle -> m r) -> m r
withBinaryFileDurable String
filePath IOMode
iomode Handle -> m r
action =
  case IOMode
iomode of
    IOMode
ReadMode
      -- We do not need to consider durable operations when we are in a
      -- 'ReadMode', so we can use a regular `withBinaryFile`
     -> String -> IOMode -> (Handle -> m r) -> m r
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> IOMode -> (Handle -> m a) -> m a
withBinaryFile String
filePath IOMode
iomode Handle -> m r
action
    IOMode
_ {- WriteMode,  ReadWriteMode,  AppendMode -}
     ->
      String -> (DirFd -> m r) -> m r
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (DirFd -> m a) -> m a
withDirectory (ShowS
takeDirectory String
filePath) ((DirFd -> m r) -> m r) -> (DirFd -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \DirFd
dirFd ->
        DirFd -> String -> IOMode -> (Handle -> m r) -> m r
forall (m :: * -> *) a.
MonadUnliftIO m =>
DirFd -> String -> IOMode -> (Handle -> m a) -> m a
withFileInDirectory DirFd
dirFd String
filePath IOMode
iomode ((Handle -> m r) -> m r) -> (Handle -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \Handle
tmpFileHandle -> do
          r
res <- Handle -> m r
action Handle
tmpFileHandle
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            String -> Handle -> IO ()
fsyncFileHandle String
"withBinaryFileDurablePosix" Handle
tmpFileHandle
            -- NOTE: Here we are purposefully not fsyncing the directory if the file fails to fsync
            String -> DirFd -> IO ()
fsyncDirectoryFd String
"withBinaryFileDurablePosix" DirFd
dirFd
          r -> m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
res

-- | See `withBinaryFileDurableAtomic`
withBinaryFileDurableAtomic ::
     MonadUnliftIO m => FilePath -> IOMode -> (Handle -> m r) -> m r
withBinaryFileDurableAtomic :: String -> IOMode -> (Handle -> m r) -> m r
withBinaryFileDurableAtomic String
filePath IOMode
iomode Handle -> m r
action =
  case IOMode
iomode of
    IOMode
ReadMode
      -- We do not need to consider an atomic operation when we are in a
      -- 'ReadMode', so we can use a regular `withBinaryFile`
     -> String -> IOMode -> (Handle -> m r) -> m r
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> IOMode -> (Handle -> m a) -> m a
withBinaryFile String
filePath IOMode
iomode Handle -> m r
action
    IOMode
_ {- WriteMode,  ReadWriteMode,  AppendMode -}
     ->
      String -> (DirFd -> m r) -> m r
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (DirFd -> m a) -> m a
withDirectory (ShowS
takeDirectory String
filePath) ((DirFd -> m r) -> m r) -> (DirFd -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \DirFd
dirFd -> do
        Maybe r
mRes <- Maybe DirFd -> String -> IOMode -> (Handle -> m r) -> m (Maybe r)
forall (m :: * -> *) a.
MonadUnliftIO m =>
Maybe DirFd -> String -> IOMode -> (Handle -> m a) -> m (Maybe a)
withAnonymousBinaryTempFileFor (DirFd -> Maybe DirFd
forall a. a -> Maybe a
Just DirFd
dirFd) String
filePath IOMode
iomode ((Handle -> m r) -> m (Maybe r)) -> (Handle -> m r) -> m (Maybe r)
forall a b. (a -> b) -> a -> b
$
          DirFd -> Maybe String -> Handle -> m r
durableAtomicAction DirFd
dirFd Maybe String
forall a. Maybe a
Nothing
        case Maybe r
mRes of
          Just r
res -> r -> m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
res
          Maybe r
Nothing ->
            Maybe DirFd -> String -> IOMode -> (String -> Handle -> m r) -> m r
forall (m :: * -> *) a.
MonadUnliftIO m =>
Maybe DirFd -> String -> IOMode -> (String -> Handle -> m a) -> m a
withNonAnonymousBinaryTempFileFor (DirFd -> Maybe DirFd
forall a. a -> Maybe a
Just DirFd
dirFd) String
filePath IOMode
iomode ((String -> Handle -> m r) -> m r)
-> (String -> Handle -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \String
tmpFilePath ->
              DirFd -> Maybe String -> Handle -> m r
durableAtomicAction DirFd
dirFd (String -> Maybe String
forall a. a -> Maybe a
Just String
tmpFilePath)
  where
    durableAtomicAction :: DirFd -> Maybe String -> Handle -> m r
durableAtomicAction DirFd
dirFd Maybe String
mTmpFilePath Handle
tmpFileHandle = do
      Maybe CMode
mFileMode <- IOMode -> String -> Handle -> m (Maybe CMode)
forall (f :: * -> *).
MonadUnliftIO f =>
IOMode -> String -> Handle -> f (Maybe CMode)
copyFileHandle IOMode
iomode String
filePath Handle
tmpFileHandle
      r
res <- Handle -> m r
action Handle
tmpFileHandle
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
        DirFd -> Maybe CMode -> Handle -> Maybe String -> String -> IO ()
atomicDurableTempFileRename
          DirFd
dirFd
          Maybe CMode
mFileMode
          Handle
tmpFileHandle
          Maybe String
mTmpFilePath
          String
filePath
      r -> m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
res

-- | See `withBinaryFileAtomic`
withBinaryFileAtomic ::
     MonadUnliftIO m => FilePath -> IOMode -> (Handle -> m r) -> m r
withBinaryFileAtomic :: String -> IOMode -> (Handle -> m r) -> m r
withBinaryFileAtomic String
filePath IOMode
iomode Handle -> m r
action =
  case IOMode
iomode of
    IOMode
ReadMode
      -- We do not need to consider an atomic operation when we are in a
      -- 'ReadMode', so we can use a regular `withBinaryFile`
     -> String -> IOMode -> (Handle -> m r) -> m r
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> IOMode -> (Handle -> m a) -> m a
withBinaryFile String
filePath IOMode
iomode Handle -> m r
action
    IOMode
_ {- WriteMode,  ReadWriteMode,  AppendMode -}
     -> do
      Maybe r
mRes <-
        Maybe DirFd -> String -> IOMode -> (Handle -> m r) -> m (Maybe r)
forall (m :: * -> *) a.
MonadUnliftIO m =>
Maybe DirFd -> String -> IOMode -> (Handle -> m a) -> m (Maybe a)
withAnonymousBinaryTempFileFor Maybe DirFd
forall a. Maybe a
Nothing String
filePath IOMode
iomode ((Handle -> m r) -> m (Maybe r)) -> (Handle -> m r) -> m (Maybe r)
forall a b. (a -> b) -> a -> b
$
        Maybe String -> Handle -> m r
atomicAction Maybe String
forall a. Maybe a
Nothing
      case Maybe r
mRes of
        Just r
res -> r -> m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
res
        Maybe r
Nothing ->
          Maybe DirFd -> String -> IOMode -> (String -> Handle -> m r) -> m r
forall (m :: * -> *) a.
MonadUnliftIO m =>
Maybe DirFd -> String -> IOMode -> (String -> Handle -> m a) -> m a
withNonAnonymousBinaryTempFileFor Maybe DirFd
forall a. Maybe a
Nothing String
filePath IOMode
iomode ((String -> Handle -> m r) -> m r)
-> (String -> Handle -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \String
tmpFilePath ->
            Maybe String -> Handle -> m r
atomicAction (String -> Maybe String
forall a. a -> Maybe a
Just String
tmpFilePath)
  where
    atomicAction :: Maybe String -> Handle -> m r
atomicAction Maybe String
mTmpFilePath Handle
tmpFileHandle = do
      let eTmpFile :: Either Handle String
eTmpFile = Either Handle String
-> (String -> Either Handle String)
-> Maybe String
-> Either Handle String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Handle -> Either Handle String
forall a b. a -> Either a b
Left Handle
tmpFileHandle) String -> Either Handle String
forall a b. b -> Either a b
Right Maybe String
mTmpFilePath
      Maybe CMode
mFileMode <- IOMode -> String -> Handle -> m (Maybe CMode)
forall (f :: * -> *).
MonadUnliftIO f =>
IOMode -> String -> Handle -> f (Maybe CMode)
copyFileHandle IOMode
iomode String
filePath Handle
tmpFileHandle
      r
res <- Handle -> m r
action Handle
tmpFileHandle
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe DirFd
-> Maybe CMode -> Either Handle String -> String -> IO ()
atomicTempFileRename Maybe DirFd
forall a. Maybe a
Nothing Maybe CMode
mFileMode Either Handle String
eTmpFile String
filePath
      r -> m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
res