{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-| This module is about stream-processing tar archives. It is currently
not very well tested. See the documentation of 'withEntries' for an usage sample.
-}
module Data.Conduit.Tar
    ( -- * Basic functions
      tar
    , tarEntries
    , untar
    , untarWithFinalizers
    , untarWithExceptions
    , restoreFile
    , restoreFileInto
    , restoreFileIntoLenient
    , restoreFileWithErrors
    -- ** Operate on Chunks
    , untarChunks
    , withEntry
    , withEntries
    , withFileInfo
      -- * Helper functions
    , headerFileType
    , headerFilePath
      -- ** Creation
    , tarFilePath
    , filePathConduit
      -- * Directly on files
    , createTarball
    , writeTarball
    , extractTarball
    , extractTarballLenient
      -- * Types
    , module Data.Conduit.Tar.Types
    ) where

import           Conduit                  as C
import           Control.Exception        (assert, SomeException)
import           Control.Monad            (unless, void)
import           Data.Bits
import           Data.ByteString          (ByteString)
import qualified Data.ByteString          as S
import           Data.ByteString.Builder
import qualified Data.ByteString.Char8    as S8
import qualified Data.ByteString.Lazy     as SL
import           Data.ByteString.Short    (ShortByteString, fromShort, toShort)
import qualified Data.ByteString.Short    as SS
import qualified Data.ByteString.Unsafe   as BU
import           Data.Foldable            (foldr')
import           Data.Monoid              ((<>), mempty)
import           Foreign.C.Types          (CTime (..))
import           Foreign.Storable
import           System.Directory         (createDirectoryIfMissing,
                                           getCurrentDirectory)
import           System.FilePath
import           System.IO

#if !MIN_VERSION_base(4,8,0)
import           Control.Applicative      ((<*))
#endif

import           Data.Conduit.Tar.Types
#ifdef WINDOWS
import           Data.Conduit.Tar.Windows
#else
import           Data.Conduit.Tar.Unix
#endif


headerFilePathBS :: Header -> S.ByteString
headerFilePathBS :: Header -> ByteString
headerFilePathBS Header {Word8
DeviceID
CMode
FileOffset
GroupID
UserID
EpochTime
ShortByteString
headerFileNamePrefix :: Header -> ShortByteString
headerDeviceMinor :: Header -> DeviceID
headerDeviceMajor :: Header -> DeviceID
headerGroupName :: Header -> ShortByteString
headerOwnerName :: Header -> ShortByteString
headerMagicVersion :: Header -> ShortByteString
headerLinkName :: Header -> ShortByteString
headerLinkIndicator :: Header -> Word8
headerTime :: Header -> EpochTime
headerPayloadSize :: Header -> FileOffset
headerGroupId :: Header -> GroupID
headerOwnerId :: Header -> UserID
headerFileMode :: Header -> CMode
headerFileNameSuffix :: Header -> ShortByteString
headerPayloadOffset :: Header -> FileOffset
headerOffset :: Header -> FileOffset
headerFileNamePrefix :: ShortByteString
headerDeviceMinor :: DeviceID
headerDeviceMajor :: DeviceID
headerGroupName :: ShortByteString
headerOwnerName :: ShortByteString
headerMagicVersion :: ShortByteString
headerLinkName :: ShortByteString
headerLinkIndicator :: Word8
headerTime :: EpochTime
headerPayloadSize :: FileOffset
headerGroupId :: GroupID
headerOwnerId :: UserID
headerFileMode :: CMode
headerFileNameSuffix :: ShortByteString
headerPayloadOffset :: FileOffset
headerOffset :: FileOffset
..} =
    if ShortByteString -> Bool
SS.null ShortByteString
headerFileNamePrefix
        then ShortByteString -> ByteString
fromShort ShortByteString
headerFileNameSuffix
        else [ByteString] -> ByteString
S.concat
                 [ShortByteString -> ByteString
fromShort ShortByteString
headerFileNamePrefix, ByteString
pathSeparatorS, ShortByteString -> ByteString
fromShort ShortByteString
headerFileNameSuffix]

-- | Construct a `FilePath` from `headerFileNamePrefix` and `headerFileNameSuffix`.
--
-- @since 0.1.0
headerFilePath :: Header -> FilePath
headerFilePath :: Header -> FilePath
headerFilePath = ByteString -> FilePath
decodeFilePath (ByteString -> FilePath)
-> (Header -> ByteString) -> Header -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header -> ByteString
headerFilePathBS

-- | Get Header file type.
--
-- @since 0.1.0
headerFileType :: Header -> FileType
headerFileType :: Header -> FileType
headerFileType Header
h =
    case Header -> Word8
headerLinkIndicator Header
h of
        Word8
0  -> FileType
FTNormal
        Word8
48 -> FileType
FTNormal
        Word8
49 -> ByteString -> FileType
FTHardLink (ShortByteString -> ByteString
fromShort (Header -> ShortByteString
headerLinkName Header
h))
        Word8
50 -> ByteString -> FileType
FTSymbolicLink (ShortByteString -> ByteString
fromShort (Header -> ShortByteString
headerLinkName Header
h))
        Word8
51 -> FileType
FTCharacterSpecial
        Word8
52 -> FileType
FTBlockSpecial
        Word8
53 -> FileType
FTDirectory
        Word8
54 -> FileType
FTFifo
        Word8
x  -> Word8 -> FileType
FTOther Word8
x

parseHeader :: FileOffset -> ByteString -> Either TarException Header
parseHeader :: FileOffset -> ByteString -> Either TarException Header
parseHeader FileOffset
offset ByteString
bs = do
    Bool -> Either TarException () -> Either TarException ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int
S.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
512) (Either TarException () -> Either TarException ())
-> Either TarException () -> Either TarException ()
forall a b. (a -> b) -> a -> b
$ TarException -> Either TarException ()
forall a b. a -> Either a b
Left (TarException -> Either TarException ())
-> TarException -> Either TarException ()
forall a b. (a -> b) -> a -> b
$ FileOffset -> TarException
IncompleteHeader FileOffset
offset
    let checksumBytes :: ByteString
checksumBytes = Int -> ByteString -> ByteString
BU.unsafeTake Int
8 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeDrop Int
148 ByteString
bs
        expectedChecksum :: Int
expectedChecksum = ByteString -> Int
forall i. Integral i => ByteString -> i
parseOctal ByteString
checksumBytes
        actualChecksum :: Int
actualChecksum = ByteString -> Int
bsum ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
bsum ByteString
checksumBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
forall i. Integral i => i
space
        magicVersion :: ShortByteString
magicVersion = ByteString -> ShortByteString
toShort (ByteString -> ShortByteString) -> ByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeTake Int
8 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeDrop Int
257 ByteString
bs
        getNumber :: (Storable a, Bits a, Integral a) => Int -> Int -> a
        getNumber :: Int -> Int -> a
getNumber = if ShortByteString
magicVersion ShortByteString -> ShortByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ShortByteString
gnuTarMagicVersion then Int -> Int -> a
forall a. (Storable a, Bits a, Integral a) => Int -> Int -> a
getHexOctal else Int -> Int -> a
forall a. Integral a => Int -> Int -> a
getOctal

    Bool -> Either TarException () -> Either TarException ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
actualChecksum Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expectedChecksum) (TarException -> Either TarException ()
forall a b. a -> Either a b
Left (FileOffset -> TarException
BadChecksum FileOffset
offset))
    Header -> Either TarException Header
forall (m :: * -> *) a. Monad m => a -> m a
return Header :: FileOffset
-> FileOffset
-> ShortByteString
-> CMode
-> UserID
-> GroupID
-> FileOffset
-> EpochTime
-> Word8
-> ShortByteString
-> ShortByteString
-> ShortByteString
-> ShortByteString
-> DeviceID
-> DeviceID
-> ShortByteString
-> Header
Header
        { headerOffset :: FileOffset
headerOffset         = FileOffset
offset
        , headerPayloadOffset :: FileOffset
headerPayloadOffset  = FileOffset
offset FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ FileOffset
512
        , headerFileNameSuffix :: ShortByteString
headerFileNameSuffix = Int -> Int -> ShortByteString
getShort Int
0 Int
100
        , headerFileMode :: CMode
headerFileMode       = Int -> Int -> CMode
forall a. Integral a => Int -> Int -> a
getOctal Int
100 Int
8
        , headerOwnerId :: UserID
headerOwnerId        = Int -> Int -> UserID
forall a. (Storable a, Bits a, Integral a) => Int -> Int -> a
getNumber Int
108 Int
8
        , headerGroupId :: GroupID
headerGroupId        = Int -> Int -> GroupID
forall a. (Storable a, Bits a, Integral a) => Int -> Int -> a
getNumber Int
116 Int
8
        , headerPayloadSize :: FileOffset
headerPayloadSize    = Int -> Int -> FileOffset
forall a. (Storable a, Bits a, Integral a) => Int -> Int -> a
getNumber Int
124 Int
12
        , headerTime :: EpochTime
headerTime           = Int64 -> EpochTime
CTime (Int64 -> EpochTime) -> Int64 -> EpochTime
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int64
forall a. (Storable a, Bits a, Integral a) => Int -> Int -> a
getNumber Int
136 Int
12
        , headerLinkIndicator :: Word8
headerLinkIndicator  = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
156
        , headerLinkName :: ShortByteString
headerLinkName       = Int -> Int -> ShortByteString
getShort Int
157 Int
100
        , headerMagicVersion :: ShortByteString
headerMagicVersion   = ShortByteString
magicVersion
        , headerOwnerName :: ShortByteString
headerOwnerName      = Int -> Int -> ShortByteString
getShort Int
265 Int
32
        , headerGroupName :: ShortByteString
headerGroupName      = Int -> Int -> ShortByteString
getShort Int
297 Int
32
        , headerDeviceMajor :: DeviceID
headerDeviceMajor    = Int -> Int -> DeviceID
forall a. (Storable a, Bits a, Integral a) => Int -> Int -> a
getNumber Int
329 Int
8
        , headerDeviceMinor :: DeviceID
headerDeviceMinor    = Int -> Int -> DeviceID
forall a. (Storable a, Bits a, Integral a) => Int -> Int -> a
getNumber Int
337 Int
8
        , headerFileNamePrefix :: ShortByteString
headerFileNamePrefix = Int -> Int -> ShortByteString
getShort Int
345 Int
155
        }
  where
    bsum :: ByteString -> Int
    bsum :: ByteString -> Int
bsum = (Int -> Word8 -> Int) -> Int -> ByteString -> Int
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
S.foldl' (\Int
c Word8
n -> Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n) Int
0

    getShort :: Int -> Int -> ShortByteString
getShort Int
off Int
len = ByteString -> ShortByteString
toShort (ByteString -> ShortByteString) -> ByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
S.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeTake Int
len (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeDrop Int
off ByteString
bs

    getOctal :: Integral a => Int -> Int -> a
    getOctal :: Int -> Int -> a
getOctal Int
off Int
len = ByteString -> a
forall i. Integral i => ByteString -> i
parseOctal (ByteString -> a) -> ByteString -> a
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeTake Int
len (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeDrop Int
off ByteString
bs

    -- | Depending on the first bit of the first byte in the range either choose direct
    -- hex representation, or classic octal string view.
    getHexOctal :: (Storable a, Bits a, Integral a) => Int -> Int -> a
    getHexOctal :: Int -> Int -> a
getHexOctal Int
off Int
len = if ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
off Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x80 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x80
                          then ByteString -> a
forall a. (Storable a, Bits a, Integral a) => ByteString -> a
fromHex (ByteString -> a) -> ByteString -> a
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeTake Int
len (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BU.unsafeDrop Int
off ByteString
bs
                          else Int -> Int -> a
forall a. Integral a => Int -> Int -> a
getOctal Int
off Int
len

    parseOctal :: Integral i => ByteString -> i
    parseOctal :: ByteString -> i
parseOctal = (i -> Word8 -> i) -> i -> ByteString -> i
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
S.foldl' (\i
t Word8
c -> i
t i -> i -> i
forall a. Num a => a -> a -> a
* i
8 i -> i -> i
forall a. Num a => a -> a -> a
+ Word8 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
c Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
zero)) i
0
               (ByteString -> i) -> (ByteString -> ByteString) -> ByteString -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
S.takeWhile (\Word8
c -> Word8
zero Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
seven)
               (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
S.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
forall i. Integral i => i
space)

    space :: Integral i => i
    space :: i
space = i
0x20
    zero :: Word8
zero = Word8
48
    seven :: Word8
seven = Word8
55

-- | Make sure we don't use more bytes than we can fit in the data type.
fromHex :: forall a . (Storable a, Bits a, Integral a) => ByteString -> a
fromHex :: ByteString -> a
fromHex ByteString
str = (a -> Word8 -> a) -> a -> ByteString -> a
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
S.foldl' (\ a
acc Word8
x -> (a
acc a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) a -> a -> a
forall a. Bits a => a -> a -> a
.|. Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x) a
0 (ByteString -> a) -> ByteString -> a
forall a b. (a -> b) -> a -> b
$
              Int -> ByteString -> ByteString
S.drop (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (ByteString -> Int
S.length ByteString
str Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))) ByteString
str



-- | Convert a stream of raw bytes into a stream of 'TarChunk's. This stream can further be passed
-- into `withFileInfo` or `withHeaders` functions.
--
-- @since 0.2.1
untarChunks :: Monad m => ConduitM ByteString TarChunk m ()
untarChunks :: ConduitM ByteString TarChunk m ()
untarChunks =
    FileOffset -> ConduitM ByteString TarChunk m ()
forall (m :: * -> *).
Monad m =>
FileOffset -> ConduitT ByteString TarChunk m ()
loop FileOffset
0
  where
    loop :: FileOffset -> ConduitT ByteString TarChunk m ()
