{-# 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
#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
}
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]
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
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)
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
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
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])