{-# LANGUAGE CPP                 #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Conduit.Tar.Unix
    ( getFileInfo
    , restoreFileInternal
    ) where

import           Conduit                       hiding (throwM)
import           Control.Exception.Safe
import           Control.Monad                 (void, when, unless)
import           Data.Bits
import qualified Data.ByteString.Char8         as S8
import           Data.Either
import           Data.Conduit.Tar.Types
import           Foreign.C.Types               (CTime (..))
import qualified System.Directory              as Dir
import qualified System.Posix.Files            as Posix
import qualified System.Posix.User             as Posix
import qualified System.FilePath.Posix         as Posix

getFileInfo :: FilePath -> IO FileInfo
getFileInfo :: FilePath -> IO FileInfo
getFileInfo FilePath
fpStr = do
    let fp :: ByteString
fp = FilePath -> ByteString
encodeFilePath FilePath
fpStr
    FileStatus
fs <- FilePath -> IO FileStatus
Posix.getSymbolicLinkStatus FilePath
fpStr
    let uid :: UserID
uid = FileStatus -> UserID
Posix.fileOwner FileStatus
fs
        gid :: GroupID
gid = FileStatus -> GroupID
Posix.fileGroup FileStatus
fs
    -- Allow for username/group retrieval failure, especially useful for non-tty environment.
    -- Workaround for: https://ghc.haskell.org/trac/ghc/ticket/1487
    -- Moreover, names are non-critical as they are not used during unarchival process
    Either IOException UserEntry
euEntry :: Either IOException Posix.UserEntry <- IO UserEntry -> IO (Either IOException UserEntry)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (IO UserEntry -> IO (Either IOException UserEntry))
-> IO UserEntry -> IO (Either IOException UserEntry)
forall a b. (a -> b) -> a -> b
$ UserID -> IO UserEntry
Posix.getUserEntryForID UserID
uid
    Either IOException GroupEntry
egEntry :: Either IOException Posix.GroupEntry <- IO GroupEntry -> IO (Either IOException GroupEntry)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (IO GroupEntry -> IO (Either IOException GroupEntry))
-> IO GroupEntry -> IO (Either IOException GroupEntry)
forall a b. (a -> b) -> a -> b
$ GroupID -> IO GroupEntry
Posix.getGroupEntryForID GroupID
gid
    (FileType
fType, FileOffset
fSize) <-
        case () of
            () | FileStatus -> Bool
Posix.isRegularFile FileStatus
fs     -> (FileType, FileOffset) -> IO (FileType, FileOffset)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileType
FTNormal, FileStatus -> FileOffset
Posix.fileSize FileStatus
fs)
               | FileStatus -> Bool
Posix.isSymbolicLink FileStatus
fs    -> do
                     FilePath
ln <- FilePath -> IO FilePath
Posix.readSymbolicLink FilePath
fpStr
                     (FileType, FileOffset) -> IO (FileType, FileOffset)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> FileType
FTSymbolicLink (FilePath -> ByteString
encodeFilePath FilePath
ln), FileOffset
0)
               | FileStatus -> Bool
Posix.isCharacterDevice FileStatus
fs -> (FileType, FileOffset) -> IO (FileType, FileOffset)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileType
FTCharacterSpecial, FileOffset
0)
               | FileStatus -> Bool
Posix.isBlockDevice FileStatus
fs     -> (FileType, FileOffset) -> IO (FileType, FileOffset)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileType
FTBlockSpecial, FileOffset
0)
               | FileStatus -> Bool
Posix.isDirectory FileStatus
fs       -> (FileType, FileOffset) -> IO (FileType, FileOffset)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileType
FTDirectory, FileOffset
0)
               | FileStatus -> Bool
Posix.isNamedPipe FileStatus
fs       -> (FileType, FileOffset) -> IO (FileType, FileOffset)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileType
FTFifo, FileOffset
0)
               | Bool
