{-# 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
#if MIN_VERSION_unix(2,8,0)
import qualified System.Posix.User.ByteString as UBS
#endif

getFileInfo :: FilePath -> IO FileInfo
getFileInfo :: [Char] -> IO FileInfo
getFileInfo [Char]
fpStr = do
    let fp :: ByteString
fp = [Char] -> ByteString
encodeFilePath [Char]
fpStr
    FileStatus
fs <- [Char] -> IO FileStatus
Posix.getSymbolicLinkStatus [Char]
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
#if MIN_VERSION_unix(2,8,0)
    Either IOException UserEntry
euEntry :: Either IOException UBS.UserEntry <- IO UserEntry -> IO (Either IOException UserEntry)
forall (m :: * -> *) e a.
(HasCallStack, 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 UBS.GroupEntry <- IO GroupEntry -> IO (Either IOException GroupEntry)
forall (m :: * -> *) e a.
(HasCallStack, 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
    let
      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
"") UserEntry -> ByteString
UBS.userName Either IOException UserEntry
euEntry
      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
"") GroupEntry -> ByteString
UBS.groupName Either IOException GroupEntry
egEntry
#else
    euEntry :: Either IOException Posix.UserEntry <- try $ Posix.getUserEntryForID uid
    egEntry :: Either IOException Posix.GroupEntry <- try $ Posix.getGroupEntryForID gid
    let
      fileUserName = either (const "") (S8.pack . Posix.userName) euEntry
      fileGroupName = either (const "") (S8.pack . Posix.groupName) egEntry
#endif
    (FileType
fType, FileOffset
fSize) <-
        case () of
            () | FileStatus -> Bool
Posix.isRegularFile FileStatus
fs     -> (FileType, FileOffset) -> IO (FileType, FileOffset)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FileType
FTNormal, FileStatus -> FileOffset
Posix.fileSize FileStatus
fs)
               | FileStatus -> Bool
Posix.isSymbolicLink FileStatus
fs    -> do
                     [Char]
ln <- [Char] -> IO [Char]
Posix.readSymbolicLink [Char]
fpStr
                     (FileType, FileOffset) -> IO (FileType, FileOffset)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> FileType
FTSymbolicLink ([Char] -> ByteString
encodeFilePath [Char]
ln), FileOffset
0)
               | FileStatus -> Bool
Posix.isCharacterDevice FileStatus
fs -> (FileType, FileOffset) -> IO (FileType, FileOffset)
forall a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FileType
FTFifo, FileOffset
0)
               | Bool
otherwise                  -> [Char] -> IO (FileType, FileOffset)
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO (FileType, FileOffset))
-> [Char] -> IO (FileType, FileOffset)
forall a b. (a -> b) -> a -> b
$ [Char]
"Unsupported file type: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
S8.unpack ByteString
fp
    FileInfo -> IO FileInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FileInfo -> IO FileInfo) -> FileInfo -> IO FileInfo
