{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{- HLINT ignore "Avoid restricted function" -}
-- | Functions to create temporary files and directories.
--
-- Most functions come in two flavours: those that create files/directories
-- under the system standard temporary directory and those that use the
-- user-supplied directory.
--
-- The functions that create files/directories under the system standard
-- temporary directory will return canonical absolute paths (see
-- 'getCanonicalTemporaryDirectory'). The functions that use the user-supplied
-- directory will not canonicalize the returned path.
--
-- The action inside 'withTempFile' or 'withTempDirectory' is allowed to
-- remove the temporary file/directory if it needs to.
--
-- == Templates and file names
--
-- You shouldn't rely on the specific form of file or directory names
-- generated by the library; it has changed in the past and may change in the future
-- without bumping a major version.
module System.IO.Temp.OsPath (
withSystemTempFile,
withSystemTempDirectory,
withTempFile,
withTempDirectory,
openNewBinaryFile,
createTempDirectory,
writeTempFile,
writeSystemTempFile,
emptyTempFile,
emptySystemTempFile,
createTempFileName,
withTempFileName,
-- * Re-exports from "System.File.OsPath"
openTempFile,
openBinaryTempFile,
-- * Auxiliary functions
getCanonicalTemporaryDirectory,
) where
import qualified Control.Monad.Catch as MC
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Bits (countLeadingZeros, shiftR)
import Data.ByteString.Lazy (LazyByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Word (Word64)
import GHC.IORef (IORef, atomicModifyIORef'_, newIORef)
import Numeric (showHex)
import System.CPUTime (cpuTimePrecision, getCPUTime)
import System.Directory.OsPath (
canonicalizePath,
getTemporaryDirectory,
removeDirectoryRecursive,
removeFile,
)
import System.File.OsPath (
openBinaryTempFile,
openBinaryTempFileWithDefaultPermissions,
openTempFile,
)
import System.IO (
Handle,
hClose,
)
import System.IO.Error (isAlreadyExistsError)
import System.IO.Unsafe (unsafePerformIO)
import System.OsPath (
OsPath,
OsString,
encodeFS,
isPathSeparator,
makeValid,
osp,
(</>),
)
import System.OsString (filter)
import System.Posix.Internals (c_getpid)
import Prelude hiding (filter)
#ifdef mingw32_HOST_OS
import System.Directory.OsPath (createDirectory)
#else
import qualified System.Posix.Directory.PosixPath
import System.OsString.Internal.Types (getOsString)
#endif
-- | Create, open, and use a temporary file in the system standard temporary directory.
--
-- The temporary file is deleted after use.
--
-- Behaves exactly the same as 'withTempFile', except that the parent temporary directory
-- will be that returned by 'getCanonicalTemporaryDirectory'.
withSystemTempFile
:: (MonadIO m, MC.MonadMask m)
=> OsString
-- ^ File name template
-> (OsPath -> Handle -> m a)
-- ^ Callback that can use the file
-> m a
withSystemTempFile template action = do
tmpDir <- liftIO getCanonicalTemporaryDirectory
withTempFile tmpDir template action
-- | Create and use a temporary directory in the system standard temporary directory.
--
-- Behaves exactly the same as 'withTempDirectory', except that the parent temporary directory
-- will be that returned by 'getCanonicalTemporaryDirectory'.
withSystemTempDirectory
:: (MonadIO m, MC.MonadMask m)
=> OsString
-- ^ Directory name template
-> (OsPath -> m a)
-- ^ Callback that can use the directory
-> m a
withSystemTempDirectory template action = do
tmpDir <- liftIO getCanonicalTemporaryDirectory
withTempDirectory tmpDir template action
-- | Create, open (in text mode) and use a temporary file in the given directory.
--
-- The temporary file is deleted after use.
withTempFile
:: (MonadIO m, MC.MonadMask m)
=> OsPath
-- ^ Parent directory to create the file in
-> OsString
-- ^ File name template
-> (OsPath -> Handle -> m a)
-- ^ Callback that can use the file
-> m a
withTempFile tmpDir template action =
MC.bracket
(liftIO (openTempFile tmpDir template))
(\(name, handle) -> liftIO (hClose handle >> ignoringIOErrors (removeFile name)))
(uncurry action)
-- | Create and use a temporary directory inside the given directory.
--
-- The directory is deleted after use.
withTempDirectory
:: (MC.MonadMask m, MonadIO m)
=> OsPath
-- ^ Parent directory to create the directory in
-> OsString
-- ^ Directory name template
-> (OsPath -> m a)
-- ^ Callback that can use the directory
-> m a
withTempDirectory targetDir template =
MC.bracket
(liftIO (createTempDirectory targetDir template))
(liftIO . ignoringIOErrors . removeDirectoryRecursive)
-- | Create a unique new file, write a given data string to it,
-- and close the handle again. The file will not be deleted automatically,
-- and only the current user will have permission to access the file.
writeTempFile
:: OsPath
-- ^ Parent directory to create the file in
-> OsString
-- ^ File name template
-> LazyByteString
-- ^ Data to store in the file
-> IO OsPath
-- ^ Path to the (written and closed) file
writeTempFile targetDir template content =
MC.bracket
(openBinaryTempFile targetDir template)
(\(_, handle) -> hClose handle)
(\(filePath, handle) -> BL.hPut handle content >> pure filePath)
-- | Like 'writeTempFile', but use the system directory for temporary files.
writeSystemTempFile
:: OsString
-- ^ File name template
-> LazyByteString
-- ^ Data to store in the file
-> IO OsPath
-- ^ Path to the (written and closed) file
writeSystemTempFile template content = do
tmpDir <- getCanonicalTemporaryDirectory
writeTempFile tmpDir template content
-- | Create a unique new empty file. (Equivalent to 'writeTempFile' with empty data string.)
-- This is useful if the actual content is provided by an external process.
emptyTempFile
:: OsPath
-- ^ Parent directory to create the file in
-> OsString
-- ^ File name template
-> IO OsPath
-- ^ Path to the (written and closed) file
emptyTempFile targetDir template =
MC.bracket
(openBinaryTempFile targetDir template)
(\(_, handle) -> hClose handle)
(\(filePath, _) -> pure filePath)
-- | Like 'emptyTempFile', but use the system directory for temporary files.
emptySystemTempFile
:: OsString
-- ^ File name template
-> IO OsPath
-- ^ Path to the (written and closed) file
emptySystemTempFile template = do
tmpDir <- getCanonicalTemporaryDirectory
emptyTempFile tmpDir template
ignoringIOErrors :: MC.MonadCatch m => m () -> m ()
ignoringIOErrors ioe = ioe `MC.catch` (\(_ :: IOError) -> pure ())
-- | Legacy synonym for 'openBinaryTempFileWithDefaultPermissions'.
openNewBinaryFile :: OsPath -> OsString -> IO (OsPath, Handle)
openNewBinaryFile = openBinaryTempFileWithDefaultPermissions
{-# DEPRECATED openNewBinaryFile "Use 'openBinaryTempFileWithDefaultPermissions' instead" #-}
-- | Create a temporary directory.
createTempDirectory
:: OsPath
-- ^ Parent directory to create the directory in
-> OsString
-- ^ Directory name template
-> IO OsPath
createTempDirectory dir template = findTempName
where
findTempName :: IO OsPath
findTempName = do
dirpath <- (dir </>) <$> randomString (sanitizeAsDirName template)
r <- MC.try $ mkPrivateDir dirpath
case r of
Right _ -> pure dirpath
Left e
| isAlreadyExistsError e -> findTempName
| otherwise -> ioError e
tempDirectoryCounter :: IORef Word
tempDirectoryCounter = unsafePerformIO $ newIORef 0
{-# NOINLINE tempDirectoryCounter #-}
randomString :: OsString -> IO OsPath
randomString template = do
r1 <- c_getpid
(r2, _) <- atomicModifyIORef'_ tempDirectoryCounter (+ 1)
r3 <- (`shiftR` logCpuTimePrecision) <$> getCPUTime
let suffix = showHex (abs r1) ('-' : showHex r2 ('-' : showHex (abs r3) ""))
pure $ template <> unsafePerformIO (encodeFS suffix)
#ifdef netbsd_HOST_OS
-- cpuTimePrecision seems to fail on NetBSD
logCpuTimePrecision :: Int
logCpuTimePrecision = 0
#else
logCpuTimePrecision :: Int
logCpuTimePrecision =
64 - countLeadingZeros (fromInteger cpuTimePrecision :: Word64)
#endif
sanitizeAsDirName :: OsString -> OsPath
sanitizeAsDirName = makeValid . filter (\c -> not (isPathSeparator c))
-- | Get a temporary file name without creating a file.
--
-- If you merely want to create a temporary file or directory,
-- please use one of the functions above, such as 'withTempFile' or
-- 'withTempDirectory'.
--
-- This function can be useful when:
--
-- * you want to create a file of a special type, like a FIFO or a socket.
-- * you have a process/function that accepts a filename and then waits for it
-- to appear to do something, so you need to know the file name /before/ the
-- file is created.
-- * you need a target for an atomic rename operation.
--
-- This function works by creating a temporary directory with
-- 'createTempDirectory' and then returning a fixed file name within that
-- directory. On UNIX, the directory is created with the mode 0700, which
-- ensures that a different user cannot make us overwrite an existing file.
-- This makes this function more secure than merely generating a random file
-- name.
--
-- See also 'withTempFileName'.
createTempFileName
:: OsPath
-- ^ Parent directory to create the temporary directory in
-> OsString
-- ^ Directory name template
-> IO OsPath
createTempFileName dir template = do
tempDir <- createTempDirectory dir template
pure (tempDir </> [osp|temp_file|])
-- | Similarly to 'createTempFileName', this function creates a temporary
-- directory and constructs a fixed file name within it. The supplied callback is
-- called with the generated file name, and after it returns, the directory is
-- removed with all its contents.
--
-- Please read the documentation for 'createTempFileName' carefully and make
-- sure this is the right function for your needs before using it.
withTempFileName
:: (MonadIO m, MC.MonadMask m)
=> OsPath
-- ^ Parent directory to create the temporary directory in
-> OsString
-- ^ Directory name template
-> (OsPath -> m a)
-> m a
withTempFileName dir template k = withTempDirectory dir template $ \tempDir ->
k (tempDir </> [osp|temp_file|])
mkPrivateDir :: OsPath -> IO ()
#ifdef mingw32_HOST_OS
mkPrivateDir = createDirectory
#else
mkPrivateDir s =
System.Posix.Directory.PosixPath.createDirectory (getOsString s) 0o700
#endif
-- | Return the absolute and canonical path to the system temporary
-- directory.
--
-- >>> setCurrentDirectory "/home/username/"
-- >>> setEnv "TMPDIR" "."
-- >>> getTemporaryDirectory
-- "."
-- >>> getCanonicalTemporaryDirectory
-- "/home/username"
getCanonicalTemporaryDirectory :: IO OsPath
getCanonicalTemporaryDirectory = getTemporaryDirectory >>= canonicalizePath