loop !FileOffset
offset = Bool
-> ConduitT ByteString TarChunk m ()
-> ConduitT ByteString TarChunk m ()
forall a. HasCallStack => Bool -> a -> a
assert (FileOffset
offset FileOffset -> FileOffset -> FileOffset
forall a. Integral a => a -> a -> a
`mod` FileOffset
512 FileOffset -> FileOffset -> Bool
forall a. Eq a => a -> a -> Bool
== FileOffset
0) (ConduitT ByteString TarChunk m ()
 -> ConduitT ByteString TarChunk m ())
-> ConduitT ByteString TarChunk m ()
-> ConduitT ByteString TarChunk m ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString
bs <- Index ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) seq.
(Monad m, IsSequence seq) =>
Index seq -> ConduitT seq seq m ()
takeCE Index ByteString
512 ConduitT ByteString ByteString m ()
-> ConduitM ByteString TarChunk m ByteString
-> ConduitM ByteString TarChunk m ByteString
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString TarChunk m ByteString
forall (m :: * -> *) a o. (Monad m, Monoid a) => ConduitT a o m a
foldC
        case ByteString -> Int
S.length ByteString
bs of
            Int
0 -> () -> ConduitT ByteString TarChunk m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Int
512 | (Word8 -> Bool) -> ByteString -> Bool
S.all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
bs -> do
                let offset' :: FileOffset
offset' = FileOffset
offset FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ FileOffset
512
                ByteString
bs' <- Index ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) seq.
(Monad m, IsSequence seq) =>
Index seq -> ConduitT seq seq m ()
takeCE Index ByteString
512 ConduitT ByteString ByteString m ()
-> ConduitM ByteString TarChunk m ByteString
-> ConduitM ByteString TarChunk m ByteString
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString TarChunk m ByteString
forall (m :: * -> *) a o. (Monad m, Monoid a) => ConduitT a o m a
foldC
                case () of
                    ()
                        | ByteString -> Int
S.length ByteString
bs' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
512 -> do
                            ByteString -> ConduitT ByteString TarChunk m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
bs'
                            TarChunk -> ConduitT ByteString TarChunk m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (TarChunk -> ConduitT ByteString TarChunk m ())
-> TarChunk -> ConduitT ByteString TarChunk m ()
forall a b. (a -> b) -> a -> b
$ TarException -> TarChunk
ChunkException (TarException -> TarChunk) -> TarException -> TarChunk
forall a b. (a -> b) -> a -> b
$ FileOffset -> TarException
ShortTrailer FileOffset
offset'
                        | (Word8 -> Bool) -> ByteString -> Bool
S.all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
bs' -> () -> ConduitT ByteString TarChunk m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        | Bool
otherwise -> do
                            ByteString -> ConduitT ByteString TarChunk m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
bs'
                            TarChunk -> ConduitT ByteString TarChunk m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (TarChunk -> ConduitT ByteString TarChunk m ())
-> TarChunk -> ConduitT ByteString TarChunk m ()
forall a b. (a -> b) -> a -> b
$ TarException -> TarChunk
ChunkException (TarException -> TarChunk) -> TarException -> TarChunk
forall a b. (a -> b) -> a -> b
$ FileOffset -> TarException
BadTrailer FileOffset
offset'
            Int
512 ->
                case FileOffset -> ByteString -> Either TarException Header
parseHeader FileOffset
offset ByteString
bs of
                    Left TarException
e -> do
                        ByteString -> ConduitT ByteString TarChunk m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
bs
                        TarChunk -> ConduitT ByteString TarChunk m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (TarChunk -> ConduitT ByteString TarChunk m ())
-> TarChunk -> ConduitT ByteString TarChunk m ()
forall a b. (a -> b) -> a -> b
$ TarException -> TarChunk
ChunkException TarException
e
                    Right Header
h -> do
                        TarChunk -> ConduitT ByteString TarChunk m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (TarChunk -> ConduitT ByteString TarChunk m ())
-> TarChunk -> ConduitT ByteString TarChunk m ()
forall a b. (a -> b) -> a -> b
$ Header -> TarChunk
ChunkHeader Header
h
                        FileOffset
offset' <- FileOffset
-> FileOffset -> ConduitT ByteString TarChunk m FileOffset
forall t (m :: * -> *).
(Monad m, Integral t) =>
FileOffset -> t -> ConduitT ByteString TarChunk m FileOffset
payloads (FileOffset
offset FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ FileOffset
512) (FileOffset -> ConduitT ByteString TarChunk m FileOffset)
-> FileOffset -> ConduitT ByteString TarChunk m FileOffset
forall a b. (a -> b) -> a -> b
$ Header -> FileOffset
headerPayloadSize Header
h
                        let expectedOffset :: FileOffset
expectedOffset = FileOffset
offset FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ FileOffset
512 FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ Header -> FileOffset
headerPayloadSize Header
h FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+
                                (case FileOffset
512 FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
- (Header -> FileOffset
headerPayloadSize Header
h FileOffset -> FileOffset -> FileOffset
forall a. Integral a => a -> a -> a
`mod` FileOffset
512) of
                                    FileOffset
512 -> FileOffset
0
                                    FileOffset
x   -> FileOffset
x)
                        Bool
-> ConduitT ByteString TarChunk m ()
-> ConduitT ByteString TarChunk m ()
forall a. HasCallStack => Bool -> a -> a
assert (FileOffset
offset' FileOffset -> FileOffset -> Bool
forall a. Eq a => a -> a -> Bool
== FileOffset
expectedOffset) (FileOffset -> ConduitT ByteString TarChunk m ()
loop FileOffset
offset')
            Int
_ -> do
                ByteString -> ConduitT ByteString TarChunk m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
bs
                TarChunk -> ConduitT ByteString TarChunk m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (TarChunk -> ConduitT ByteString TarChunk m ())
-> TarChunk -> ConduitT ByteString TarChunk m ()
forall a b. (a -> b) -> a -> b
$ TarException -> TarChunk
ChunkException (TarException -> TarChunk) -> TarException -> TarChunk
forall a b. (a -> b) -> a -> b
$ FileOffset -> TarException
IncompleteHeader FileOffset
offset

    payloads :: FileOffset -> t -> ConduitT ByteString TarChunk m FileOffset
payloads !FileOffset
offset t
0 = do
        let padding :: Int
padding =
                case FileOffset
offset FileOffset -> FileOffset -> FileOffset
forall a. Integral a => a -> a -> a
`mod` FileOffset
512 of
                    FileOffset
0 -> Int
0
                    FileOffset
x -> Int
512 Int -> Int -> Int
forall a. Num a => a -> a -> a
- FileOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FileOffset
x
        Index ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) seq.
(Monad m, IsSequence seq) =>
Index seq -> ConduitT seq seq m ()
takeCE Int
Index ByteString
padding ConduitT ByteString ByteString m ()
-> ConduitM ByteString TarChunk m ()
-> ConduitM ByteString TarChunk m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString TarChunk m ()
forall (m :: * -> *) a o. Monad m => ConduitT a o m ()
sinkNull
        FileOffset -> ConduitT ByteString TarChunk m FileOffset
forall (m :: * -> *) a. Monad m => a -> m a
return (FileOffset -> ConduitT ByteString TarChunk m FileOffset)
-> FileOffset -> ConduitT ByteString TarChunk m FileOffset
forall a b. (a -> b) -> a -> b
$! FileOffset
offset FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ Int -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
padding
    payloads !FileOffset
offset !t
size = do
        Maybe ByteString
mbs <- ConduitT ByteString TarChunk m (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
        case Maybe ByteString
mbs of
            Maybe ByteString
Nothing -> do
                TarChunk -> ConduitM ByteString TarChunk m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (TarChunk -> ConduitM ByteString TarChunk m ())
-> TarChunk -> ConduitM ByteString TarChunk m ()
forall a b. (a -> b) -> a -> b
$ TarException -> TarChunk
ChunkException (TarException -> TarChunk) -> TarException -> TarChunk
forall a b. (a -> b) -> a -> b
$ FileOffset -> ByteCount -> TarException
IncompletePayload FileOffset
offset (ByteCount -> TarException) -> ByteCount -> TarException
forall a b. (a -> b) -> a -> b
$ t -> ByteCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
size
                FileOffset -> ConduitT ByteString TarChunk m FileOffset
forall (m :: * -> *) a. Monad m => a -> m a
return FileOffset
offset
            Just ByteString
bs -> do
                let (ByteString
x, ByteString
y) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt (t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (t -> t -> t
forall a. Ord a => a -> a -> a
min t
size (Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)))) ByteString
bs
                TarChunk -> ConduitM ByteString TarChunk m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (TarChunk -> ConduitM ByteString TarChunk m ())
-> TarChunk -> ConduitM ByteString TarChunk m ()
forall a b. (a -> b) -> a -> b
$ FileOffset -> ByteString -> TarChunk
ChunkPayload FileOffset
offset ByteString
x
                let size' :: t
size' = t
size t -> t -> t
forall a. Num a => a -> a -> a
- Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
x)
                    offset' :: FileOffset
offset' = FileOffset
offset FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ Int -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
x)
                Bool
-> ConduitM ByteString TarChunk m ()
-> ConduitM ByteString TarChunk m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
S.null ByteString
y) (ByteString -> ConduitM ByteString TarChunk m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
y)
                FileOffset -> t -> ConduitT ByteString TarChunk m FileOffset
payloads FileOffset
offset' t
size'


-- | Process a single tar entry. See 'withEntries' for more details.
--
-- @since 0.1.0
--
withEntry :: MonadThrow m
          => (Header -> ConduitM ByteString o m r)
          -> ConduitM TarChunk o m r
withEntry :: (Header -> ConduitM ByteString o m r) -> ConduitM TarChunk o m r
withEntry Header -> ConduitM ByteString o m r
inner = do
    Maybe TarChunk
mc <- ConduitT TarChunk o m (Maybe TarChunk)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
    case Maybe TarChunk
mc of
        Maybe TarChunk
Nothing -> TarException -> ConduitM TarChunk o m r
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TarException
NoMoreHeaders
        Just (ChunkHeader Header
h) -> ConduitM TarChunk ByteString m ()
forall (m :: * -> *).
MonadThrow m =>
ConduitM TarChunk ByteString m ()
payloadsConduit ConduitM TarChunk ByteString m ()
-> ConduitM ByteString o m r -> ConduitM TarChunk o m r
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Header -> ConduitM ByteString o m r
inner Header
h ConduitM ByteString o m r
-> ConduitT ByteString o m () -> ConduitM ByteString o m r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ConduitT ByteString o m ()
forall (m :: * -> *) a o. Monad m => ConduitT a o m ()
sinkNull)
        Just x :: TarChunk
x@(ChunkPayload FileOffset
offset ByteString
_bs) -> do
            TarChunk -> ConduitT TarChunk o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover TarChunk
x
            TarException -> ConduitM TarChunk o m r
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TarException -> ConduitM TarChunk o m r)
-> TarException -> ConduitM TarChunk o m r
forall a b. (a -> b) -> a -> b
$ FileOffset -> TarException
UnexpectedPayload FileOffset
offset
        Just (ChunkException TarException
e) -> TarException -> ConduitM TarChunk o m r
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TarException
e


payloadsConduit :: MonadThrow m
               => ConduitM TarChunk ByteString m ()
payloadsConduit :: ConduitM TarChunk ByteString m ()
payloadsConduit = do
    Maybe TarChunk
mx <- ConduitT TarChunk ByteString m (Maybe TarChunk)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
    case Maybe TarChunk
mx of
        Just (ChunkPayload FileOffset
_ ByteString
bs) -> ByteString -> ConduitM TarChunk ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
bs ConduitM TarChunk ByteString m ()
-> ConduitM TarChunk ByteString m ()
-> ConduitM TarChunk ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitM TarChunk ByteString m ()
forall (m :: * -> *).
MonadThrow m =>
ConduitM TarChunk ByteString m ()
payloadsConduit
        Just x :: TarChunk
x@ChunkHeader {}    -> TarChunk -> ConduitM TarChunk ByteString m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover TarChunk
x
        Just (ChunkException TarException
e)  -> TarException -> ConduitM TarChunk ByteString m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TarException
e
        Maybe TarChunk
Nothing                  -> () -> ConduitM TarChunk ByteString m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


{-| This function handles each entry of the tar archive according to the
behaviour of the function passed as first argument.

Here is a full example function, that reads a compressed tar archive and for each entry that is a
simple file, it prints its file path and SHA256 digest. Note that this function can throw
exceptions!

> import qualified Crypto.Hash.Conduit as CH
> import qualified Data.Conduit.Tar    as CT
>
> import Conduit
> import Crypto.Hash (Digest, SHA256)
> import Control.Monad (when)
> import Data.Conduit.Zlib (ungzip)
> import Data.ByteString (ByteString)
>
> filedigests :: FilePath -> IO ()
> filedigests fp = runConduitRes (  sourceFileBS fp          -- read the raw file
>                                .| ungzip                   -- gunzip
>                                .| CT.untarChunks           -- decode the tar archive
>                                .| CT.withEntries hashentry -- process each file
>                                .| printC                   -- print the results
>                                )
>     where
>         hashentry :: Monad m => CT.Header -> Conduit ByteString m (FilePath, Digest SHA256)
>         hashentry hdr = when (CT.headerFileType hdr == CT.FTNormal) $ do
>             hash <- CH.sinkHash
>             yield (CT.headerFilePath hdr, hash)

The @hashentry@ function handles a single entry, based on its first 'Header' argument.
In this example, a 'Consumer' is used to process the whole entry.

Note that the benefits of stream processing are easily lost when working with a 'Consumer'. For
example, the following implementation would have used an unbounded amount of memory:

>         hashentry hdr = when (CT.headerFileType hdr == CT.FTNormal) $ do
>             content <- mconcat <$> sinkList
>             yield (CT.headerFilePath hdr, hash content)

@since 0.1.0
-}
withEntries :: MonadThrow m
            => (Header -> ConduitM ByteString o m ())
            -> ConduitM TarChunk o m ()