forall a b. (a -> b) -> a -> b
$! FileInfo
        { filePath :: ByteString
filePath      = ByteString
fp
        , fileUserId :: UserID
fileUserId    = UserID
uid
        , fileUserName :: ByteString
fileUserName  = ByteString
fileUserName
        , fileGroupId :: GroupID
fileGroupId   = GroupID
gid
        , fileGroupName :: ByteString
fileGroupName = ByteString
fileGroupName
        , 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 :: forall (m :: * -> *).
MonadResource m =>
Bool
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileInternal Bool
lenient fi :: FileInfo
fi@FileInfo {EpochTime
UserID
GroupID
FileOffset
FileMode
ByteString
FileType
filePath :: FileInfo -> ByteString
fileUserId :: FileInfo -> UserID
fileUserName :: FileInfo -> ByteString
fileGroupId :: FileInfo -> GroupID
fileGroupName :: FileInfo -> ByteString
fileMode :: FileInfo -> FileMode
fileSize :: FileInfo -> FileOffset
fileType :: FileInfo -> FileType
fileModTime :: FileInfo -> EpochTime
filePath :: ByteString
fileUserId :: UserID
fileUserName :: ByteString
fileGroupId :: GroupID
fileGroupName :: ByteString
fileMode :: FileMode
fileSize :: FileOffset
fileType :: FileType
fileModTime :: EpochTime
..} = do
    let fpStr :: [Char]
fpStr = ByteString -> [Char]
decodeFilePath ByteString
filePath
        tryAnyCond :: m a -> m (Either SomeException a)
tryAnyCond m a
action = if Bool
lenient then m a -> m (Either SomeException a)
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryAny m a
action else (a -> Either SomeException a) -> m a -> m (Either SomeException a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either SomeException a
forall a b. b -> Either a b
Right m a
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
$ [Char] -> UserID -> GroupID -> IO ()
Posix.setOwnerAndGroup [Char]
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
$ [Char] -> FileMode -> IO ()
Posix.setFileMode [Char]
fpStr FileMode
fileMode
            [SomeException] -> IO [SomeException]
forall a. a -> IO a
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 a.
IO a -> ConduitT ByteString (IO (FileInfo, [SomeException])) m a
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 -> [Char] -> IO ()
Dir.createDirectoryIfMissing Bool
True [Char]
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 ([Char] -> IO Bool
Dir.doesDirectoryExist [Char]
fpStr IO Bool -> (Bool -> 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
>>=
                                    (Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` [Char] -> EpochTime -> EpochTime -> IO ()
Posix.setFileTimes [Char]
fpStr EpochTime
fileModTime EpochTime
fileModTime))
                (FileInfo, [SomeException]) -> IO (FileInfo, [SomeException])
forall a. a -> IO a
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 a. a -> [a]
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 a.
IO a -> ConduitT ByteString (IO (FileInfo, [SomeException])) m a
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.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryAny (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
Posix.removeLink [Char]
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 -> [Char] -> IO ()
Dir.createDirectoryIfMissing Bool
True ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
Posix.takeDirectory [Char]
fpStr
                [Char] -> [Char] -> IO ()
Posix.createSymbolicLink (ByteString -> [Char]
decodeFilePath ByteString
link) [Char]
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
$ [Char] -> UserID -> GroupID -> IO ()
Posix.setSymbolicLinkOwnerAndGroup [Char]
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.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryAny (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ [Char] -> POSIXTime -> POSIXTime -> IO ()
Posix.setSymbolicLinkTimesHiRes [Char]
fpStr POSIXTime
unixModTime POSIXTime
unixModTime
#endif
                [SomeException] -> IO [SomeException]
forall a. a -> IO a
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 a. [a] -> 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 a. a -> IO a
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 a.
IO a -> ConduitT ByteString (IO (FileInfo, [SomeException])) m a
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 :: [Char]
linkedFp = ByteString -> [Char]
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 <- [Char] -> IO Bool
Posix.fileExist [Char]
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 -> [Char] -> IO ()
Dir.createDirectoryIfMissing Bool
True ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
Posix.takeDirectory [Char]
linkedFp
                        [Char] -> [Char] -> IO ()
writeFile [Char]
linkedFp [Char]
""
                Bool -> [Char] -> IO ()
Dir.createDirectoryIfMissing Bool
True ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
Posix.takeDirectory [Char]
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.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryAny (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
Posix.removeLink [Char]
fpStr
                [Char] -> [Char] -> IO ()
Posix.createLink [Char]
linkedFp [Char]
fpStr
                IO [SomeException] -> IO [SomeException]
forall a. IO a -> IO a
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
$ [Char] -> EpochTime -> EpochTime -> IO ()
Posix.setFileTimes [Char]
fpStr EpochTime
fileModTime EpochTime
fileModTime
                    [SomeException] -> IO [SomeException]
forall a. a -> IO a
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 a. a -> [a]
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 a. [a] -> 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 a. a -> IO a
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 a.
IO a -> ConduitT ByteString (IO (FileInfo, [SomeException])) m a
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 -> [Char] -> IO ()
Dir.createDirectoryIfMissing Bool
True ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
Posix.takeDirectory [Char]
fpStr
            [Char] -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (m :: * -> *) o.
MonadResource m =>
[Char] -> ConduitT ByteString o m ()
sinkFile [Char]
fpStr
            [SomeException]
excs <- IO [SomeException]
-> ConduitT
     ByteString (IO (FileInfo, [SomeException])) m [SomeException]
forall a.
IO a -> ConduitT ByteString (IO (FileInfo, [SomeException])) m a
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
$ [Char] -> EpochTime -> EpochTime -> IO ()
Posix.setFileTimes [Char]
fpStr EpochTime
fileModTime EpochTime
fileModTime
                [SomeException] -> IO [SomeException]
forall a. a -> IO a
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 a. a -> [a]
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 a. [a] -> 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 a. a -> IO a
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 a.
IO a -> ConduitT ByteString (IO (FileInfo, [SomeException])) m a
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.
(HasCallStack, 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FileInfo
fi, [TarException -> SomeException
forall e. Exception e => e -> SomeException
toException TarException
exc])