{-# 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 :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
OsPath -> (OsPath -> Handle -> m a) -> m a
withSystemTempFile OsPath
template OsPath -> Handle -> m a
action = do
  OsPath
tmpDir <- IO OsPath -> m OsPath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO OsPath
getCanonicalTemporaryDirectory
  OsPath -> OsPath -> (OsPath -> Handle -> m a) -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
OsPath -> OsPath -> (OsPath -> Handle -> m a) -> m a
withTempFile OsPath
tmpDir OsPath
template OsPath -> Handle -> m a
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 :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
OsPath -> (OsPath -> m a) -> m a
withSystemTempDirectory OsPath
template OsPath -> m a
action = do
  OsPath
tmpDir <- IO OsPath -> m OsPath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO OsPath
getCanonicalTemporaryDirectory
  OsPath -> OsPath -> (OsPath -> m a) -> m a
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
OsPath -> OsPath -> (OsPath -> m a) -> m a
withTempDirectory OsPath
tmpDir OsPath
template OsPath -> m a
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 :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
OsPath -> OsPath -> (OsPath -> Handle -> m a) -> m a
withTempFile OsPath
tmpDir OsPath
template OsPath -> Handle -> m a
action =
  m (OsPath, Handle)
-> ((OsPath, Handle) -> m ()) -> ((OsPath, Handle) -> m a) -> m a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
MC.bracket
    (IO (OsPath, Handle) -> m (OsPath, Handle)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (OsPath -> OsPath -> IO (OsPath, Handle)
openTempFile OsPath
tmpDir OsPath
template))
    (\(OsPath
name, Handle
handle) -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO ()
hClose Handle
handle IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> IO ()
forall (m :: * -> *). MonadCatch m => m () -> m ()
ignoringIOErrors (OsPath -> IO ()
removeFile OsPath
name)))
    ((OsPath -> Handle -> m a) -> (OsPath, Handle) -> m a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry OsPath -> Handle -> m a
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 :: forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
OsPath -> OsPath -> (OsPath -> m a) -> m a
withTempDirectory OsPath
targetDir OsPath
template =
  m OsPath -> (OsPath -> m ()) -> (OsPath -> m a) -> m a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
MC.bracket
    (IO OsPath -> m OsPath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (OsPath -> OsPath -> IO OsPath
createTempDirectory OsPath
targetDir OsPath
template))
    (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (OsPath -> IO ()) -> OsPath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (m :: * -> *). MonadCatch m => m () -> m ()
ignoringIOErrors (IO () -> IO ()) -> (OsPath -> IO ()) -> OsPath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> IO ()
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 :: OsPath -> OsPath -> LazyByteString -> IO OsPath
writeTempFile OsPath
targetDir OsPath
template LazyByteString
content =
  IO (OsPath, Handle)
-> ((OsPath, Handle) -> IO ())
-> ((OsPath, Handle) -> IO OsPath)
-> IO OsPath
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
MC.bracket
    (OsPath -> OsPath -> IO (OsPath, Handle)
openBinaryTempFile OsPath
targetDir OsPath
template)
    (\(OsPath
_, Handle
handle) -> Handle -> IO ()
hClose Handle
handle)
    (\(OsPath
filePath, Handle
handle) -> Handle -> LazyByteString -> IO ()
BL.hPut Handle
handle LazyByteString
content IO () -> IO OsPath -> IO OsPath
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> OsPath -> IO OsPath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsPath
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 :: OsPath -> LazyByteString -> IO OsPath
writeSystemTempFile OsPath
template LazyByteString
content = do
  OsPath
tmpDir <- IO OsPath
getCanonicalTemporaryDirectory
  OsPath -> OsPath -> LazyByteString -> IO OsPath
writeTempFile OsPath
tmpDir OsPath
template LazyByteString
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 :: OsPath -> OsPath -> IO OsPath
emptyTempFile OsPath
targetDir OsPath
template =
  IO (OsPath, Handle)
-> ((OsPath, Handle) -> IO ())
-> ((OsPath, Handle) -> IO OsPath)
-> IO OsPath
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
MC.bracket
    (OsPath -> OsPath -> IO (OsPath, Handle)
openBinaryTempFile OsPath
targetDir OsPath
template)
    (\(OsPath
_, Handle
handle) -> Handle -> IO ()
hClose Handle
handle)
    (\(OsPath
filePath, Handle
_) -> OsPath -> IO OsPath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsPath
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 :: OsPath -> IO OsPath
emptySystemTempFile OsPath
template = do
  OsPath
tmpDir <- IO OsPath
getCanonicalTemporaryDirectory
  OsPath -> OsPath -> IO OsPath
emptyTempFile OsPath
tmpDir OsPath
template

ignoringIOErrors :: MC.MonadCatch m => m () -> m ()
ignoringIOErrors :: forall (m :: * -> *). MonadCatch m => m () -> m ()
ignoringIOErrors m ()
ioe = m ()
ioe m () -> (IOError -> m ()) -> m ()
forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`MC.catch` (\(IOError
_ :: IOError) -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Legacy synonym for 'openBinaryTempFileWithDefaultPermissions'.
openNewBinaryFile :: OsPath -> OsString -> IO (OsPath, Handle)
openNewBinaryFile :: OsPath -> OsPath -> IO (OsPath, Handle)
openNewBinaryFile = OsPath -> OsPath -> IO (OsPath, Handle)
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 :: OsPath -> OsPath -> IO OsPath
createTempDirectory OsPath
dir OsPath
template = IO OsPath
findTempName
  where
    findTempName :: IO OsPath
    findTempName :: IO OsPath
findTempName = do
      OsPath
dirpath <- (OsPath
dir OsPath -> OsPath -> OsPath
</>) (OsPath -> OsPath) -> IO OsPath -> IO OsPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsPath -> IO OsPath
randomString (OsPath -> OsPath
sanitizeAsDirName OsPath
template)
      Either IOError ()
r <- IO () -> IO (Either IOError ())
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
MC.try (IO () -> IO (Either IOError ()))
-> IO () -> IO (Either IOError ())
forall a b. (a -> b) -> a -> b
$ OsPath -> IO ()
mkPrivateDir OsPath
dirpath
      case Either IOError ()
r of
        Right ()
_ -> OsPath -> IO OsPath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsPath
dirpath
        Left IOError
e
          | IOError -> Bool
isAlreadyExistsError IOError
e -> IO OsPath
findTempName
          | Bool
otherwise -> IOError -> IO OsPath
forall a. IOError -> IO a
ioError IOError
e

tempDirectoryCounter :: IORef Word
tempDirectoryCounter :: IORef Word
tempDirectoryCounter = IO (IORef Word) -> IORef Word
forall a. IO a -> a
unsafePerformIO (IO (IORef Word) -> IORef Word) -> IO (IORef Word) -> IORef Word
forall a b. (a -> b) -> a -> b
$ Word -> IO (IORef Word)
forall a. a -> IO (IORef a)
newIORef Word
0
{-# NOINLINE tempDirectoryCounter #-}

randomString :: OsString -> IO OsPath
randomString :: OsPath -> IO OsPath
randomString OsPath
template = do
  CPid
r1 <- IO CPid
c_getpid
  (Word
r2, Word
_) <- IORef Word -> (Word -> Word) -> IO (Word, Word)
forall a. IORef a -> (a -> a) -> IO (a, a)
atomicModifyIORef'_ IORef Word
tempDirectoryCounter (Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1)
  Integer
r3 <- (Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
logCpuTimePrecision) (Integer -> Integer) -> IO Integer -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Integer
getCPUTime
  let suffix :: String
suffix = CPid -> ShowS
forall a. Integral a => a -> ShowS
showHex (CPid -> CPid
forall a. Num a => a -> a
abs CPid
r1) (Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Word -> ShowS
forall a. Integral a => a -> ShowS
showHex Word
r2 (Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Integer -> ShowS
forall a. Integral a => a -> ShowS
showHex (Integer -> Integer
forall a. Num a => a -> a
abs Integer
r3) String
""))
  OsPath -> IO OsPath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OsPath -> IO OsPath) -> OsPath -> IO OsPath
forall a b. (a -> b) -> a -> b
$ OsPath
template OsPath -> OsPath -> OsPath
forall a. Semigroup a => a -> a -> a
<> IO OsPath -> OsPath
forall a. IO a -> a
unsafePerformIO (String -> IO OsPath
encodeFS String
suffix)

#ifdef netbsd_HOST_OS
-- cpuTimePrecision seems to fail on NetBSD
logCpuTimePrecision :: Int
logCpuTimePrecision = 0
#else
logCpuTimePrecision :: Int
logCpuTimePrecision :: Int
logCpuTimePrecision =
  Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word64 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
cpuTimePrecision :: Word64)
#endif

sanitizeAsDirName :: OsString -> OsPath
sanitizeAsDirName :: OsPath -> OsPath
sanitizeAsDirName = OsPath -> OsPath
makeValid (OsPath -> OsPath) -> (OsPath -> OsPath) -> OsPath -> OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OsChar -> Bool) -> OsPath -> OsPath
filter (\OsChar
c -> Bool -> Bool
not (OsChar -> Bool
isPathSeparator OsChar
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 :: OsPath -> OsPath -> IO OsPath
createTempFileName OsPath
dir OsPath
template = do
  OsPath
tempDir <- OsPath -> OsPath -> IO OsPath
createTempDirectory OsPath
dir OsPath
template
  OsPath -> IO OsPath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OsPath
tempDir OsPath -> OsPath -> OsPath
</> [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 :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
OsPath -> OsPath -> (OsPath -> m a) -> m a
withTempFileName OsPath
dir OsPath
template OsPath -> m a
k = OsPath -> OsPath -> (OsPath -> m a) -> m a
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
OsPath -> OsPath -> (OsPath -> m a) -> m a
withTempDirectory OsPath
dir OsPath
template ((OsPath -> m a) -> m a) -> (OsPath -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \OsPath
tempDir ->
  OsPath -> m a
k (OsPath
tempDir OsPath -> OsPath -> OsPath
</> [osp|temp_file|])

mkPrivateDir :: OsPath -> IO ()
#ifdef mingw32_HOST_OS
mkPrivateDir = createDirectory
#else
mkPrivateDir :: OsPath -> IO ()
mkPrivateDir OsPath
s =
  PosixString -> FileMode -> IO ()
System.Posix.Directory.PosixPath.createDirectory (OsPath -> PosixString
getOsString OsPath
s) FileMode
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 :: IO OsPath
getCanonicalTemporaryDirectory = IO OsPath
getTemporaryDirectory IO OsPath -> (OsPath -> IO OsPath) -> IO OsPath
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= OsPath -> IO OsPath
canonicalizePath