otherwise                  -> FilePath -> IO (FileType, FileOffset)
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO (FileType, FileOffset))
-> FilePath -> IO (FileType, FileOffset)
forall a b. (a -> b) -> a -> b
$ FilePath
"Unsupported file type: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ByteString -> FilePath
S8.unpack ByteString
fp
    FileInfo -> IO FileInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (FileInfo -> IO FileInfo) -> FileInfo -> IO FileInfo
forall a b. (a -> b) -> a -> b
$! FileInfo :: ByteString
-> UserID
-> ByteString
-> GroupID
-> ByteString
-> FileMode
-> FileOffset
-> FileType
-> EpochTime
-> FileInfo
FileInfo
        { filePath :: ByteString
filePath      = ByteString
fp
        , fileUserId :: UserID
fileUserId    = UserID
uid
        , fileUserName :: ByteString
fileUserName  = (IOException -> ByteString)
-> (UserEntry -> ByteString)
-> Either IOException UserEntry
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> IOException -> ByteString
forall a b. a -> b -> a
const ByteString
"") (FilePath -> ByteString
S8.pack (FilePath -> ByteString)
-> (UserEntry -> FilePath) -> UserEntry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserEntry -> FilePath
Posix.userName) Either IOException UserEntry
euEntry
        , fileGroupId :: GroupID
fileGroupId   = GroupID
gid
        , fileGroupName :: ByteString
fileGroupName = (IOException -> ByteString)
-> (GroupEntry -> ByteString)
-> Either IOException GroupEntry
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> IOException -> ByteString
forall a b. a -> b -> a
const ByteString
"") (FilePath -> ByteString
S8.pack (FilePath -> ByteString)
-> (GroupEntry -> FilePath) -> GroupEntry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupEntry -> FilePath
Posix.groupName) Either IOException GroupEntry
egEntry
        , fileMode :: FileMode
fileMode      = FileStatus -> FileMode
Posix.fileMode FileStatus
fs FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.&. FileMode
0o7777
        , fileSize :: FileOffset
fileSize      = FileOffset
fSize
        , fileType :: FileType
fileType      = FileType
fType
        , fileModTime :: EpochTime
fileModTime   = FileStatus -> EpochTime
Posix.modificationTime FileStatus
fs
        }

-- | See 'Data.Conduit.Tar.restoreFileWithErrors' for documentation
restoreFileInternal ::
       (MonadResource m)
    => Bool
    -> FileInfo
    -> ConduitM S8.ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileInternal :: Bool
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileInternal Bool
lenient fi :: FileInfo
fi@FileInfo {FileMode
FileOffset
GroupID
UserID
EpochTime
ByteString
FileType
fileModTime :: EpochTime
fileType :: FileType
fileSize :: FileOffset
fileMode :: FileMode
fileGroupName :: ByteString
fileGroupId :: GroupID
fileUserName :: ByteString
fileUserId :: UserID
filePath :: ByteString
fileModTime :: FileInfo -> EpochTime
fileType :: FileInfo -> FileType
fileSize :: FileInfo -> FileOffset
fileMode :: FileInfo -> FileMode
fileGroupName :: FileInfo -> ByteString
fileGroupId :: FileInfo -> GroupID
fileUserName :: FileInfo -> ByteString
fileUserId :: FileInfo -> UserID
filePath :: FileInfo -> ByteString
..} = do
    let fpStr :: FilePath
fpStr = ByteString -> FilePath
decodeFilePath ByteString
filePath
        tryAnyCond :: f b -> f (Either SomeException b)
