-- |
-- Module      :  System.AtomicWrite.Internal
-- Copyright   :  © 2015-2019 Stack Builders Inc.
-- License     :  MIT
--
-- Maintainer  :  Stack Builders <hackage@stackbuilders.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Provides functionality to create a temporary file with correct permissions
-- atomically.

module System.AtomicWrite.Internal where

import           System.Directory         (doesFileExist, renameFile)
import           System.FilePath          (takeDirectory)
import           System.IO                (Handle, hClose, hSetBinaryMode,
                                           openTempFile,
                                           openTempFileWithDefaultPermissions)
import           System.Posix.Types       (FileMode)
import           System.PosixCompat.Files (fileMode, getFileStatus, setFileMode)

-- | Returns a temporary file with permissions correctly set. Chooses
-- either previously-set permissions if the file that we're writing
-- to existed, or permissions following the current umask.
tempFileFor ::
  FilePath -- ^ The target filepath that we will replace atomically.
  -> IO (FilePath, Handle)
tempFileFor :: FilePath -> IO (FilePath, Handle)
tempFileFor FilePath
targetFilePath =

  FilePath -> IO Bool
doesFileExist FilePath
targetFilePath IO Bool -> (Bool -> IO (FilePath, Handle)) -> IO (FilePath, Handle)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    FilePath -> FilePath -> FilePath -> Bool -> IO (FilePath, Handle)
tmpFile FilePath
targetFilePath (FilePath -> FilePath
takeDirectory FilePath
targetFilePath) FilePath
"atomic.write"

  where

    tmpFile :: FilePath -> FilePath -> String -> Bool -> IO (FilePath, Handle)
    tmpFile :: FilePath -> FilePath -> FilePath -> Bool -> IO (FilePath, Handle)
tmpFile FilePath
targetPath FilePath
workingDirectory FilePath
template Bool
previousExisted =

      if Bool
previousExisted then
        FilePath -> FilePath -> IO (FilePath, Handle)
openTempFile FilePath
workingDirectory FilePath
template IO (FilePath, Handle)
-> ((FilePath, Handle) -> IO (FilePath, Handle))
-> IO (FilePath, Handle)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=

          \(FilePath
tmpPath, Handle
handle) ->

            FilePath -> IO FileStatus
getFileStatus FilePath
targetPath IO FileStatus -> (FileStatus -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> FileMode -> IO ()
setFileMode FilePath
tmpPath (FileMode -> IO ())
-> (FileStatus -> FileMode) -> FileStatus -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> FileMode
fileMode IO () -> IO (FilePath, Handle) -> IO (FilePath, Handle)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>

            (FilePath, Handle) -> IO (FilePath, Handle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
tmpPath, Handle
handle)

      else
        FilePath -> FilePath -> IO (FilePath, Handle)
openTempFileWithDefaultPermissions FilePath
workingDirectory FilePath
template


closeAndRename :: Handle -> FilePath -> FilePath -> IO ()
closeAndRename :: Handle -> FilePath -> FilePath -> IO ()
closeAndRename Handle
tmpHandle FilePath
tempFile FilePath
destFile =
  Handle -> IO ()
hClose Handle
tmpHandle IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> FilePath -> IO ()
renameFile FilePath
tempFile FilePath
destFile

maybeSetFileMode :: FilePath -> Maybe FileMode -> IO ()
maybeSetFileMode :: FilePath -> Maybe FileMode -> IO ()
maybeSetFileMode FilePath
path =
  IO () -> (FileMode -> IO ()) -> Maybe FileMode -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    ( () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () )
    ( \FileMode
mode -> FilePath -> FileMode -> IO ()
setFileMode FilePath
path FileMode
mode )


-- Helper Function
atomicWriteFileMaybeModeText ::
  Maybe FileMode -- ^ The mode to set the file to
  -> FilePath    -- ^ The path where the file will be updated or created
  -> (Handle -> a -> IO ()) -- ^ The function to use to write on the file
  -> a        -- ^ The content to write to the file
  -> IO ()
atomicWriteFileMaybeModeText :: forall a.
Maybe FileMode -> FilePath -> (Handle -> a -> IO ()) -> a -> IO ()
atomicWriteFileMaybeModeText Maybe FileMode
mmode FilePath
path Handle -> a -> IO ()
hF a
text =
  FilePath -> IO (FilePath, Handle)
tempFileFor FilePath
path IO (FilePath, Handle) -> ((FilePath, Handle) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(FilePath
tmpPath, Handle
h) -> Handle -> Bool -> IO ()
hSetBinaryMode Handle
h Bool
False
                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> a -> IO ()
hF Handle
h a
text
                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> FilePath -> FilePath -> IO ()
closeAndRename Handle
h FilePath
tmpPath FilePath
path
                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> Maybe FileMode -> IO ()
maybeSetFileMode FilePath
path Maybe FileMode
mmode
-- Helper Function
atomicWriteFileMaybeModeBinary ::
  Maybe FileMode -- ^ The mode to set the file to
  -> FilePath    -- ^ The path where the file will be updated or created
  -> (Handle -> a -> IO ()) -- ^ The function to use to write on the file
  -> a        -- ^ The content to write to the file
  -> IO ()
atomicWriteFileMaybeModeBinary :: forall a.
Maybe FileMode -> FilePath -> (Handle -> a -> IO ()) -> a -> IO ()
atomicWriteFileMaybeModeBinary Maybe FileMode
mmode FilePath
path Handle -> a -> IO ()
hF a
text =
  FilePath -> IO (FilePath, Handle)
tempFileFor FilePath
path IO (FilePath, Handle) -> ((FilePath, Handle) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(FilePath
tmpPath, Handle
h) -> Handle -> Bool -> IO ()
hSetBinaryMode Handle
h Bool
True
                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> a -> IO ()
hF Handle
h a
text
                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> FilePath -> FilePath -> IO ()
closeAndRename Handle
h FilePath
tmpPath FilePath
path
                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> Maybe FileMode -> IO ()
maybeSetFileMode FilePath
path Maybe FileMode
mmode