withEntries :: (Header -> ConduitM ByteString o m ()) -> ConduitM TarChunk o m ()
withEntries = ConduitM TarChunk o m () -> ConduitM TarChunk o m ()
forall (m :: * -> *) i o.
Monad m =>
ConduitT i o m () -> ConduitT i o m ()
peekForever (ConduitM TarChunk o m () -> ConduitM TarChunk o m ())
-> ((Header -> ConduitM ByteString o m ())
    -> ConduitM TarChunk o m ())
-> (Header -> ConduitM ByteString o m ())
-> ConduitM TarChunk o m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Header -> ConduitM ByteString o m ()) -> ConduitM TarChunk o m ()
forall (m :: * -> *) o r.
MonadThrow m =>
(Header -> ConduitM ByteString o m r) -> ConduitM TarChunk o m r
withEntry


-- | Extract a tarball, similarly to `withEntries`, but instead of dealing directly with tar format,
-- this conduit allows you to work directly on file abstractions `FileInfo`. For now support is
-- minimal:
--
-- * Old v7 tar format.
-- * ustar: POSIX 1003.1-1988 format
-- * and only some portions of GNU format:
--   * Larger values for `fileUserId`, `fileGroupId`, `fileSize` and `fileModTime`.
--   * 'L' type - long file names, but only up to 4096 chars to prevent DoS attack
--   * other types are simply discarded
--
-- /Note/ - Here is a really good reference for specifics of different tar formats:
-- <https://github.com/libarchive/libarchive/wiki/ManPageTar5>
--
-- @since 0.2.2
withFileInfo :: MonadThrow m
             => (FileInfo -> ConduitM ByteString o m ())
             -> ConduitM TarChunk o m ()
withFileInfo :: (FileInfo -> ConduitM ByteString o m ())
-> ConduitM TarChunk o m ()
withFileInfo FileInfo -> ConduitM ByteString o m ()
inner = ConduitM TarChunk o m ()
start
  where
    start :: ConduitM TarChunk o m ()
start = ConduitT TarChunk o m (Maybe TarChunk)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT TarChunk o m (Maybe TarChunk)
-> (Maybe TarChunk -> ConduitM TarChunk o m ())
-> ConduitM TarChunk o m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitM TarChunk o m ()
-> (TarChunk -> ConduitM TarChunk o m ())
-> Maybe TarChunk
-> ConduitM TarChunk o m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitM TarChunk o m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) TarChunk -> ConduitM TarChunk o m ()
go
    go :: TarChunk -> ConduitM TarChunk o m ()
go TarChunk
x =
        case TarChunk
x of
            ChunkHeader Header
h
                | Header -> Word8
headerLinkIndicator Header
h Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
55 ->
                    if Header -> ShortByteString
headerMagicVersion Header
h ShortByteString -> ShortByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ShortByteString
gnuTarMagicVersion
                        then Header -> ConduitT TarChunk o m (Maybe TarChunk)
forall (m :: * -> *) o.
MonadThrow m =>
Header -> ConduitM TarChunk o m (Maybe TarChunk)
handleGnuTarHeader Header
h ConduitT TarChunk o m (Maybe TarChunk)
-> (Maybe TarChunk -> ConduitM TarChunk o m ())
-> ConduitM TarChunk o m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitM TarChunk o m ()
-> (TarChunk -> ConduitM TarChunk o m ())
-> Maybe TarChunk
-> ConduitM TarChunk o m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ConduitM TarChunk o m ()
start TarChunk -> ConduitM TarChunk o m ()
go
                        else (TarChunk -> Bool) -> ConduitM TarChunk o m ()
forall (m :: * -> *) a o.
Monad m =>
(a -> Bool) -> ConduitT a o m ()
dropWhileC
                                 (\case
                                      ChunkPayload FileOffset
_ ByteString
_ -> Bool
True
                                      TarChunk
_                -> Bool
False) ConduitM TarChunk o m ()
-> ConduitM TarChunk o m () -> ConduitM TarChunk o m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitM TarChunk o m ()
start
            ChunkHeader Header
h -> do
                ConduitM TarChunk ByteString m ()
forall (m :: * -> *).
MonadThrow m =>
ConduitM TarChunk ByteString m ()
payloadsConduit ConduitM TarChunk ByteString m ()
-> ConduitM ByteString o m () -> ConduitM TarChunk o m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (FileInfo -> ConduitM ByteString o m ()
inner (Header -> FileInfo
fileInfoFromHeader Header
h) ConduitM ByteString o m ()
-> ConduitM ByteString o m () -> ConduitM ByteString o m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ConduitM ByteString o m ()
forall (m :: * -> *) a o. Monad m => ConduitT a o m ()
sinkNull)
                ConduitM TarChunk o m ()
start
            ChunkPayload FileOffset
offset ByteString
_bs -> do
                TarChunk -> ConduitM TarChunk o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover TarChunk
x
                TarException -> ConduitM TarChunk o m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TarException -> ConduitM TarChunk o m ())
-> TarException -> ConduitM TarChunk o m ()
forall a b. (a -> b) -> a -> b
$ FileOffset -> TarException
UnexpectedPayload FileOffset
offset
            ChunkException TarException
e -> TarException -> ConduitM TarChunk o m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TarException
e


-- | Take care of custom GNU tar format.
handleGnuTarHeader :: MonadThrow m
                   => Header
                   -> ConduitM TarChunk o m (Maybe TarChunk)
handleGnuTarHeader :: Header -> ConduitM TarChunk o m (Maybe TarChunk)
handleGnuTarHeader Header
h =
    case Header -> Word8
headerLinkIndicator Header
h of
        Word8
76 -> do
            let pSize :: FileOffset
pSize = Header -> FileOffset
headerPayloadSize Header
h
            -- guard against names that are too long in order to prevent a DoS attack on unbounded
            -- file names
            Bool -> ConduitT TarChunk o m () -> ConduitT TarChunk o m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FileOffset
0 FileOffset -> FileOffset -> Bool
forall a. Ord a => a -> a -> Bool
< FileOffset
pSize Bool -> Bool -> Bool
&& FileOffset
pSize FileOffset -> FileOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= FileOffset
4096) (ConduitT TarChunk o m () -> ConduitT TarChunk o m ())
-> ConduitT TarChunk o m () -> ConduitT TarChunk o m ()
forall a b. (a -> b) -> a -> b
$
                TarException -> ConduitT TarChunk o m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TarException -> ConduitT TarChunk o m ())
-> TarException -> ConduitT TarChunk o m ()
forall a b. (a -> b) -> a -> b
$
                FileOffset -> Char -> FilePath -> TarException
FileTypeError (Header -> FileOffset
headerPayloadOffset Header
h) Char
'L' (FilePath -> TarException) -> FilePath -> TarException
forall a b. (a -> b) -> a -> b
$ FilePath
"Filepath is too long: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FileOffset -> FilePath
forall a. Show a => a -> FilePath
show FileOffset
pSize
            Builder
longFileNameBuilder <- ConduitM TarChunk ByteString m ()
forall (m :: * -> *).
MonadThrow m =>
ConduitM TarChunk ByteString m ()
payloadsConduit ConduitM TarChunk ByteString m ()
-> ConduitM ByteString o m Builder -> ConduitM TarChunk o m Builder
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (ByteString -> Builder) -> ConduitM ByteString o m Builder
forall (m :: * -> *) b a o.
(Monad m, Monoid b) =>
(a -> b) -> ConduitT a o m b
foldMapC ByteString -> Builder
byteString
            let longFileName :: ByteString
longFileName = ByteString -> ByteString
SL.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
SL.init (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder
longFileNameBuilder
            Maybe TarChunk
mcNext <- ConduitM TarChunk o m (Maybe TarChunk)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
            case Maybe TarChunk
mcNext of
                Just (ChunkHeader Header
nh) -> do
                    Bool -> ConduitT TarChunk o m () -> ConduitT TarChunk o m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> ByteString -> Bool
S.isPrefixOf (ShortByteString -> ByteString
fromShort (Header -> ShortByteString
headerFileNameSuffix Header
nh)) ByteString
longFileName) (ConduitT TarChunk o m () -> ConduitT TarChunk o m ())
-> ConduitT TarChunk o m () -> ConduitT TarChunk o m ()
forall a b. (a -> b) -> a -> b
$
                        TarException -> ConduitT TarChunk o m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TarException -> ConduitT TarChunk o m ())
-> TarException -> ConduitT TarChunk o m ()
forall a b. (a -> b) -> a -> b
$
                        FileOffset -> Char -> FilePath -> TarException
FileTypeError (Header -> FileOffset
headerPayloadOffset Header
nh) Char
'L'
                        FilePath
"Long filename doesn't match the original."
                    Maybe TarChunk -> ConduitM TarChunk o m (Maybe TarChunk)
forall (m :: * -> *) a. Monad m => a -> m a
return
                        (TarChunk -> Maybe TarChunk
forall a. a -> Maybe a
Just (TarChunk -> Maybe TarChunk) -> TarChunk -> Maybe TarChunk
forall a b. (a -> b) -> a -> b
$ Header -> TarChunk
ChunkHeader (Header -> TarChunk) -> Header -> TarChunk
forall a b. (a -> b) -> a -> b
$
                         Header
nh
                         { headerFileNameSuffix :: ShortByteString
headerFileNameSuffix = ByteString -> ShortByteString
toShort ByteString
longFileName
                         , headerFileNamePrefix :: ShortByteString
headerFileNamePrefix = ShortByteString
SS.empty
                         })
                Just c :: TarChunk
c@(ChunkPayload FileOffset
offset ByteString
_) -> do
                    TarChunk -> ConduitT TarChunk o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover TarChunk
c
                    TarException -> ConduitM TarChunk o m (Maybe TarChunk)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TarException -> ConduitM TarChunk o m (Maybe TarChunk))
-> TarException -> ConduitM TarChunk o m (Maybe TarChunk)
forall a b. (a -> b) -> a -> b
$ FileOffset -> TarException
InvalidHeader FileOffset
offset
                Just (ChunkException TarException
exc) -> TarException -> ConduitM TarChunk o m (Maybe TarChunk)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TarException
exc
                Maybe TarChunk
Nothing -> TarException -> ConduitM TarChunk o m (Maybe TarChunk)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TarException
NoMoreHeaders
        Word8
83 -> do
            ConduitM TarChunk ByteString m ()
forall (m :: * -> *).
MonadThrow m =>
ConduitM TarChunk ByteString m ()
payloadsConduit ConduitM TarChunk ByteString m ()
-> ConduitM ByteString o m () -> ConduitT TarChunk o m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString o m ()
forall (m :: * -> *) a o. Monad m => ConduitT a o m ()
sinkNull -- discard sparse files payload
            -- TODO : Implement restoring of sparse files
            Maybe TarChunk -> ConduitM TarChunk o m (Maybe TarChunk)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TarChunk
forall a. Maybe a
Nothing
        Word8
_ -> Maybe TarChunk -> ConduitM TarChunk o m (Maybe TarChunk)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TarChunk
forall a. Maybe a
Nothing



-- | Just like `withFileInfo`, but works directly on the stream of bytes.
--
-- @since 0.2.0
untar :: MonadThrow m
      => (FileInfo -> ConduitM ByteString o m ())
      -> ConduitM ByteString o m ()
untar :: (FileInfo -> ConduitM ByteString o m ())
-> ConduitM ByteString o m ()
untar FileInfo -> ConduitM ByteString o m ()
inner = ConduitM ByteString TarChunk m ()
forall (m :: * -> *). Monad m => ConduitM ByteString TarChunk m ()
untarChunks ConduitM ByteString TarChunk m ()
-> ConduitM TarChunk o m () -> ConduitM ByteString o m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (FileInfo -> ConduitM ByteString o m ())
-> ConduitM TarChunk o m ()
forall (m :: * -> *) o.
MonadThrow m =>
(FileInfo -> ConduitM ByteString o m ())
-> ConduitM TarChunk o m ()
withFileInfo FileInfo -> ConduitM ByteString o m ()
inner


-- | Just like `untar`, except that each `FileInfo` handling function can produce a finalizing
-- action, all of which will be executed after the whole tarball has been processed in the opposite
-- order. Very useful with `restoreFile` and `restoreFileInto`, since they restore direcory
-- modification timestamps only after files have been fully written to disk.
--
-- @since 0.2.0
untarWithFinalizers ::
       (MonadThrow m, MonadIO m)
    => (FileInfo -> ConduitM ByteString (IO ()) m ())
    -> ConduitM ByteString c m ()
untarWithFinalizers :: (FileInfo -> ConduitM ByteString (IO ()) m ())
-> ConduitM ByteString c m ()
untarWithFinalizers FileInfo -> ConduitM ByteString (IO ()) m ()
inner = do
    IO ()
finilizers <- (FileInfo -> ConduitM ByteString (IO ()) m ())
-> ConduitM ByteString (IO ()) m ()
forall (m :: * -> *) o.
MonadThrow m =>
(FileInfo -> ConduitM ByteString o m ())
-> ConduitM ByteString o m ()
untar FileInfo -> ConduitM ByteString (IO ()) m ()
inner ConduitM ByteString (IO ()) m ()
-> ConduitM (IO ()) c m (IO ()) -> ConduitM ByteString c m (IO ())
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (IO () -> IO () -> IO ()) -> IO () -> ConduitM (IO ()) c m (IO ())
forall (m :: * -> *) a b o.
Monad m =>
(a -> b -> a) -> a -> ConduitT b o m a
foldlC IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    IO () -> ConduitM ByteString c m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
finilizers