tryAnyCond f b
action = if Bool
lenient then f b -> f (Either SomeException b)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAny f b
action else (b -> Either SomeException b) -> f b -> f (Either SomeException b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either SomeException b
forall a b. b -> Either a b
Right f b
action
        restorePermissions :: IO [SomeException]
restorePermissions = do
            Either SomeException ()
eExc1 <- IO () -> IO (Either SomeException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAnyCond (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ FilePath -> UserID -> GroupID -> IO ()
Posix.setOwnerAndGroup FilePath
fpStr UserID
fileUserId GroupID
fileGroupId
            Either SomeException ()
eExc2 <- IO () -> IO (Either SomeException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAnyCond (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ FilePath -> FileMode -> IO ()
Posix.setFileMode FilePath
fpStr FileMode
fileMode
            [SomeException] -> IO [SomeException]
forall (m :: * -> *) a. Monad m => a -> m a
return ([SomeException] -> IO [SomeException])
-> [SomeException] -> IO [SomeException]
forall a b. (a -> b) -> a -> b
$! ([SomeException], [()]) -> [SomeException]
forall a b. (a, b) -> a
fst (([SomeException], [()]) -> [SomeException])
-> ([SomeException], [()]) -> [SomeException]
forall a b. (a -> b) -> a -> b
$ [Either SomeException ()] -> ([SomeException], [()])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either SomeException ()
eExc1, Either SomeException ()
eExc2]
        -- | Catch all exceptions, but only if lenient is set to True
    case FileType
fileType of
        FileType
FTDirectory -> do
            [SomeException]
excs <- IO [SomeException]
-> ConduitT
     ByteString (IO (FileInfo, [SomeException])) m [SomeException]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SomeException]
 -> ConduitT
      ByteString (IO (FileInfo, [SomeException])) m [SomeException])
-> IO [SomeException]
-> ConduitT
     ByteString (IO (FileInfo, [SomeException])) m [SomeException]
forall a b. (a -> b) -> a -> b
$ do
                Bool -> FilePath -> IO ()
Dir.createDirectoryIfMissing Bool
True FilePath
fpStr
                IO [SomeException]
restorePermissions
            IO (FileInfo, [SomeException])
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (IO (FileInfo, [SomeException])
 -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
-> IO (FileInfo, [SomeException])
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall a b. (a -> b) -> a -> b
$ do
                Either SomeException ()
eExc <- IO () -> IO (Either SomeException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAnyCond (FilePath -> IO Bool
Dir.doesDirectoryExist FilePath
fpStr IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                    (Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` FilePath -> EpochTime -> EpochTime -> IO ()
Posix.setFileTimes FilePath
fpStr EpochTime
fileModTime EpochTime
fileModTime))
                (FileInfo, [SomeException]) -> IO (FileInfo, [SomeException])
forall (m :: * -> *) a. Monad m => a -> m a
return (FileInfo
fi, (SomeException -> [SomeException])
-> (() -> [SomeException])
-> Either SomeException ()
-> [SomeException]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (([SomeException]
excs [SomeException] -> [SomeException] -> [SomeException]
forall a. [a] -> [a] -> [a]
++) ([SomeException] -> [SomeException])
-> (SomeException -> [SomeException])
-> SomeException
-> [SomeException]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> [SomeException]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) ([SomeException] -> () -> [SomeException]
forall a b. a -> b -> a
const [SomeException]
excs) Either SomeException ()
eExc)
        FTSymbolicLink ByteString
link -> do
            [SomeException]
excs <- IO [SomeException]
-> ConduitT
     ByteString (IO (FileInfo, [SomeException])) m [SomeException]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SomeException]
 -> ConduitT
      ByteString (IO (FileInfo, [SomeException])) m [SomeException])
-> IO [SomeException]
-> ConduitT
     ByteString (IO (FileInfo, [SomeException])) m [SomeException]
forall a b. (a -> b) -> a -> b
$ do
                -- Try to unlink any existing file/symlink
                IO (Either SomeException ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either SomeException ()) -> IO ())
-> IO (Either SomeException ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either SomeException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAny (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
Posix.removeLink FilePath
fpStr
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
lenient (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
Dir.createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
Posix.takeDirectory FilePath
fpStr
                FilePath -> FilePath -> IO ()
Posix.createSymbolicLink (ByteString -> FilePath
decodeFilePath ByteString
link) FilePath
fpStr
                Either SomeException ()
eExc1 <- IO () -> IO (Either SomeException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAnyCond (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ FilePath -> UserID -> GroupID -> IO ()
Posix.setSymbolicLinkOwnerAndGroup FilePath
fpStr UserID
fileUserId GroupID
fileGroupId
#if MIN_VERSION_unix(2,7,0)
                -- Try best effort in setting symbolic link modification time.
                let CTime Int64
epochInt32 = EpochTime
fileModTime
                    unixModTime :: POSIXTime
unixModTime = Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
epochInt32)
                Either SomeException ()
eExc2 <- IO () -> IO (Either SomeException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAny (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ FilePath -> POSIXTime -> POSIXTime -> IO ()
Posix.setSymbolicLinkTimesHiRes FilePath
fpStr POSIXTime
unixModTime POSIXTime
unixModTime
#endif
                [SomeException] -> IO [SomeException]
forall (m :: * -> *) a. Monad m => a -> m a
return ([SomeException] -> IO [SomeException])
-> [SomeException] -> IO [SomeException]
forall a b. (a -> b) -> a -> b
$ ([SomeException], [()]) -> [SomeException]
forall a b. (a, b) -> a
fst (([SomeException], [()]) -> [SomeException])
-> ([SomeException], [()]) -> [SomeException]
forall a b. (a -> b) -> a -> b
$ [Either SomeException ()] -> ([SomeException], [()])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either SomeException ()
eExc1, Either SomeException ()
eExc2]
            Bool
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SomeException] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SomeException]
excs) (ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
 -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall a b. (a -> b) -> a -> b
$ IO (FileInfo, [SomeException])
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ((FileInfo, [SomeException]) -> IO (FileInfo, [SomeException])
forall (m :: * -> *) a. Monad m => a -> m a
return (FileInfo
fi, [SomeException]
excs))
        FTHardLink ByteString
link -> do
            [SomeException]
excs <- IO [SomeException]
-> ConduitT
     ByteString (IO (FileInfo, [SomeException])) m [SomeException]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SomeException]
 -> ConduitT
      ByteString (IO (FileInfo, [SomeException])) m [SomeException])
-> IO [SomeException]
-> ConduitT
     ByteString (IO (FileInfo, [SomeException])) m [SomeException]
forall a b. (a -> b) -> a -> b
$ do
                let linkedFp :: FilePath
linkedFp = ByteString -> FilePath
decodeFilePath ByteString
link
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
lenient (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    Bool
linkedFileExists <- FilePath -> IO Bool
Posix.fileExist FilePath
linkedFp
                    -- If the linked file does not exist (yet), we cannot create a hard link.
                    -- Try to "pre-create" it.
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
linkedFileExists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        Bool -> FilePath -> IO ()
Dir.createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
Posix.takeDirectory FilePath
linkedFp
                        FilePath -> FilePath -> IO ()
writeFile FilePath
linkedFp FilePath
""
                Bool -> FilePath -> IO ()
Dir.createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
Posix.takeDirectory FilePath
fpStr
                -- Try to unlink any existing file/hard link
                IO (Either SomeException ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either SomeException ()) -> IO ())
-> IO (Either SomeException ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either SomeException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAny (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
Posix.removeLink FilePath
fpStr
                FilePath -> FilePath -> IO ()
Posix.createLink FilePath
linkedFp FilePath
fpStr
                IO [SomeException] -> IO [SomeException]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SomeException] -> IO [SomeException])
-> IO [SomeException] -> IO [SomeException]
forall a b. (a -> b) -> a -> b
$ do
                    [SomeException]
excs <- IO [SomeException]
restorePermissions
                    Either SomeException ()
eExc <- IO () -> IO (Either SomeException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAnyCond (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ FilePath -> EpochTime -> EpochTime -> IO ()
Posix.setFileTimes FilePath
fpStr EpochTime
fileModTime EpochTime
fileModTime
                    [SomeException] -> IO [SomeException]
forall (m :: * -> *) a. Monad m => a -> m a
return ((SomeException -> [SomeException])
-> (() -> [SomeException])
-> Either SomeException ()
-> [SomeException]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (([SomeException]
excs [SomeException] -> [SomeException] -> [SomeException]
forall a. [a] -> [a] -> [a]
++) ([SomeException] -> [SomeException])
-> (SomeException -> [SomeException])
-> SomeException
-> [SomeException]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> [SomeException]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) ([SomeException] -> () -> [SomeException]
forall a b. a -> b -> a
const [SomeException]
excs) Either SomeException ()
eExc)
            Bool
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SomeException] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SomeException]
excs) (ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
 -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall a b. (a -> b) -> a -> b
$ IO (FileInfo, [SomeException])
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ((FileInfo, [SomeException]) -> IO (FileInfo, [SomeException])
forall (m :: * -> *) a. Monad m => a -> m a
return (FileInfo
fi, [SomeException]
excs))
        FileType
FTNormal -> do
            Bool
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
lenient (ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
 -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall a b. (a -> b) -> a -> b
$ IO () -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
-> IO ()
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
Dir.createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
Posix.takeDirectory FilePath
fpStr
            FilePath
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (m :: * -> *) o.
MonadResource m =>
FilePath -> ConduitT ByteString o m ()
sinkFile FilePath
fpStr
            [SomeException]
excs <- IO [SomeException]
-> ConduitT
     ByteString (IO (FileInfo, [SomeException])) m [SomeException]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SomeException]
 -> ConduitT
      ByteString (IO (FileInfo, [SomeException])) m [SomeException])
-> IO [SomeException]
-> ConduitT
     ByteString (IO (FileInfo, [SomeException])) m [SomeException]
forall a b. (a -> b) -> a -> b
$ do
                [SomeException]
excs <- IO [SomeException]
restorePermissions
                Either SomeException ()
eExc <- IO () -> IO (Either SomeException ())
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAnyCond (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ FilePath -> EpochTime -> EpochTime -> IO ()
Posix.setFileTimes FilePath
fpStr EpochTime
fileModTime EpochTime
fileModTime
                [SomeException] -> IO [SomeException]
forall (m :: * -> *) a. Monad m => a -> m a
return ((SomeException -> [SomeException])
-> (() -> [SomeException])
-> Either SomeException ()
-> [SomeException]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (([SomeException]
excs [SomeException] -> [SomeException] -> [SomeException]
forall a. [a] -> [a] -> [a]
++) ([SomeException] -> [SomeException])
-> (SomeException -> [SomeException])
-> SomeException
-> [SomeException]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> [SomeException]
forall (f :: * -> *) a. Applicative f => a -> f a
pure) ([SomeException] -> () -> [SomeException]
forall a b. a -> b -> a
const [SomeException]
excs) Either SomeException ()
eExc)
            Bool
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([SomeException] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SomeException]
excs) (ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
 -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall a b. (a -> b) -> a -> b
$ IO (FileInfo, [SomeException])
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (IO (FileInfo, [SomeException])
 -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
-> IO (FileInfo, [SomeException])
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall a b. (a -> b) -> a -> b
$ (FileInfo, [SomeException]) -> IO (FileInfo, [SomeException])
forall (m :: * -> *) a. Monad m => a -> m a
return (FileInfo
fi, [SomeException]
excs)
        FileType
ty -> do
            let exc :: TarException
exc = FileType -> TarException
UnsupportedType FileType
ty
            Bool
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
lenient (ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
 -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall a b. (a -> b) -> a -> b
$ IO () -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
-> IO ()
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall a b. (a -> b) -> a -> b
$ TarException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TarException
exc
            IO (FileInfo, [SomeException])
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (IO (FileInfo, [SomeException])
 -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
-> IO (FileInfo, [SomeException])
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall a b. (a -> b) -> a -> b
$ (FileInfo, [SomeException]) -> IO (FileInfo, [SomeException])
forall (m :: * -> *) a. Monad m => a -> m a
return (FileInfo
fi, [TarException -> SomeException
forall e. Exception e => e -> SomeException
toException TarException
exc])