    {- File mode utilities.
     -
     - Copyright 2010-2017 Joey Hess <id@joeyh.name>
     -
     - License: BSD-2-clause
     -}

    {-# LANGUAGE CPP #-}

    module Utility.FileMode (
    	module Utility.FileMode,
    	FileMode,
    ) where

    import System.IO
    import Control.Monad
    import System.PosixCompat.Types
    import System.PosixCompat.Files
    #ifndef mingw32_HOST_OS
    import System.Posix.Files (symbolicLinkMode)
    import Control.Monad.IO.Class (liftIO)
    #endif
    import Control.Monad.IO.Class (MonadIO)
    import Foreign (complement)
    import Control.Monad.Catch

    import Utility.Exception

    {- Applies a conversion function to a file's mode. -}
    modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO ()
    modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO ()
    modifyFileMode FilePath
    f FileMode -> FileMode
    convert = IO FileMode -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO FileMode -> IO ()) -> IO FileMode -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> (FileMode -> FileMode) -> IO FileMode
    modifyFileMode' FilePath
    f FileMode -> FileMode
    convert

    modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode
    modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode
    modifyFileMode' FilePath
    f FileMode -> FileMode
    convert = do
    	s <- FilePath -> IO FileStatus
    getFileStatus FilePath
    f
    	let old = FileStatus -> FileMode
    fileMode FileStatus
    s
    	let new = FileMode -> FileMode
    convert FileMode
    old
    	when (new /= old) $
    		setFileMode f new
    	return old

    {- Runs an action after changing a file's mode, then restores the old mode. -}
    withModifiedFileMode :: FilePath -> (FileMode -> FileMode) -> IO a -> IO a
    withModifiedFileMode :: forall a. FilePath -> (FileMode -> FileMode) -> IO a -> IO a
    withModifiedFileMode FilePath
    file FileMode -> FileMode
    convert IO a
    a = IO FileMode -> (FileMode -> IO ()) -> (FileMode -> IO a) -> IO a
    forall (m :: * -> *) a c b.
    (HasCallStack, MonadMask m) =>
    m a -> (a -> m c) -> (a -> m b) -> m b
    bracket IO FileMode
    setup FileMode -> IO ()
    cleanup FileMode -> IO a
    forall {p}. p -> IO a
    go
      where
    	setup :: IO FileMode
    setup = FilePath -> (FileMode -> FileMode) -> IO FileMode
    modifyFileMode' FilePath
    file FileMode -> FileMode
    convert
    	cleanup :: FileMode -> IO ()
    cleanup FileMode
    oldmode = FilePath -> (FileMode -> FileMode) -> IO ()
    modifyFileMode FilePath
    file (FileMode -> FileMode -> FileMode
    forall a b. a -> b -> a
    const FileMode
    oldmode)
    	go :: p -> IO a
    go p
    _ = IO a
    a

    {- Adds the specified FileModes to the input mode, leaving the rest
     - unchanged. -}
    addModes :: [FileMode] -> FileMode -> FileMode
    addModes :: [FileMode] -> FileMode -> FileMode
    addModes [FileMode]
    ms FileMode
    m = [FileMode] -> FileMode
    combineModes (FileMode
    mFileMode -> [FileMode] -> [FileMode]
    forall a. a -> [a] -> [a]
    :[FileMode]
    ms)

    {- Removes the specified FileModes from the input mode. -}
    removeModes :: [FileMode] -> FileMode -> FileMode
    removeModes :: [FileMode] -> FileMode -> FileMode
    removeModes [FileMode]
    ms FileMode
    m = FileMode
    m FileMode -> FileMode -> FileMode
    `intersectFileModes` FileMode -> FileMode
    forall a. Bits a => a -> a
    complement ([FileMode] -> FileMode
    combineModes [FileMode]
    ms)

    writeModes :: [FileMode]
    writeModes :: [FileMode]
    writeModes = [FileMode
    ownerWriteMode, FileMode
    groupWriteMode, FileMode
    otherWriteMode]

    readModes :: [FileMode]
    readModes :: [FileMode]
    readModes = [FileMode
    ownerReadMode, FileMode
    groupReadMode, FileMode
    otherReadMode]

    executeModes :: [FileMode]
    executeModes :: [FileMode]
    executeModes = [FileMode
    ownerExecuteMode, FileMode
    groupExecuteMode, FileMode
    otherExecuteMode]

    otherGroupModes :: [FileMode]
    otherGroupModes :: [FileMode]
    otherGroupModes =
    	[ FileMode
    groupReadMode, FileMode
    otherReadMode
    	, FileMode
    groupWriteMode, FileMode
    otherWriteMode
    	, FileMode
    groupExecuteMode, FileMode
    otherExecuteMode
    	]

    {- Removes the write bits from a file. -}
    preventWrite :: FilePath -> IO ()
    preventWrite :: FilePath -> IO ()
    preventWrite FilePath
    f = FilePath -> (FileMode -> FileMode) -> IO ()
    modifyFileMode FilePath
    f ((FileMode -> FileMode) -> IO ())
    -> (FileMode -> FileMode) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [FileMode] -> FileMode -> FileMode
    removeModes [FileMode]
    writeModes

    {- Turns a file's owner write bit back on. -}
    allowWrite :: FilePath -> IO ()
    allowWrite :: FilePath -> IO ()
    allowWrite FilePath
    f = FilePath -> (FileMode -> FileMode) -> IO ()
    modifyFileMode FilePath
    f ((FileMode -> FileMode) -> IO ())
    -> (FileMode -> FileMode) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [FileMode] -> FileMode -> FileMode
    addModes [FileMode
    ownerWriteMode]

    {- Turns a file's owner read bit back on. -}
    allowRead :: FilePath -> IO ()
    allowRead :: FilePath -> IO ()
    allowRead FilePath
    f = FilePath -> (FileMode -> FileMode) -> IO ()
    modifyFileMode FilePath
    f ((FileMode -> FileMode) -> IO ())
    -> (FileMode -> FileMode) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [FileMode] -> FileMode -> FileMode
    addModes [FileMode
    ownerReadMode]

    {- Allows owner and group to read and write to a file. -}
    groupSharedModes :: [FileMode]
    groupSharedModes :: [FileMode]
    groupSharedModes =
    	[ FileMode
    ownerWriteMode, FileMode
    groupWriteMode
    	, FileMode
    ownerReadMode, FileMode
    groupReadMode
    	]

    groupWriteRead :: FilePath -> IO ()
    groupWriteRead :: FilePath -> IO ()
    groupWriteRead FilePath
    f = FilePath -> (FileMode -> FileMode) -> IO ()
    modifyFileMode FilePath
    f ((FileMode -> FileMode) -> IO ())
    -> (FileMode -> FileMode) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [FileMode] -> FileMode -> FileMode
    addModes [FileMode]
    groupSharedModes

    checkMode :: FileMode -> FileMode -> Bool
    checkMode :: FileMode -> FileMode -> Bool
    checkMode FileMode
    checkfor FileMode
    mode = FileMode
    checkfor FileMode -> FileMode -> FileMode
    `intersectFileModes` FileMode
    mode FileMode -> FileMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == FileMode
    checkfor

    {- Checks if a file mode indicates it's a symlink. -}
    isSymLink :: FileMode -> Bool
    #ifdef mingw32_HOST_OS
    isSymLink _ = False
    #else
    isSymLink :: FileMode -> Bool
    isSymLink = FileMode -> FileMode -> Bool
    checkMode FileMode
    symbolicLinkMode
    #endif

    {- Checks if a file has any executable bits set. -}
    isExecutable :: FileMode -> Bool
    isExecutable :: FileMode -> Bool
    isExecutable FileMode
    mode = [FileMode] -> FileMode
    combineModes [FileMode]
    executeModes FileMode -> FileMode -> FileMode
    `intersectFileModes` FileMode
    mode FileMode -> FileMode -> Bool
    forall a. Eq a => a -> a -> Bool
    /= FileMode
    0

    {- Runs an action without that pesky umask influencing it, unless the
     - passed FileMode is the standard one. -}
    noUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a
    #ifndef mingw32_HOST_OS
    noUmask :: forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    FileMode -> m a -> m a
    noUmask FileMode
    mode m a
    a
    	| FileMode
    mode FileMode -> FileMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == FileMode
    stdFileMode = m a
    a
    	| Bool
    otherwise = FileMode -> m a -> m a
    forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    FileMode -> m a -> m a
    withUmask FileMode
    nullFileMode m a
    a
    #else
    noUmask _ a = a
    #endif

    withUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a
    #ifndef mingw32_HOST_OS
    withUmask :: forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    FileMode -> m a -> m a
    withUmask FileMode
    umask m a
    a = m FileMode -> (FileMode -> m FileMode) -> (FileMode -> m a) -> m a
    forall (m :: * -> *) a c b.
    (HasCallStack, MonadMask m) =>
    m a -> (a -> m c) -> (a -> m b) -> m b
    bracket m FileMode
    setup FileMode -> m FileMode
    cleanup FileMode -> m a
    forall {p}. p -> m a
    go
      where
    	setup :: m FileMode
    setup = IO FileMode -> m FileMode
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO FileMode -> m FileMode) -> IO FileMode -> m FileMode
    forall a b. (a -> b) -> a -> b
    $ FileMode -> IO FileMode
    setFileCreationMask FileMode
    umask
    	cleanup :: FileMode -> m FileMode
    cleanup = IO FileMode -> m FileMode
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO FileMode -> m FileMode)
    -> (FileMode -> IO FileMode) -> FileMode -> m FileMode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FileMode -> IO FileMode
    setFileCreationMask
    	go :: p -> m a
    go p
    _ = m a
    a
    #else
    withUmask _ a = a
    #endif

    getUmask :: IO FileMode
    #ifndef mingw32_HOST_OS
    getUmask :: IO FileMode
    getUmask = IO FileMode
    -> (FileMode -> IO FileMode)
    -> (FileMode -> IO FileMode)
    -> IO FileMode
    forall (m :: * -> *) a c b.
    (HasCallStack, MonadMask m) =>
    m a -> (a -> m c) -> (a -> m b) -> m b
    bracket IO FileMode
    setup FileMode -> IO FileMode
    cleanup FileMode -> IO FileMode
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
      where
    	setup :: IO FileMode
    setup = FileMode -> IO FileMode
    setFileCreationMask FileMode
    nullFileMode
    	cleanup :: FileMode -> IO FileMode
    cleanup = FileMode -> IO FileMode
    setFileCreationMask
    #else
    getUmask = return nullFileMode
    #endif

    defaultFileMode :: IO FileMode
    defaultFileMode :: IO FileMode
    defaultFileMode = do
    	umask <- IO FileMode
    getUmask
    	return $ intersectFileModes (complement umask) stdFileMode

    combineModes :: [FileMode] -> FileMode
    combineModes :: [FileMode] -> FileMode
    combineModes [] = FileMode
    0
    combineModes [FileMode
    m] = FileMode
    m
    combineModes (FileMode
    m:[FileMode]
    ms) = (FileMode -> FileMode -> FileMode)
    -> FileMode -> [FileMode] -> FileMode
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl FileMode -> FileMode -> FileMode
    unionFileModes FileMode
    m [FileMode]
    ms

    isSticky :: FileMode -> Bool
    #ifdef mingw32_HOST_OS
    isSticky _ = False
    #else
    isSticky :: FileMode -> Bool
    isSticky = FileMode -> FileMode -> Bool
    checkMode FileMode
    stickyMode

    stickyMode :: FileMode
    stickyMode :: FileMode
    stickyMode = FileMode
    512

    setSticky :: FilePath -> IO ()
    setSticky :: FilePath -> IO ()
    setSticky FilePath
    f = FilePath -> (FileMode -> FileMode) -> IO ()
    modifyFileMode FilePath
    f ((FileMode -> FileMode) -> IO ())
    -> (FileMode -> FileMode) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [FileMode] -> FileMode -> FileMode
    addModes [FileMode
    stickyMode]
    #endif

    {- Writes a file, ensuring that its modes do not allow it to be read
     - or written by anyone other than the current user,
     - before any content is written.
     -
     - When possible, this is done using the umask.
     -
     - On a filesystem that does not support file permissions, this is the same
     - as writeFile.
     -}
    writeFileProtected :: FilePath -> String -> IO ()
    writeFileProtected :: FilePath -> FilePath -> IO ()
    writeFileProtected FilePath
    file FilePath
    content = FilePath -> (Handle -> IO ()) -> IO ()
    writeFileProtected' FilePath
    file
    	(\Handle
    h -> Handle -> FilePath -> IO ()
    hPutStr Handle
    h FilePath
    content)

    writeFileProtected' :: FilePath -> (Handle -> IO ()) -> IO ()
    writeFileProtected' :: FilePath -> (Handle -> IO ()) -> IO ()
    writeFileProtected' FilePath
    file Handle -> IO ()
    writer = IO () -> IO ()
    forall a. IO a -> IO a
    protectedOutput (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    	FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
    withFile FilePath
    file IOMode
    WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
    		IO (Either IOException ()) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Either IOException ()) -> IO ())
    -> IO (Either IOException ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO (Either IOException ())
    forall (m :: * -> *) a.
    MonadCatch m =>
    m a -> m (Either IOException a)
    tryIO (IO () -> IO (Either IOException ()))
    -> IO () -> IO (Either IOException ())
    forall a b. (a -> b) -> a -> b
    $ FilePath -> (FileMode -> FileMode) -> IO ()
    modifyFileMode FilePath
    file ((FileMode -> FileMode) -> IO ())
    -> (FileMode -> FileMode) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [FileMode] -> FileMode -> FileMode
    removeModes [FileMode]
    otherGroupModes
    		Handle -> IO ()
    writer Handle
    h

    protectedOutput :: IO a -> IO a
    protectedOutput :: forall a. IO a -> IO a
    protectedOutput = FileMode -> IO a -> IO a
    forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    FileMode -> m a -> m a
    withUmask FileMode
    0o0077