-- | Same as `untarWithFinalizers`, but will also produce a list of any exceptions that might have
-- occured during restoration process.
--
-- @since 0.2.5
untarWithExceptions ::
       (MonadThrow m, MonadIO m)
    => (FileInfo -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
    -> ConduitM ByteString c m [(FileInfo, [SomeException])]
untarWithExceptions :: (FileInfo
 -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
-> ConduitM ByteString c m [(FileInfo, [SomeException])]
untarWithExceptions FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
inner = do
    IO [(FileInfo, [SomeException])]
finalizers <- (FileInfo
 -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (m :: * -> *) o.
MonadThrow m =>
(FileInfo -> ConduitM ByteString o m ())
-> ConduitM ByteString o m ()
untar FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
inner ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
-> ConduitM
     (IO (FileInfo, [SomeException]))
     c
     m
     (IO [(FileInfo, [SomeException])])
-> ConduitM ByteString c m (IO [(FileInfo, [SomeException])])
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (IO (FileInfo, [SomeException])
 -> IO [(FileInfo, [SomeException])])
-> ConduitM
     (IO (FileInfo, [SomeException]))
     c
     m
     (IO [(FileInfo, [SomeException])])
forall (m :: * -> *) b a o.
(Monad m, Monoid b) =>
(a -> b) -> ConduitT a o m b
C.foldMapC (((FileInfo, [SomeException]) -> [(FileInfo, [SomeException])])
-> IO (FileInfo, [SomeException])
-> IO [(FileInfo, [SomeException])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FileInfo, [SomeException]) -> [(FileInfo, [SomeException])]
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
    ((FileInfo, [SomeException]) -> Bool)
-> [(FileInfo, [SomeException])] -> [(FileInfo, [SomeException])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((FileInfo, [SomeException]) -> Bool)
-> (FileInfo, [SomeException])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SomeException] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([SomeException] -> Bool)
-> ((FileInfo, [SomeException]) -> [SomeException])
-> (FileInfo, [SomeException])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileInfo, [SomeException]) -> [SomeException]
forall a b. (a, b) -> b
snd) ([(FileInfo, [SomeException])] -> [(FileInfo, [SomeException])])
-> ConduitM ByteString c m [(FileInfo, [SomeException])]
-> ConduitM ByteString c m [(FileInfo, [SomeException])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(FileInfo, [SomeException])]
-> ConduitM ByteString c m [(FileInfo, [SomeException])]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [(FileInfo, [SomeException])]
finalizers


--------------------------------------------------------------------------------
-- Create a tar file -----------------------------------------------------------
--------------------------------------------------------------------------------

gnuTarMagicVersion :: ShortByteString
gnuTarMagicVersion :: ShortByteString
gnuTarMagicVersion = ByteString -> ShortByteString
toShort (FilePath -> ByteString
S8.pack FilePath
"ustar  \NUL")

ustarMagicVersion :: ShortByteString
ustarMagicVersion :: ShortByteString
ustarMagicVersion = ByteString -> ShortByteString
toShort (FilePath -> ByteString
S8.pack FilePath
"ustar\NUL00")

blockSize :: FileOffset
blockSize :: FileOffset
blockSize = FileOffset
512

terminatorBlock :: ByteString
terminatorBlock :: ByteString
terminatorBlock = Int -> Word8 -> ByteString
S.replicate (FileOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileOffset
2 FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
* FileOffset
blockSize)) Word8
0

defHeader :: FileOffset -> Header
defHeader :: FileOffset -> Header
defHeader FileOffset
offset = Header :: FileOffset
-> FileOffset
-> ShortByteString
-> CMode
-> UserID
-> GroupID
-> FileOffset
-> EpochTime
-> Word8
-> ShortByteString
-> ShortByteString
-> ShortByteString
-> ShortByteString
-> DeviceID
-> DeviceID
-> ShortByteString
-> Header
Header
          { headerOffset :: FileOffset
headerOffset = FileOffset
offset
          , headerPayloadOffset :: FileOffset
headerPayloadOffset = FileOffset
offset FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ FileOffset
512
          , headerFileNameSuffix :: ShortByteString
headerFileNameSuffix = ShortByteString
SS.empty
          , headerFileMode :: CMode
headerFileMode = CMode
0o644
          , headerOwnerId :: UserID
headerOwnerId = UserID
0
          , headerGroupId :: GroupID
headerGroupId = GroupID
0
          , headerPayloadSize :: FileOffset
headerPayloadSize = FileOffset
0
          , headerTime :: EpochTime
headerTime = EpochTime
0
          , headerLinkIndicator :: Word8
headerLinkIndicator = Word8
0
          , headerLinkName :: ShortByteString
headerLinkName = ShortByteString
SS.empty
          , headerMagicVersion :: ShortByteString
headerMagicVersion = ShortByteString
ustarMagicVersion
          , headerOwnerName :: ShortByteString
headerOwnerName = ShortByteString
"root"
          , headerGroupName :: ShortByteString
headerGroupName = ShortByteString
"root"
          , headerDeviceMajor :: DeviceID
headerDeviceMajor = DeviceID
0
          , headerDeviceMinor :: DeviceID
headerDeviceMinor = DeviceID
0
          , headerFileNamePrefix :: ShortByteString
headerFileNamePrefix = ShortByteString
SS.empty
          }


headerFromFileInfo ::
       MonadThrow m
    => FileOffset -- ^ Starting offset within the tarball. Must be multiple of 512, otherwise error.
    -> FileInfo -- ^ File info.
    -> m (Either TarCreateException Header)
headerFromFileInfo :: FileOffset -> FileInfo -> m (Either TarCreateException Header)
headerFromFileInfo FileOffset
offset FileInfo
fi = do
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FileOffset
offset FileOffset -> FileOffset -> FileOffset
forall a. Integral a => a -> a -> a
`mod` FileOffset
512 FileOffset -> FileOffset -> Bool
forall a. Eq a => a -> a -> Bool
== FileOffset
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        TarCreateException -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TarCreateException -> m ()) -> TarCreateException -> m ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> TarCreateException
TarCreationError (FilePath -> TarCreateException) -> FilePath -> TarCreateException
forall a b. (a -> b) -> a -> b
$
        FilePath
"<headerFromFileInfo>: Offset must always be a multiple of 512 for file: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
        FileInfo -> FilePath
getFileInfoPath FileInfo
fi
    let (ShortByteString
prefix, ShortByteString
suffix) = Int -> ByteString -> (ShortByteString, ShortByteString)
splitPathAt Int
100 (ByteString -> (ShortByteString, ShortByteString))
-> ByteString -> (ShortByteString, ShortByteString)
forall a b. (a -> b) -> a -> b
$ FileInfo -> ByteString
filePath FileInfo
fi
    if ShortByteString -> Int
SS.length ShortByteString
prefix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
155 Bool -> Bool -> Bool
|| ShortByteString -> Bool
SS.null ShortByteString
suffix
        then Either TarCreateException Header
-> m (Either TarCreateException Header)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TarCreateException Header
 -> m (Either TarCreateException Header))
-> Either TarCreateException Header
-> m (Either TarCreateException Header)
forall a b. (a -> b) -> a -> b
$ TarCreateException -> Either TarCreateException Header
forall a b. a -> Either a b
Left (TarCreateException -> Either TarCreateException Header)
-> TarCreateException -> Either TarCreateException Header
forall a b. (a -> b) -> a -> b
$ FileInfo -> TarCreateException
FileNameTooLong FileInfo
fi
        else do
            (FileOffset
payloadSize, ShortByteString
linkName, Word8
linkIndicator) <-
                case FileInfo -> FileType
fileType FileInfo
fi of
                    FileType
FTNormal -> (FileOffset, ShortByteString, Word8)
-> m (FileOffset, ShortByteString, Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileInfo -> FileOffset
fileSize FileInfo
fi, ShortByteString
SS.empty, Word8
48)
                    FTHardLink ByteString
ln -> (FileOffset, ShortByteString, Word8)
-> m (FileOffset, ShortByteString, Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileOffset
0, ByteString -> ShortByteString
toShort ByteString
ln, Word8
49)
                    FTSymbolicLink ByteString
ln -> (FileOffset, ShortByteString, Word8)
-> m (FileOffset, ShortByteString, Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileOffset
0, ByteString -> ShortByteString
toShort ByteString
ln, Word8
50)
                    FileType
FTDirectory -> (FileOffset, ShortByteString, Word8)
-> m (FileOffset, ShortByteString, Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (FileOffset
0, ShortByteString
SS.empty, Word8
53)
                    FileType
fty ->
                        TarCreateException -> m (FileOffset, ShortByteString, Word8)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TarCreateException -> m (FileOffset, ShortByteString, Word8))
-> TarCreateException -> m (FileOffset, ShortByteString, Word8)
forall a b. (a -> b) -> a -> b
$
                        FilePath -> TarCreateException
TarCreationError (FilePath -> TarCreateException) -> FilePath -> TarCreateException
forall a b. (a -> b) -> a -> b
$
                        FilePath
"<headerFromFileInfo>: Unsupported file type: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                        FileType -> FilePath
forall a. Show a => a -> FilePath
show FileType
fty FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" for file: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FileInfo -> FilePath
getFileInfoPath FileInfo
fi
            Either TarCreateException Header
-> m (Either TarCreateException Header)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TarCreateException Header
 -> m (Either TarCreateException Header))
-> Either TarCreateException Header
-> m (Either TarCreateException Header)
forall a b. (a -> b) -> a -> b
$
                Header -> Either TarCreateException Header
forall a b. b -> Either a b
Right
                    Header :: FileOffset
-> FileOffset
-> ShortByteString
-> CMode
-> UserID
-> GroupID
-> FileOffset
-> EpochTime
-> Word8
-> ShortByteString
-> ShortByteString
-> ShortByteString
-> ShortByteString
-> DeviceID
-> DeviceID
-> ShortByteString
-> Header
Header
                    { headerOffset :: FileOffset
headerOffset = FileOffset
offset
                    , headerPayloadOffset :: FileOffset
headerPayloadOffset = FileOffset
offset FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ FileOffset
512
                    , headerFileNameSuffix :: ShortByteString
headerFileNameSuffix = ShortByteString
suffix
                    , headerFileMode :: CMode
headerFileMode = FileInfo -> CMode
fileMode FileInfo
fi
                    , headerOwnerId :: UserID
headerOwnerId = FileInfo -> UserID
fileUserId FileInfo
fi
                    , headerGroupId :: GroupID
headerGroupId = FileInfo -> GroupID
fileGroupId FileInfo
fi
                    , headerPayloadSize :: FileOffset
headerPayloadSize = FileOffset
payloadSize
                    , headerTime :: EpochTime
headerTime = FileInfo -> EpochTime
fileModTime FileInfo
fi
                    , headerLinkIndicator :: Word8
headerLinkIndicator = Word8
linkIndicator
                    , headerLinkName :: ShortByteString
headerLinkName = ShortByteString
linkName
                    , headerMagicVersion :: ShortByteString
headerMagicVersion = ShortByteString
ustarMagicVersion
                    , headerOwnerName :: ShortByteString
headerOwnerName = ByteString -> ShortByteString
toShort (ByteString -> ShortByteString) -> ByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ FileInfo -> ByteString
fileUserName FileInfo
fi
                    , headerGroupName :: ShortByteString
headerGroupName = ByteString -> ShortByteString
toShort (ByteString -> ShortByteString) -> ByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ FileInfo -> ByteString
fileGroupName FileInfo
fi
                    , headerDeviceMajor :: DeviceID
headerDeviceMajor = DeviceID
0
                    , headerDeviceMinor :: DeviceID
headerDeviceMinor = DeviceID
0
                    , headerFileNamePrefix :: ShortByteString
headerFileNamePrefix = ShortByteString
prefix
                    }


-- | Split a file path at the @n@ mark from the end, while still keeping the
-- split as a valid path, i.e split at a path separator only.
splitPathAt :: Int -> ByteString -> (ShortByteString, ShortByteString)
splitPathAt :: Int -> ByteString -> (ShortByteString, ShortByteString)
splitPathAt Int
n ByteString
fp
    | ByteString -> Int
S.length ByteString
fp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n = (ShortByteString
SS.empty, ByteString -> ShortByteString
toShort ByteString
fp)
    | Bool
otherwise =
        let sfp :: [ByteString]
sfp = (Char -> Bool) -> ByteString -> [ByteString]
S8.splitWith Char -> Bool
isPathSeparator ByteString
fp
            sepWith :: ByteString
-> (Int, [ByteString], [ByteString])
-> (Int, [ByteString], [ByteString])
sepWith ByteString
p (Int
tlen, [ByteString]
prefix', [ByteString]
suffix') =
                case ByteString -> Int
S.length ByteString
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tlen of
                    Int
tlen'
                        | Int
tlen' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n -> (Int
tlen', [ByteString]
prefix', ByteString
p ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
suffix')
                    Int
tlen' -> (Int
tlen', ByteString
p ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
prefix', [ByteString]
suffix')
            (Int
_, [ByteString]
prefix, [ByteString]
suffix) = (ByteString
 -> (Int, [ByteString], [ByteString])
 -> (Int, [ByteString], [ByteString]))
-> (Int, [ByteString], [ByteString])
-> [ByteString]
-> (Int, [ByteString], [ByteString])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' ByteString
-> (Int, [ByteString], [ByteString])
-> (Int, [ByteString], [ByteString])
sepWith (Int
0, [], []) [ByteString]
sfp
            toShortPath :: [ByteString] -> ShortByteString
toShortPath = ByteString -> ShortByteString
toShort (ByteString -> ShortByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
S8.intercalate ByteString
pathSeparatorS
        in ([ByteString] -> ShortByteString
toShortPath [ByteString]
prefix, [ByteString] -> ShortByteString
toShortPath [ByteString]
suffix)

packHeader :: MonadThrow m => Header -> m S.ByteString
packHeader :: Header -> m ByteString
packHeader Header
header = do
    (ByteString
left, ByteString
right) <- Header -> m (ByteString, ByteString)
forall (m :: * -> *).
MonadThrow m =>
Header -> m (ByteString, ByteString)
packHeaderNoChecksum Header
header
    let sumsl :: SL.ByteString -> Int
        sumsl :: ByteString -> Int
sumsl = (Int -> Word8 -> Int) -> Int -> ByteString -> Int
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
SL.foldl' (\ !Int
acc !Word8
v -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v) Int
0
        checksum :: Int
checksum = ByteString -> Int
sumsl ByteString
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
sumsl ByteString
right
    Builder
encChecksum <-
        ((Int, Int) -> m Builder)
-> (Builder -> m Builder) -> Either (Int, Int) Builder -> m Builder
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (\(Int
_, Int
val) ->
                 TarCreateException -> m Builder
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TarCreateException -> m Builder)
-> TarCreateException -> m Builder
forall a b. (a -> b) -> a -> b
$
                 FilePath -> TarCreateException
TarCreationError (FilePath -> TarCreateException) -> FilePath -> TarCreateException
forall a b. (a -> b) -> a -> b
$
                 FilePath
"<packHeader>: Impossible happened - Checksum " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 Int -> FilePath
forall a. Show a => a -> FilePath
show Int
val FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" doesn't fit into header for file: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Header -> FilePath
headerFilePath Header
header)
            Builder -> m Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Int, Int) Builder -> m Builder)
-> Either (Int, Int) Builder -> m Builder
forall a b. (a -> b) -> a -> b
$
        Int -> Int -> Either (Int, Int) Builder
forall a. Integral a => Int -> a -> Either (Int, a) Builder
encodeOctal Int
8 Int
checksum
    ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
SL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
left ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Builder -> ByteString
toLazyByteString Builder
encChecksum ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
right

packHeaderNoChecksum :: MonadThrow m => Header -> m (SL.ByteString, SL.ByteString)
packHeaderNoChecksum :: Header -> m (ByteString, ByteString)
packHeaderNoChecksum h :: Header
h@Header {Word8
DeviceID
CMode
FileOffset
GroupID
UserID
EpochTime
ShortByteString
headerFileNamePrefix :: ShortByteString
headerDeviceMinor :: DeviceID
headerDeviceMajor :: DeviceID
headerGroupName :: ShortByteString
headerOwnerName :: ShortByteString
headerMagicVersion :: ShortByteString
headerLinkName :: ShortByteString
headerLinkIndicator :: Word8
headerTime :: EpochTime
headerPayloadSize :: FileOffset
headerGroupId :: GroupID
headerOwnerId :: UserID
headerFileMode :: CMode
headerFileNameSuffix :: ShortByteString
headerPayloadOffset :: FileOffset
headerOffset :: FileOffset
headerFileNamePrefix :: Header -> ShortByteString
headerDeviceMinor :: Header -> DeviceID
headerDeviceMajor :: Header -> DeviceID
headerGroupName :: Header -> ShortByteString
headerOwnerName :: Header -> ShortByteString
headerMagicVersion :: Header -> ShortByteString
headerLinkName :: Header -> ShortByteString
headerLinkIndicator :: Header -> Word8
headerTime :: Header -> EpochTime
headerPayloadSize :: Header -> FileOffset
headerGroupId :: Header -> GroupID
headerOwnerId :: Header -> UserID
headerFileMode :: Header -> CMode
headerFileNameSuffix :: Header -> ShortByteString
headerPayloadOffset :: Header -> FileOffset
headerOffset :: Header -> FileOffset
..} = do
    let CTime Int64
headerTime' = EpochTime
headerTime
        magic0 :: ShortByteString
magic0 = ShortByteString
headerMagicVersion
    (ShortByteString
magic1, Builder
hOwnerId) <- ShortByteString
-> FilePath -> Int -> UserID -> m (ShortByteString, Builder)
forall (m :: * -> *) a.
(MonadThrow m, Show a, Storable a, Bits a, Integral a) =>
ShortByteString
-> FilePath -> Int -> a -> m (ShortByteString, Builder)
encodeNumber ShortByteString
magic0 FilePath
"ownerId" Int
8 UserID
headerOwnerId
    (ShortByteString
magic2, Builder
hGroupId) <- ShortByteString
-> FilePath -> Int -> GroupID -> m (ShortByteString, Builder)
forall (m :: * -> *) a.
(MonadThrow m, Show a, Storable a, Bits a, Integral a) =>
ShortByteString
-> FilePath -> Int -> a -> m (ShortByteString, Builder)
encodeNumber ShortByteString
magic1 FilePath
"groupId" Int
8 GroupID
headerGroupId
    (ShortByteString
magic3, Builder
hPayloadSize) <- ShortByteString
-> FilePath -> Int -> FileOffset -> m (ShortByteString, Builder)
forall (m :: * -> *) a.
(MonadThrow m, Show a, Storable a, Bits a, Integral a) =>
ShortByteString
-> FilePath -> Int -> a -> m (ShortByteString, Builder)
encodeNumber ShortByteString
magic2 FilePath
"payloadSize" Int
12 FileOffset
headerPayloadSize
    (ShortByteString
magic4, Builder
hTime) <- ShortByteString
-> FilePath -> Int -> Int64 -> m (ShortByteString, Builder)
forall (m :: * -> *) a.
(MonadThrow m, Show a, Storable a, Bits a, Integral a) =>
ShortByteString
-> FilePath -> Int -> a -> m (ShortByteString, Builder)
encodeNumber ShortByteString
magic3 FilePath
"time" Int
12 Int64
headerTime'
    (ShortByteString
magic5, Builder
hDevMajor) <- ShortByteString
-> FilePath -> DeviceID -> m (ShortByteString, Builder)
forall a (m :: * -> *).
(MonadThrow m, Show a, Storable a, Bits a, Integral a) =>
ShortByteString -> FilePath -> a -> m (ShortByteString, Builder)
encodeDevice ShortByteString
magic4 FilePath
"Major" DeviceID
headerDeviceMajor
    (ShortByteString
magic6, Builder
hDevMinor) <- ShortByteString
-> FilePath -> DeviceID -> m (ShortByteString, Builder)
forall a (m :: * -> *).
(MonadThrow m, Show a, Storable a, Bits a, Integral a) =>
ShortByteString -> FilePath -> a -> m (ShortByteString, Builder)
encodeDevice ShortByteString
magic5 FilePath
"Minor" DeviceID
headerDeviceMinor
    Builder
hNameSuffix <- Header -> FilePath -> Int -> ShortByteString -> m Builder
forall (m :: * -> *).
MonadThrow m =>
Header -> FilePath -> Int -> ShortByteString -> m Builder
encodeShort Header
h FilePath
"nameSuffix" Int
100 ShortByteString
headerFileNameSuffix
    Builder
hFileMode <- FilePath -> Either (Int, CMode) Builder -> m Builder
forall (m :: * -> *) a a a.
(MonadThrow m, Show a, Show a) =>
FilePath -> Either (a, a) a -> m a
throwNumberEither FilePath
"fileMode" (Either (Int, CMode) Builder -> m Builder)
-> Either (Int, CMode) Builder -> m Builder
forall a b. (a -> b) -> a -> b
$ Int -> CMode -> Either (Int, CMode) Builder
forall a. Integral a => Int -> a -> Either (Int, a) Builder
encodeOctal Int
8 CMode
headerFileMode
    Builder
hLinkName <- Header -> FilePath -> Int -> ShortByteString -> m Builder
forall (m :: * -> *).
MonadThrow m =>
Header -> FilePath -> Int -> ShortByteString -> m Builder
encodeShort Header
h FilePath
"linkName" Int
100 ShortByteString
headerLinkName
    Builder
hMagicVersion <- Header -> FilePath -> Int -> ShortByteString -> m Builder
forall (m :: * -> *).
MonadThrow m =>
Header -> FilePath -> Int -> ShortByteString -> m Builder
encodeShort Header
h FilePath
"magicVersion" Int
8 ShortByteString
magic6
    Builder
hOwnerName <- Header -> FilePath -> Int -> ShortByteString -> m Builder
forall (m :: * -> *).
MonadThrow m =>
Header -> FilePath -> Int -> ShortByteString -> m Builder
encodeShort Header
h FilePath
"ownerName" Int
32 ShortByteString
headerOwnerName
    Builder
hGroupName <- Header -> FilePath -> Int -> ShortByteString -> m Builder
forall (m :: * -> *).
MonadThrow m =>
Header -> FilePath -> Int -> ShortByteString -> m Builder
encodeShort Header
h FilePath
"groupName" Int
32 ShortByteString
headerGroupName
    Builder
hNamePrefix <- Header -> FilePath -> Int -> ShortByteString -> m Builder
forall (m :: * -> *).
MonadThrow m =>
Header -> FilePath -> Int -> ShortByteString -> m Builder
encodeShort Header
h FilePath
"namePrefix" Int
155 ShortByteString
headerFileNamePrefix
    (ByteString, ByteString) -> m (ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
          Builder
hNameSuffix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          Builder
hFileMode Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          Builder
hOwnerId Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          Builder
hGroupId Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          Builder
hPayloadSize Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          Builder
hTime
        , Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
          Word8 -> Builder
word8 Word8
headerLinkIndicator Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          Builder
hLinkName Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          Builder
hMagicVersion Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          Builder
hOwnerName Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          Builder
hGroupName Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          Builder
hDevMajor Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          Builder
hDevMinor Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          Builder
hNamePrefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          ByteString -> Builder
byteString (Int -> Word8 -> ByteString
S.replicate Int
12 Word8
0)
        )
  where
    encodeNumber :: ShortByteString
-> FilePath -> Int -> a -> m (ShortByteString, Builder)
encodeNumber ShortByteString
magic FilePath
field Int
len = FilePath
-> Either (Int, a) (ShortByteString, Builder)
-> m (ShortByteString, Builder)
forall (m :: * -> *) a a a.
(MonadThrow m, Show a, Show a) =>
FilePath -> Either (a, a) a -> m a
throwNumberEither FilePath
field (Either (Int, a) (ShortByteString, Builder)
 -> m (ShortByteString, Builder))
-> (a -> Either (Int, a) (ShortByteString, Builder))
-> a
-> m (ShortByteString, Builder)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString
-> Either (Int, a) Builder
-> Either (Int, a) (ShortByteString, Builder)
forall a.
(Storable a, Bits a, Integral a) =>
ShortByteString
-> Either (Int, a) Builder
-> Either (Int, a) (ShortByteString, Builder)
fallbackHex ShortByteString
magic (Either (Int, a) Builder
 -> Either (Int, a) (ShortByteString, Builder))
-> (a -> Either (Int, a) Builder)
-> a
-> Either (Int, a) (ShortByteString, Builder)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Either (Int, a) Builder
forall a. Integral a => Int -> a -> Either (Int, a) Builder
encodeOctal Int
len
    encodeDevice :: ShortByteString -> FilePath -> a -> m (ShortByteString, Builder)
encodeDevice ShortByteString
magic FilePath
_ a
0     = (ShortByteString, Builder) -> m (ShortByteString, Builder)
forall (m :: * -> *) a. Monad m => a -> m a
return (ShortByteString
magic, ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
S.replicate Int
8 Word8
0)
    encodeDevice ShortByteString
magic FilePath
m a
devid = ShortByteString
-> FilePath -> Int -> a -> m (ShortByteString, Builder)
forall (m :: * -> *) a.
(MonadThrow m, Show a, Storable a, Bits a, Integral a) =>
ShortByteString
-> FilePath -> Int -> a -> m (ShortByteString, Builder)
encodeNumber ShortByteString
magic (FilePath
"device" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
m) Int
8 a
devid
    fallbackHex :: ShortByteString
-> Either (Int, a) Builder
-> Either (Int, a) (ShortByteString, Builder)
fallbackHex ShortByteString
magic (Right Builder
enc)       = (ShortByteString, Builder)
-> Either (Int, a) (ShortByteString, Builder)
forall a b. b -> Either a b
Right (ShortByteString
magic, Builder
enc)
    fallbackHex ShortByteString
_     (Left (Int
len, a
val)) = (,) ShortByteString
gnuTarMagicVersion (Builder -> (ShortByteString, Builder))
-> Either (Int, a) Builder
-> Either (Int, a) (ShortByteString, Builder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> Either (Int, a) Builder
forall a.
(Storable a, Bits a, Integral a) =>
Int -> a -> Either (Int, a) Builder
encodeHex Int
len a
val
    throwNumberEither :: FilePath -> Either (a, a) a -> m a
throwNumberEither FilePath
_     (Right a
v)         = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
    throwNumberEither FilePath
field (Left (a
len, a
val)) =
        TarCreateException -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TarCreateException -> m a) -> TarCreateException -> m a
forall a b. (a -> b) -> a -> b
$
        FilePath -> TarCreateException
TarCreationError (FilePath -> TarCreateException) -> FilePath -> TarCreateException
forall a b. (a -> b) -> a -> b
$
        FilePath
"<packHeaderNoChecksum>: Tar value overflow for file: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
        Header -> FilePath
headerFilePath Header
h FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
        FilePath
" (for field '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
field FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' with maxLen " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
len FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"): " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
val


-- | Encode a number as hexadecimal with most significant bit set to 1. Returns Left if the value
-- doesn't fit in a ByteString of the supplied length, also prohibits negative numbers if precision
-- of value is higher than available length. Eg. length 8 can't reliably encoed negative numbers,
-- since MSB is already used for flagging Hex extension.
encodeHex :: (Storable a, Bits a, Integral a) =>
             Int -> a -> Either (Int, a) Builder
encodeHex :: Int -> a -> Either (Int, a) Builder
encodeHex !Int
len !a
val =
    if a -> a
forall a. Bits a => a -> a
complement (a -> a
forall a. Bits a => a -> a
complement a
0 a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
infoBits) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
val a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
val Bool -> Bool -> Bool
&&
       Bool -> Bool
not (a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 Bool -> Bool -> Bool
&& Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Int
forall a. Storable a => a -> Int
sizeOf a
val)
        then Int -> a -> Builder -> Either (Int, a) Builder
forall a (m :: * -> *).
(Bits a, Integral a, Monad m) =>
Int -> a -> Builder -> m Builder
go Int
0 a
val Builder
forall a. Monoid a => a
mempty
        else (Int, a) -> Either (Int, a) Builder
forall a b. a -> Either a b
Left (Int
len, a
val)
  where
    len' :: Int
len' = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    infoBits :: Int
infoBits = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    go :: Int -> a -> Builder -> m Builder
go !Int
n !a
cur !Builder
acc
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len' = Int -> a -> Builder -> m Builder
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (a
cur a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) (Word8 -> Builder
word8 (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
cur a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xFF)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
acc)
        | Bool
otherwise = Builder -> m Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Builder
word8 (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
cur a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x7F) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
acc)


-- | Encode a number in 8base padded with zeros and terminated with NUL.
encodeOctal :: (Integral a) =>
                Int -> a -> Either (Int, a) Builder
encodeOctal :: Int -> a -> Either (Int, a) Builder
encodeOctal !Int
len' !a
val
    | a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = (Int, a) -> Either (Int, a) Builder
forall a b. a -> Either a b
Left (Int
len', a
val)
    | Bool
otherwise = Int -> a -> Builder -> Either (Int, a) Builder
forall a.
Integral a =>
Int -> a -> Builder -> Either (Int, a) Builder
go Int
0 a
val (Word8 -> Builder
word8 Word8
0)
  where
    !len :: Int
len = Int
len' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    go :: Int -> a -> Builder -> Either (Int, a) Builder
go !Int
n !a
cur !Builder
acc
        | a
cur a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 =
            if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len
                then Builder -> Either (Int, a) Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Either (Int, a) Builder)
-> Builder -> Either (Int, a) Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString (Int -> Word8 -> ByteString
S.replicate (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Word8
48) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
acc
                else Builder -> Either (Int, a) Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
acc
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len =
            let !(a
q, a
r) = a
cur a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`quotRem` a
8
            in Int -> a -> Builder -> Either (Int, a) Builder
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
q (Word8 -> Builder
word8 (a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
r Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
48) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
acc)
        | Bool
otherwise = (Int, a) -> Either (Int, a) Builder
forall a b. a -> Either a b
Left (Int
len', a
val)



-- | Encode a `ShortByteString` with an exact length, NUL terminating if it is
-- shorter, but throwing `TarCreationError` if it is longer.
encodeShort :: MonadThrow m => Header -> String -> Int -> ShortByteString -> m Builder
encodeShort :: Header -> FilePath -> Int -> ShortByteString -> m Builder
encodeShort Header
h FilePath
field !Int
len !ShortByteString
sbs
    | Int
lenShort Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
len = Builder -> m Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> m Builder) -> Builder -> m Builder
forall a b. (a -> b) -> a -> b
$ ShortByteString -> Builder
shortByteString ShortByteString
sbs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString (Int -> Word8 -> ByteString
S.replicate (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lenShort) Word8
0)
    | Bool
otherwise =
        TarCreateException -> m Builder
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TarCreateException -> m Builder)
-> TarCreateException -> m Builder
forall a b. (a -> b) -> a -> b
$
        FilePath -> TarCreateException
TarCreationError (FilePath -> TarCreateException) -> FilePath -> TarCreateException
forall a b. (a -> b) -> a -> b
$
        FilePath
"<encodeShort>: Tar string value overflow for file: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
        Header -> FilePath
headerFilePath Header
h FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
        FilePath
" (for field '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
field FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"' with maxLen " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
len FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"): " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ByteString -> FilePath
S8.unpack (ShortByteString -> ByteString
fromShort ShortByteString
sbs)
  where
    lenShort :: Int
lenShort = ShortByteString -> Int
SS.length ShortByteString
sbs


-- | Produce a ByteString chunk with NUL characters of the size needed to get up
-- to the next 512 byte mark in respect to the supplied offset and return that
-- offset incremented to that mark.
yieldNulPadding :: Monad m => FileOffset -> ConduitM i ByteString m FileOffset
yieldNulPadding :: FileOffset -> ConduitM i ByteString m FileOffset
yieldNulPadding FileOffset
n = do
    let pad :: FileOffset
pad = FileOffset
blockSize FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
- (FileOffset
n FileOffset -> FileOffset -> FileOffset
forall a. Integral a => a -> a -> a
`mod` FileOffset
blockSize)
    if FileOffset
pad FileOffset -> FileOffset -> Bool
forall a. Eq a => a -> a -> Bool
/= FileOffset
blockSize
        then ByteString -> ConduitT i ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Int -> Word8 -> ByteString
S.replicate (FileOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FileOffset
pad) Word8
0) ConduitT i ByteString m ()
-> ConduitM i ByteString m FileOffset
-> ConduitM i ByteString m FileOffset
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FileOffset -> ConduitM i ByteString m FileOffset
forall (m :: * -> *) a. Monad m => a -> m a
return (FileOffset
n FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ FileOffset
pad)
        else FileOffset -> ConduitM i ByteString m FileOffset
forall (m :: * -> *) a. Monad m => a -> m a
return FileOffset
n



-- | Handle tar payload, while validating its size and padding it to the full
-- block at the end.
tarPayload :: MonadThrow m =>
              FileOffset -- ^ Received payload size
           -> Header -- ^ Header for the file that we are currently receiving the payload for
           -> (FileOffset -> ConduitM (Either a ByteString) ByteString m FileOffset)
           -- ^ Continuation for after all payload has been received
           -> ConduitM (Either a ByteString) ByteString m FileOffset
tarPayload :: FileOffset
-> Header
-> (FileOffset
    -> ConduitM (Either a ByteString) ByteString m FileOffset)
-> ConduitM (Either a ByteString) ByteString m FileOffset
tarPayload FileOffset
size Header
header FileOffset
-> ConduitM (Either a ByteString) ByteString m FileOffset
cont
    | FileOffset
size FileOffset -> FileOffset -> Bool
forall a. Eq a => a -> a -> Bool
== Header -> FileOffset
headerPayloadSize Header
header = FileOffset
-> ConduitM (Either a ByteString) ByteString m FileOffset
cont (Header -> FileOffset
headerOffset Header
header FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ FileOffset
blockSize)
    | Bool
otherwise = FileOffset
-> ConduitM (Either a ByteString) ByteString m FileOffset
go FileOffset
size
  where
    go :: FileOffset
-> ConduitM (Either a ByteString) ByteString m FileOffset
go FileOffset
prevSize = do
        Maybe (Either a ByteString)
eContent <- ConduitT
  (Either a ByteString) ByteString m (Maybe (Either a ByteString))
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
        case Maybe (Either a ByteString)
eContent of
            Just h :: Either a ByteString
h@(Left a
_) -> do
                Either a ByteString
-> ConduitT (Either a ByteString) ByteString m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Either a ByteString
h
                TarCreateException
-> ConduitM (Either a ByteString) ByteString m FileOffset
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TarCreateException
 -> ConduitM (Either a ByteString) ByteString m FileOffset)
-> TarCreateException
-> ConduitM (Either a ByteString) ByteString m FileOffset
forall a b. (a -> b) -> a -> b
$
                    FilePath -> TarCreateException
TarCreationError (FilePath -> TarCreateException) -> FilePath -> TarCreateException
forall a b. (a -> b) -> a -> b
$
                    FilePath
"<tarPayload>: Not enough payload for file: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Header -> FilePath
headerFilePath Header
header
            Just (Right ByteString
content) -> do
                let nextSize :: FileOffset
nextSize = FileOffset
prevSize FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ Int -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
content)
                Bool
-> ConduitT (Either a ByteString) ByteString m ()
-> ConduitT (Either a ByteString) ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FileOffset
nextSize FileOffset -> FileOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= Header -> FileOffset
headerPayloadSize Header
header) (ConduitT (Either a ByteString) ByteString m ()
 -> ConduitT (Either a ByteString) ByteString m ())
-> ConduitT (Either a ByteString) ByteString m ()
-> ConduitT (Either a ByteString) ByteString m ()
forall a b. (a -> b) -> a -> b
$
                    TarCreateException
-> ConduitT (Either a ByteString) ByteString m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TarCreateException
 -> ConduitT (Either a ByteString) ByteString m ())
-> TarCreateException
-> ConduitT (Either a ByteString) ByteString m ()
forall a b. (a -> b) -> a -> b
$
                    FilePath -> TarCreateException
TarCreationError (FilePath -> TarCreateException) -> FilePath -> TarCreateException
forall a b. (a -> b) -> a -> b
$
                    FilePath
"<tarPayload>: Too much payload (" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                    FileOffset -> FilePath
forall a. Show a => a -> FilePath
show FileOffset
nextSize FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
") for file with size (" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                    FileOffset -> FilePath
forall a. Show a => a -> FilePath
show (Header -> FileOffset
headerPayloadSize Header
header) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"): " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Header -> FilePath
headerFilePath Header
header
                ByteString -> ConduitT (Either a ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
content
                if FileOffset
nextSize FileOffset -> FileOffset -> Bool
forall a. Eq a => a -> a -> Bool
== Header -> FileOffset
headerPayloadSize Header
header
                    then do
                        FileOffset
paddedSize <- FileOffset
-> ConduitM (Either a ByteString) ByteString m FileOffset
forall (m :: * -> *) i.
Monad m =>
FileOffset -> ConduitM i ByteString m FileOffset
yieldNulPadding FileOffset
nextSize
                        FileOffset
-> ConduitM (Either a ByteString) ByteString m FileOffset
cont (Header -> FileOffset
headerPayloadOffset Header
header FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ FileOffset
paddedSize)
                    else FileOffset
-> ConduitM (Either a ByteString) ByteString m FileOffset
go FileOffset
nextSize
            Maybe (Either a ByteString)
Nothing ->
                TarCreateException
-> ConduitM (Either a ByteString) ByteString m FileOffset
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TarCreateException
 -> ConduitM (Either a ByteString) ByteString m FileOffset)
-> TarCreateException
-> ConduitM (Either a ByteString) ByteString m FileOffset
forall a b. (a -> b) -> a -> b
$
                FilePath -> TarCreateException
TarCreationError FilePath
"<tarPayload>: Stream finished abruptly. Not enough payload."



tarHeader :: MonadThrow m =>
             FileOffset -> ConduitM (Either Header ByteString) ByteString m FileOffset
tarHeader :: FileOffset
-> ConduitM (Either Header ByteString) ByteString m FileOffset
tarHeader FileOffset
offset = do
    Maybe (Either Header ByteString)
eContent <- ConduitT
  (Either Header ByteString)
  ByteString
  m
  (Maybe (Either Header ByteString))
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
    case Maybe (Either Header ByteString)
eContent of
        Just (Right ByteString
bs) | ByteString -> Bool
S.null ByteString
bs -> FileOffset
-> ConduitM (Either Header ByteString) ByteString m FileOffset
forall (m :: * -> *).
MonadThrow m =>
FileOffset
-> ConduitM (Either Header ByteString) ByteString m FileOffset
tarHeader FileOffset
offset -- ignore empty content
        Just c :: Either Header ByteString
c@(Right ByteString
_) -> do
            Either Header ByteString
-> ConduitT (Either Header ByteString) ByteString m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Either Header ByteString
c
            TarCreateException
-> ConduitM (Either Header ByteString) ByteString m FileOffset
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TarCreateException
 -> ConduitM (Either Header ByteString) ByteString m FileOffset)
-> TarCreateException
-> ConduitM (Either Header ByteString) ByteString m FileOffset
forall a b. (a -> b) -> a -> b
$
                FilePath -> TarCreateException
TarCreationError FilePath
"<tarHeader>: Received payload without a corresponding Header."
        Just (Left Header
header) -> do
            Header
-> ConduitT (Either Header ByteString) ByteString m ByteString
forall (m :: * -> *). MonadThrow m => Header -> m ByteString
packHeader Header
header ConduitT (Either Header ByteString) ByteString m ByteString
-> (ByteString
    -> ConduitT (Either Header ByteString) ByteString m ())
-> ConduitT (Either Header ByteString) ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> ConduitT (Either Header ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield
            FileOffset
-> Header
-> (FileOffset
    -> ConduitM (Either Header ByteString) ByteString m FileOffset)
-> ConduitM (Either Header ByteString) ByteString m FileOffset
forall (m :: * -> *) a.
MonadThrow m =>
FileOffset
-> Header
-> (FileOffset
    -> ConduitM (Either a ByteString) ByteString m FileOffset)
-> ConduitM (Either a ByteString) ByteString m FileOffset
tarPayload FileOffset
0 Header
header FileOffset
-> ConduitM (Either Header ByteString) ByteString m FileOffset
forall (m :: * -> *).
MonadThrow m =>
FileOffset
-> ConduitM (Either Header ByteString) ByteString m FileOffset
tarHeader
        Maybe (Either Header ByteString)
Nothing -> do
            ByteString -> ConduitT (Either Header ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
terminatorBlock
            FileOffset
-> ConduitM (Either Header ByteString) ByteString m FileOffset
forall (m :: * -> *) a. Monad m => a -> m a
return (FileOffset
 -> ConduitM (Either Header ByteString) ByteString m FileOffset)
-> FileOffset
-> ConduitM (Either Header ByteString) ByteString m FileOffset
forall a b. (a -> b) -> a -> b
$ FileOffset
offset FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ Int -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
terminatorBlock)



tarFileInfo :: MonadThrow m =>
               FileOffset -> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tarFileInfo :: FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tarFileInfo FileOffset
offset = do
    Maybe (Either FileInfo ByteString)
eContent <- ConduitT
  (Either FileInfo ByteString)
  ByteString
  m
  (Maybe (Either FileInfo ByteString))
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
    case Maybe (Either FileInfo ByteString)
eContent of
        Just (Right ByteString
bs)
            | ByteString -> Bool
S.null ByteString
bs -> FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
forall (m :: * -> *).
MonadThrow m =>
FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tarFileInfo FileOffset
offset -- ignore empty content
        Just c :: Either FileInfo ByteString
c@(Right ByteString
_) -> do
            Either FileInfo ByteString
-> ConduitT (Either FileInfo ByteString) ByteString m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Either FileInfo ByteString
c
            TarCreateException
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TarCreateException
 -> ConduitM (Either FileInfo ByteString) ByteString m FileOffset)
-> TarCreateException
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
forall a b. (a -> b) -> a -> b
$
                FilePath -> TarCreateException
TarCreationError FilePath
"<tarFileInfo>: Received payload without a corresponding FileInfo."
        Just (Left FileInfo
fi) -> do
            Either TarCreateException Header
eHeader <- FileOffset
-> FileInfo
-> ConduitT
     (Either FileInfo ByteString)
     ByteString
     m
     (Either TarCreateException Header)
forall (m :: * -> *).
MonadThrow m =>
FileOffset -> FileInfo -> m (Either TarCreateException Header)
headerFromFileInfo FileOffset
offset FileInfo
fi
            case Either TarCreateException Header
eHeader of
                Left (FileNameTooLong FileInfo
_) -> do
                    let fPath :: ByteString
fPath = FileInfo -> ByteString
filePath FileInfo
fi
                        fPathLen :: FileOffset
fPathLen = Int -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
fPath Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                        pad :: FileOffset
pad =
                            case FileOffset
fPathLen FileOffset -> FileOffset -> FileOffset
forall a. Integral a => a -> a -> a
`mod` FileOffset
blockSize of
                                FileOffset
0 -> FileOffset
0
                                FileOffset
x -> FileOffset
blockSize FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
- FileOffset
x
                    Either TarCreateException Header
eHeader' <-
                        FileOffset
-> FileInfo
-> ConduitT
     (Either FileInfo ByteString)
     ByteString
     m
     (Either TarCreateException Header)
forall (m :: * -> *).
MonadThrow m =>
FileOffset -> FileInfo -> m (Either TarCreateException Header)
headerFromFileInfo
                            (FileOffset
offset FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ FileOffset
blockSize FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ FileOffset
fPathLen FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ FileOffset
pad)
                            (FileInfo
fi {filePath :: ByteString
filePath = Int -> ByteString -> ByteString
S.take Int
100 ByteString
fPath})
                    Header
header <- (TarCreateException
 -> ConduitT (Either FileInfo ByteString) ByteString m Header)
-> (Header
    -> ConduitT (Either FileInfo ByteString) ByteString m Header)
-> Either TarCreateException Header
-> ConduitT (Either FileInfo ByteString) ByteString m Header
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TarCreateException
-> ConduitT (Either FileInfo ByteString) ByteString m Header
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM Header -> ConduitT (Either FileInfo ByteString) ByteString m Header
forall (m :: * -> *) a. Monad m => a -> m a
return Either TarCreateException Header
eHeader'
                    ByteString
pHeader <- Header
-> ConduitT (Either FileInfo ByteString) ByteString m ByteString
forall (m :: * -> *). MonadThrow m => Header -> m ByteString
packHeader Header
header
                    ByteString
pFileNameHeader <-
                        Header
-> ConduitT (Either FileInfo ByteString) ByteString m ByteString
forall (m :: * -> *). MonadThrow m => Header -> m ByteString
packHeader (Header
 -> ConduitT (Either FileInfo ByteString) ByteString m ByteString)
-> Header
-> ConduitT (Either FileInfo ByteString) ByteString m ByteString
forall a b. (a -> b) -> a -> b
$
                        (FileOffset -> Header
defHeader FileOffset
offset)
                        { headerFileNameSuffix :: ShortByteString
headerFileNameSuffix = ShortByteString
"././@LongLink"
                        , headerPayloadSize :: FileOffset
headerPayloadSize = FileOffset
fPathLen
                        , headerLinkIndicator :: Word8
headerLinkIndicator = Word8
76 -- 'L'
                        , headerMagicVersion :: ShortByteString
headerMagicVersion = ShortByteString
gnuTarMagicVersion
                        }
                    ByteString -> ConduitT (Either FileInfo ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
pFileNameHeader
                    ByteString -> ConduitT (Either FileInfo ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
fPath
                    ByteString -> ConduitT (Either FileInfo ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ByteString
 -> ConduitT (Either FileInfo ByteString) ByteString m ())
-> ByteString
-> ConduitT (Either FileInfo ByteString) ByteString m ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
S.replicate (FileOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral FileOffset
pad Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
0
                    ByteString -> ConduitT (Either FileInfo ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
pHeader
                    FileOffset
-> Header
-> (FileOffset
    -> ConduitM (Either FileInfo ByteString) ByteString m FileOffset)
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
forall (m :: * -> *) a.
MonadThrow m =>
FileOffset
-> Header
-> (FileOffset
    -> ConduitM (Either a ByteString) ByteString m FileOffset)
-> ConduitM (Either a ByteString) ByteString m FileOffset
tarPayload FileOffset
0 Header
header FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
forall (m :: * -> *).
MonadThrow m =>
FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tarFileInfo
                Left TarCreateException
exc -> TarCreateException
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TarCreateException
exc
                Right Header
header -> do
                    Header
-> ConduitT (Either FileInfo ByteString) ByteString m ByteString
forall (m :: * -> *). MonadThrow m => Header -> m ByteString
packHeader Header
header ConduitT (Either FileInfo ByteString) ByteString m ByteString
-> (ByteString
    -> ConduitT (Either FileInfo ByteString) ByteString m ())
-> ConduitT (Either FileInfo ByteString) ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> ConduitT (Either FileInfo ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield
                    FileOffset
-> Header
-> (FileOffset
    -> ConduitM (Either FileInfo ByteString) ByteString m FileOffset)
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
forall (m :: * -> *) a.
MonadThrow m =>
FileOffset
-> Header
-> (FileOffset
    -> ConduitM (Either a ByteString) ByteString m FileOffset)
-> ConduitM (Either a ByteString) ByteString m FileOffset
tarPayload FileOffset
0 Header
header FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
forall (m :: * -> *).
MonadThrow m =>
FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tarFileInfo
        Maybe (Either FileInfo ByteString)
Nothing -> FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
forall (m :: * -> *) a. Monad m => a -> m a
return FileOffset
offset



-- | Create a tar archive by suppying a stream of `Left` `FileInfo`s. Whenever a
-- file type is `FTNormal`, it must be immediately followed by its content as
-- `Right` `ByteString`. The produced `ByteString` is in the raw tar format and
-- is properly terminated at the end, therefore it can not be extended
-- afterwards. Returned is the total size of the bytestring as a `FileOffset`.
--
-- @since 0.2.0
tar :: MonadThrow m =>
       ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tar :: ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tar = do
    FileOffset
offset <- FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
forall (m :: * -> *).
MonadThrow m =>
FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tarFileInfo FileOffset
0
    ByteString -> ConduitT (Either FileInfo ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
terminatorBlock
    FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
forall (m :: * -> *) a. Monad m => a -> m a
return (FileOffset
 -> ConduitM (Either FileInfo ByteString) ByteString m FileOffset)
-> FileOffset
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
forall a b. (a -> b) -> a -> b
$ FileOffset
offset FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ Int -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
terminatorBlock)


-- | Just like `tar`, except gives you the ability to work at a lower `Header`
-- level, versus more user friendly `FileInfo`. A deeper understanding of tar
-- format is necessary in order to work directly with `Header`s.
--
-- @since 0.2.0
tarEntries :: MonadThrow m =>
              ConduitM (Either Header ByteString) ByteString m FileOffset
tarEntries :: ConduitM (Either Header ByteString) ByteString m FileOffset
tarEntries = do
    FileOffset
offset <- FileOffset
-> ConduitM (Either Header ByteString) ByteString m FileOffset
forall (m :: * -> *).
MonadThrow m =>
FileOffset
-> ConduitM (Either Header ByteString) ByteString m FileOffset
tarHeader FileOffset
0
    ByteString -> ConduitT (Either Header ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
terminatorBlock
    FileOffset
-> ConduitM (Either Header ByteString) ByteString m FileOffset
forall (m :: * -> *) a. Monad m => a -> m a
return (FileOffset
 -> ConduitM (Either Header ByteString) ByteString m FileOffset)
-> FileOffset
-> ConduitM (Either Header ByteString) ByteString m FileOffset
forall a b. (a -> b) -> a -> b
$ FileOffset
offset FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ Int -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
terminatorBlock)



-- | Turn a stream of file paths into a stream of `FileInfo` and file
-- content. All paths will be decended into recursively.
--
-- @since 0.2.0
filePathConduit :: (MonadThrow m, MonadResource m) =>
                   ConduitM FilePath (Either FileInfo ByteString) m ()
filePathConduit :: ConduitM FilePath (Either FileInfo ByteString) m ()
filePathConduit = do
    Maybe FilePath
mfp <- ConduitT FilePath (Either FileInfo ByteString) m (Maybe FilePath)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
    case Maybe FilePath
mfp of
        Just FilePath
fp -> do
            FileInfo
fi <- IO FileInfo
-> ConduitT FilePath (Either FileInfo ByteString) m FileInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileInfo
 -> ConduitT FilePath (Either FileInfo ByteString) m FileInfo)
-> IO FileInfo
-> ConduitT FilePath (Either FileInfo ByteString) m FileInfo
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileInfo
getFileInfo FilePath
fp
            case FileInfo -> FileType
fileType FileInfo
fi of
                FileType
FTNormal -> do
                    Either FileInfo ByteString
-> ConduitM FilePath (Either FileInfo ByteString) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (FileInfo -> Either FileInfo ByteString
forall a b. a -> Either a b
Left FileInfo
fi)
                    FilePath -> ConduitT FilePath ByteString m ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
sourceFile (FileInfo -> FilePath
getFileInfoPath FileInfo
fi) ConduitT FilePath ByteString m ()
-> ConduitM ByteString (Either FileInfo ByteString) m ()
-> ConduitM FilePath (Either FileInfo ByteString) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (ByteString -> Either FileInfo ByteString)
-> ConduitM ByteString (Either FileInfo ByteString) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC ByteString -> Either FileInfo ByteString
forall a b. b -> Either a b
Right
                FTSymbolicLink ByteString
_ -> Either FileInfo ByteString
-> ConduitM FilePath (Either FileInfo ByteString) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (FileInfo -> Either FileInfo ByteString
forall a b. a -> Either a b
Left FileInfo
fi)
                FileType
FTDirectory -> do
                    Either FileInfo ByteString
-> ConduitM FilePath (Either FileInfo ByteString) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (FileInfo -> Either FileInfo ByteString
forall a b. a -> Either a b
Left FileInfo
fi)
                    FilePath -> ConduitT FilePath FilePath m ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i FilePath m ()
sourceDirectory (FileInfo -> FilePath
getFileInfoPath FileInfo
fi) ConduitT FilePath FilePath m ()
-> ConduitM FilePath (Either FileInfo ByteString) m ()
-> ConduitM FilePath (Either FileInfo ByteString) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM FilePath (Either FileInfo ByteString) m ()
forall (m :: * -> *).
(MonadThrow m, MonadResource m) =>
ConduitM FilePath (Either FileInfo ByteString) m ()
filePathConduit
                FileType
fty -> do
                    FilePath -> ConduitM FilePath (Either FileInfo ByteString) m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover FilePath
fp
                    TarCreateException
-> ConduitM FilePath (Either FileInfo ByteString) m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (TarCreateException
 -> ConduitM FilePath (Either FileInfo ByteString) m ())
-> TarCreateException
-> ConduitM FilePath (Either FileInfo ByteString) m ()
forall a b. (a -> b) -> a -> b
$
                        FilePath -> TarCreateException
TarCreationError (FilePath -> TarCreateException) -> FilePath -> TarCreateException
forall a b. (a -> b) -> a -> b
$
                        FilePath
"<filePathConduit>: Unsupported file type: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                        FileType -> FilePath
forall a. Show a => a -> FilePath
show FileType
fty FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" for file: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FileInfo -> FilePath
getFileInfoPath FileInfo
fi
            ConduitM FilePath (Either FileInfo ByteString) m ()
forall (m :: * -> *).
(MonadThrow m, MonadResource m) =>
ConduitM FilePath (Either FileInfo ByteString) m ()
filePathConduit
        Maybe FilePath
Nothing -> () -> ConduitM FilePath (Either FileInfo ByteString) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- | Recursively tar all of the files and directories. There will be no
-- conversion between relative and absolute paths, so just like with GNU @tar@
-- cli tool, it may be necessary to `setCurrentDirectory` in order to get the
-- paths relative. Using `filePathConduit` directly, while modifying the
-- `filePath`, would be another approach to handling the file paths.
--
-- @since 0.2.0
tarFilePath :: (MonadThrow m, MonadResource m) => ConduitM FilePath ByteString m FileOffset
tarFilePath :: ConduitM FilePath ByteString m FileOffset
tarFilePath = ConduitM FilePath (Either FileInfo ByteString) m ()
forall (m :: * -> *).
(MonadThrow m, MonadResource m) =>
ConduitM FilePath (Either FileInfo ByteString) m ()
filePathConduit ConduitM FilePath (Either FileInfo ByteString) m ()
-> ConduitM (Either FileInfo ByteString) ByteString m FileOffset
-> ConduitM FilePath ByteString m FileOffset
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (Either FileInfo ByteString) ByteString m FileOffset
forall (m :: * -> *).
MonadThrow m =>
ConduitM (Either FileInfo ByteString) ByteString m FileOffset
tar


-- | Uses `tarFilePath` to create a tarball, that will recursively include the
-- supplied list of all the files and directories
--
-- @since 0.2.0
createTarball :: FilePath -- ^ File name for the tarball
              -> [FilePath] -- ^ List of files and directories to include in the tarball
              -> IO ()
createTarball :: FilePath -> [FilePath] -> IO ()
createTarball FilePath
tarfp [FilePath]
dirs =
    ConduitT () Void (ResourceT IO) () -> IO ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (ConduitT () Void (ResourceT IO) () -> IO ())
-> ConduitT () Void (ResourceT IO) () -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> ConduitT () (Element [FilePath]) (ResourceT IO) ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany [FilePath]
dirs ConduitT () FilePath (ResourceT IO) ()
-> ConduitM FilePath Void (ResourceT IO) ()
-> ConduitT () Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT FilePath ByteString (ResourceT IO) FileOffset
-> ConduitT FilePath ByteString (ResourceT IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ConduitT FilePath ByteString (ResourceT IO) FileOffset
forall (m :: * -> *).
(MonadThrow m, MonadResource m) =>
ConduitM FilePath ByteString m FileOffset
tarFilePath ConduitT FilePath ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitM FilePath Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| FilePath -> ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) o.
MonadResource m =>
FilePath -> ConduitT ByteString o m ()
sinkFile FilePath
tarfp

-- | Take a list of files and paths, recursively tar them and write output into supplied handle.
--
-- @since 0.2.0
writeTarball :: Handle -- ^ Handle where created tarball will be written to
             -> [FilePath] -- ^ List of files and directories to include in the tarball
             -> IO ()
writeTarball :: Handle -> [FilePath] -> IO ()
writeTarball Handle
tarHandle [FilePath]
dirs =
    ConduitT () Void (ResourceT IO) () -> IO ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (ConduitT () Void (ResourceT IO) () -> IO ())
-> ConduitT () Void (ResourceT IO) () -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> ConduitT () (Element [FilePath]) (ResourceT IO) ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany [FilePath]
dirs ConduitT () FilePath (ResourceT IO) ()
-> ConduitM FilePath Void (ResourceT IO) ()
-> ConduitT () Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT FilePath ByteString (ResourceT IO) FileOffset
-> ConduitT FilePath ByteString (ResourceT IO) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ConduitT FilePath ByteString (ResourceT IO) FileOffset
forall (m :: * -> *).
(MonadThrow m, MonadResource m) =>
ConduitM FilePath ByteString m FileOffset
tarFilePath ConduitT FilePath ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitM FilePath Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Handle -> ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) o.
MonadIO m =>
Handle -> ConduitT ByteString o m ()
sinkHandle Handle
tarHandle


-- always use forward slash, see
-- https://github.com/snoyberg/tar-conduit/issues/21
pathSeparatorS :: ByteString
pathSeparatorS :: ByteString
pathSeparatorS = ByteString
"/" -- S8.singleton pathSeparator


fileInfoFromHeader :: Header -> FileInfo
fileInfoFromHeader :: Header -> FileInfo
fileInfoFromHeader header :: Header
header@Header {Word8
DeviceID
CMode
FileOffset
GroupID
UserID
EpochTime
ShortByteString
headerFileNamePrefix :: ShortByteString
headerDeviceMinor :: DeviceID
headerDeviceMajor :: DeviceID
headerGroupName :: ShortByteString
headerOwnerName :: ShortByteString
headerMagicVersion :: ShortByteString
headerLinkName :: ShortByteString
headerLinkIndicator :: Word8
headerTime :: EpochTime
headerPayloadSize :: FileOffset
headerGroupId :: GroupID
headerOwnerId :: UserID
headerFileMode :: CMode
headerFileNameSuffix :: ShortByteString
headerPayloadOffset :: FileOffset
headerOffset :: FileOffset
headerFileNamePrefix :: Header -> ShortByteString
headerDeviceMinor :: Header -> DeviceID
headerDeviceMajor :: Header -> DeviceID
headerGroupName :: Header -> ShortByteString
headerOwnerName :: Header -> ShortByteString
headerMagicVersion :: Header -> ShortByteString
headerLinkName :: Header -> ShortByteString
headerLinkIndicator :: Header -> Word8
headerTime :: Header -> EpochTime
headerPayloadSize :: Header -> FileOffset
headerGroupId :: Header -> GroupID
headerOwnerId :: Header -> UserID
headerFileMode :: Header -> CMode
headerFileNameSuffix :: Header -> ShortByteString
headerPayloadOffset :: Header -> FileOffset
headerOffset :: Header -> FileOffset
..} =
    FileInfo :: ByteString
-> UserID
-> ByteString
-> GroupID
-> ByteString
-> CMode
-> FileOffset
-> FileType
-> EpochTime
-> FileInfo
FileInfo
    { filePath :: ByteString
filePath = Header -> ByteString
headerFilePathBS Header
header
    , fileUserId :: UserID
fileUserId = UserID
headerOwnerId
    , fileUserName :: ByteString
fileUserName = ShortByteString -> ByteString
fromShort ShortByteString
headerOwnerName
    , fileGroupId :: GroupID
fileGroupId = GroupID
headerGroupId
    , fileGroupName :: ByteString
fileGroupName = ShortByteString -> ByteString
fromShort ShortByteString
headerGroupName
    , fileMode :: CMode
fileMode = CMode
headerFileMode
    , fileSize :: FileOffset
fileSize = FileOffset
headerPayloadSize
    , fileType :: FileType
fileType = Header -> FileType
headerFileType Header
header
    , fileModTime :: EpochTime
fileModTime = EpochTime
headerTime
    }


-- | Extract a tarball while using `restoreFileInfo` for writing files onto the file
-- system. Restoration process is cross platform and should work concistently both on Windows and
-- Posix systems.
--
-- @since 0.2.0
extractTarball :: FilePath -- ^ Filename for the tarball
               -> Maybe FilePath -- ^ Folder where tarball should be extract
                                 -- to. Default is the current path
               -> IO ()
extractTarball :: FilePath -> Maybe FilePath -> IO ()
extractTarball FilePath
tarfp Maybe FilePath
mcd = do
    FilePath
cd <- IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO FilePath
getCurrentDirectory FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
mcd
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
cd
    ConduitT () Void (ResourceT IO) () -> IO ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (ConduitT () Void (ResourceT IO) () -> IO ())
-> ConduitT () Void (ResourceT IO) () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
sourceFileBS FilePath
tarfp ConduitT () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitT () Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (FileInfo -> ConduitM ByteString (IO ()) (ResourceT IO) ())
-> ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) c.
(MonadThrow m, MonadIO m) =>
(FileInfo -> ConduitM ByteString (IO ()) m ())
-> ConduitM ByteString c m ()
untarWithFinalizers (FilePath
-> FileInfo -> ConduitM ByteString (IO ()) (ResourceT IO) ()
forall (m :: * -> *).
MonadResource m =>
FilePath -> FileInfo -> ConduitM ByteString (IO ()) m ()
restoreFileInto FilePath
cd)


prependDirectory :: FilePath -> FileInfo -> FileInfo
prependDirectory :: FilePath -> FileInfo -> FileInfo
prependDirectory FilePath
cd FileInfo
fi = FileInfo
fi {filePath :: ByteString
filePath = FilePath -> ByteString
prependDir (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FileInfo -> FilePath
getFileInfoPath FileInfo
fi,
                             fileType :: FileType
fileType = FileType -> FileType
prependDirIfNeeded (FileInfo -> FileType
fileType FileInfo
fi)}
  where
    -- Hard links need to be interpreted based on `cd`, not just CWD, if relative,
    -- otherwise they may point to some invalid location.
    prependDirIfNeeded :: FileType -> FileType
prependDirIfNeeded (FTHardLink ByteString
p)
        | FilePath -> Bool
isRelative (FilePath -> Bool) -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
decodeFilePath ByteString
p = ByteString -> FileType
FTHardLink (FilePath -> ByteString
prependDir (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
decodeFilePath ByteString
p)
    prependDirIfNeeded FileType
other            = FileType
other
    prependDir :: FilePath -> ByteString
prependDir FilePath
p                        = FilePath -> ByteString
encodeFilePath (FilePath
cd FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
makeRelative FilePath
"/" FilePath
p)


-- | Restore all files into a folder. Absolute file paths will be turned into
-- relative to the supplied folder.
restoreFileInto :: MonadResource m =>
                   FilePath -> FileInfo -> ConduitM ByteString (IO ()) m ()
restoreFileInto :: FilePath -> FileInfo -> ConduitM ByteString (IO ()) m ()
restoreFileInto FilePath
cd = FileInfo -> ConduitM ByteString (IO ()) m ()
forall (m :: * -> *).
MonadResource m =>
FileInfo -> ConduitM ByteString (IO ()) m ()
restoreFile (FileInfo -> ConduitM ByteString (IO ()) m ())
-> (FileInfo -> FileInfo)
-> FileInfo
-> ConduitM ByteString (IO ()) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FileInfo -> FileInfo
prependDirectory FilePath
cd

-- | Restore all files into a folder. Absolute file paths will be turned into relative to the
-- supplied folder. Yields a list with exceptions instead of throwing them.
--
-- @since 0.2.5
restoreFileIntoLenient :: MonadResource m =>
    FilePath -> FileInfo -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileIntoLenient :: FilePath
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileIntoLenient FilePath
cd = Bool
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (m :: * -> *).
MonadResource m =>
Bool
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileWithErrors Bool
True (FileInfo
 -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
-> (FileInfo -> FileInfo)
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FileInfo -> FileInfo
prependDirectory FilePath
cd

-- | Same as `extractTarball`, but ignores possible extraction errors. It can still throw a
-- `TarException` if the tarball is corrupt or malformed.
--
-- @since 0.2.5
extractTarballLenient :: FilePath -- ^ Filename for the tarball
                   -> Maybe FilePath -- ^ Folder where tarball should be extract
                   -- to. Default is the current path
                   -> IO [(FileInfo, [SomeException])]
extractTarballLenient :: FilePath -> Maybe FilePath -> IO [(FileInfo, [SomeException])]
extractTarballLenient FilePath
tarfp Maybe FilePath
mcd = do
    FilePath
cd <- IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO FilePath
getCurrentDirectory FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
mcd
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
cd
    ConduitT () Void (ResourceT IO) [(FileInfo, [SomeException])]
-> IO [(FileInfo, [SomeException])]
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (ConduitT () Void (ResourceT IO) [(FileInfo, [SomeException])]
 -> IO [(FileInfo, [SomeException])])
-> ConduitT () Void (ResourceT IO) [(FileInfo, [SomeException])]
-> IO [(FileInfo, [SomeException])]
forall a b. (a -> b) -> a -> b
$
        FilePath -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
sourceFileBS FilePath
tarfp ConduitT () ByteString (ResourceT IO) ()
-> ConduitM
     ByteString Void (ResourceT IO) [(FileInfo, [SomeException])]
-> ConduitT () Void (ResourceT IO) [(FileInfo, [SomeException])]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (FileInfo
 -> ConduitM
      ByteString (IO (FileInfo, [SomeException])) (ResourceT IO) ())
-> ConduitM
     ByteString Void (ResourceT IO) [(FileInfo, [SomeException])]
forall (m :: * -> *) c.
(MonadThrow m, MonadIO m) =>
(FileInfo
 -> ConduitM ByteString (IO (FileInfo, [SomeException])) m ())
-> ConduitM ByteString c m [(FileInfo, [SomeException])]
untarWithExceptions (FilePath
-> FileInfo
-> ConduitM
     ByteString (IO (FileInfo, [SomeException])) (ResourceT IO) ()
forall (m :: * -> *).
MonadResource m =>
FilePath
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileIntoLenient FilePath
cd)



-- | Restore files onto the file system. Produces actions that will set the modification time on the
-- directories, which can be executed after the pipeline has finished and all files have been
-- written to disk.
restoreFile :: (MonadResource m) =>
               FileInfo -> ConduitM S8.ByteString (IO ()) m ()
restoreFile :: FileInfo -> ConduitM ByteString (IO ()) m ()
restoreFile FileInfo
fi = Bool
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (m :: * -> *).
MonadResource m =>
Bool
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileWithErrors Bool
False FileInfo
fi ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
-> ConduitM (IO (FileInfo, [SomeException])) (IO ()) m ()
-> ConduitM ByteString (IO ()) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (IO (FileInfo, [SomeException]) -> IO ())
-> ConduitM (IO (FileInfo, [SomeException])) (IO ()) m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC IO (FileInfo, [SomeException]) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void


-- | Restore files onto the file system, much in the same way `restoreFile` does it, except with
-- ability to ignore restoring problematic files and report errors that occured as a list of
-- exceptions, which will be returned as a list when finilizer executed. If a list is empty, it
-- means, that no errors occured and a file only had a finilizer associated with it.
--
-- @since 0.2.4
restoreFileWithErrors ::
       (MonadResource m)
    => Bool -- ^ Lenient flag, results in exceptions thrown instead of collected when set to @False@.
    -> FileInfo
    -> ConduitM S8.ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileWithErrors :: Bool
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileWithErrors = Bool
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
forall (m :: * -> *).
MonadResource m =>
Bool
-> FileInfo
-> ConduitM ByteString (IO (FileInfo, [SomeException])) m ()
restoreFileInternal