module Codec.Archive.Pack ( entriesToFile
                          , entriesToFileZip
                          , entriesToFile7Zip
                          , entriesToFileCpio
                          , entriesToFileXar
                          , entriesToBS
                          , entriesToBSzip
                          , entriesToBS7zip
                          , packEntries
                          , noFail
                          , packToFile
                          , packToFileZip
                          , packToFile7Zip
                          , packToFileCpio
                          , packToFileXar
                          ) where

import           Codec.Archive.Foreign
import           Codec.Archive.Monad
import           Codec.Archive.Pack.Common
import           Codec.Archive.Types
import           Control.Monad             (void)
import           Control.Monad.IO.Class    (MonadIO (..))
import           Data.ByteString           (packCStringLen)
import qualified Data.ByteString           as BS
import           Data.Coerce               (coerce)
import           Data.Foldable             (sequenceA_, traverse_)
import           Data.Semigroup            (Sum (..))
import           Foreign.C.String
import           Foreign.C.Types           (CLLong (..), CLong (..))
import           Foreign.Ptr               (Ptr)
import           System.IO.Unsafe          (unsafeDupablePerformIO)

maybeDo :: Applicative f => Maybe (f ()) -> f ()
maybeDo :: Maybe (f ()) -> f ()
maybeDo = Maybe (f ()) -> f ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_

contentAdd :: EntryContent -> Ptr Archive -> Ptr ArchiveEntry -> ArchiveM ()
contentAdd :: EntryContent -> Ptr Archive -> Ptr ArchiveEntry -> ArchiveM ()
contentAdd (NormalFile ByteString
contents) Ptr Archive
a Ptr ArchiveEntry
entry = do
    IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr ArchiveEntry -> Maybe FileType -> IO ()
archiveEntrySetFiletype Ptr ArchiveEntry
entry (FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
FtRegular)
    IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr ArchiveEntry -> LaInt64 -> IO ()
archiveEntrySetSize Ptr ArchiveEntry
entry (Int -> LaInt64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
contents))
    IO ArchiveResult -> ArchiveM ()
handle (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr ArchiveEntry -> IO ArchiveResult
archiveWriteHeader Ptr Archive
a Ptr ArchiveEntry
entry
    ByteString -> (CStringLen -> ArchiveM ()) -> ArchiveM ()
forall a b.
ByteString -> (CStringLen -> ExceptT a IO b) -> ExceptT a IO b
useAsCStringLenArchiveM ByteString
contents ((CStringLen -> ArchiveM ()) -> ArchiveM ())
-> (CStringLen -> ArchiveM ()) -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
buff, Int
sz) ->
        IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ IO LaInt64 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO LaInt64 -> IO ()) -> IO LaInt64 -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr CChar -> CSize -> IO LaInt64
forall a. Ptr Archive -> Ptr a -> CSize -> IO LaInt64
archiveWriteData Ptr Archive
a Ptr CChar
buff (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)
contentAdd EntryContent
Directory Ptr Archive
a Ptr ArchiveEntry
entry = do
    IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr ArchiveEntry -> Maybe FileType -> IO ()
archiveEntrySetFiletype Ptr ArchiveEntry
entry (FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
FtDirectory)
    IO ArchiveResult -> ArchiveM ()
handle (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr ArchiveEntry -> IO ArchiveResult
archiveWriteHeader Ptr Archive
a Ptr ArchiveEntry
entry
contentAdd (Symlink FilePath
fp Symlink
st) Ptr Archive
a Ptr ArchiveEntry
entry = do
    IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr ArchiveEntry -> Maybe FileType -> IO ()
archiveEntrySetFiletype Ptr ArchiveEntry
entry (FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
FtLink)
    IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr ArchiveEntry -> Symlink -> IO ()
archiveEntrySetSymlinkType Ptr ArchiveEntry
entry Symlink
st
    IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> (Ptr CChar -> IO ()) -> IO ()
forall a. FilePath -> (Ptr CChar -> IO a) -> IO a
withCString FilePath
fp ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
fpc ->
        Ptr ArchiveEntry -> Ptr CChar -> IO ()
archiveEntrySetSymlink Ptr ArchiveEntry
entry Ptr CChar
fpc
    IO ArchiveResult -> ArchiveM ()
handle (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr ArchiveEntry -> IO ArchiveResult
archiveWriteHeader Ptr Archive
a Ptr ArchiveEntry
entry
contentAdd (Hardlink FilePath
fp) Ptr Archive
a Ptr ArchiveEntry
entry = do
    IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr ArchiveEntry -> Maybe FileType -> IO ()
archiveEntrySetFiletype Ptr ArchiveEntry
entry Maybe FileType
forall a. Maybe a
Nothing
    IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> (Ptr CChar -> IO ()) -> IO ()
forall a. FilePath -> (Ptr CChar -> IO a) -> IO a
withCString FilePath
fp ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
fpc ->
        Ptr ArchiveEntry -> Ptr CChar -> IO ()
archiveEntrySetHardlink Ptr ArchiveEntry
entry Ptr CChar
fpc
    IO ArchiveResult -> ArchiveM ()
handle (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr ArchiveEntry -> IO ArchiveResult
archiveWriteHeader Ptr Archive
a Ptr ArchiveEntry
entry

withMaybeCString :: Maybe String -> (Maybe CString -> IO a) -> IO a
withMaybeCString :: Maybe FilePath -> (Maybe (Ptr CChar) -> IO a) -> IO a
withMaybeCString (Just FilePath
x) Maybe (Ptr CChar) -> IO a
f = FilePath -> (Ptr CChar -> IO a) -> IO a
forall a. FilePath -> (Ptr CChar -> IO a) -> IO a
withCString FilePath
x (Maybe (Ptr CChar) -> IO a
f (Maybe (Ptr CChar) -> IO a)
-> (Ptr CChar -> Maybe (Ptr CChar)) -> Ptr CChar -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CChar -> Maybe (Ptr CChar)
forall a. a -> Maybe a
Just)
withMaybeCString Maybe FilePath
Nothing Maybe (Ptr CChar) -> IO a
f  = Maybe (Ptr CChar) -> IO a
f Maybe (Ptr CChar)
forall a. Maybe a
Nothing

setOwnership :: Ownership -> Ptr ArchiveEntry -> IO ()
setOwnership :: Ownership -> Ptr ArchiveEntry -> IO ()
setOwnership (Ownership Maybe FilePath
uname Maybe FilePath
gname Id
uid Id
gid) Ptr ArchiveEntry
entry =
    Maybe FilePath -> (Maybe (Ptr CChar) -> IO ()) -> IO ()
forall a. Maybe FilePath -> (Maybe (Ptr CChar) -> IO a) -> IO a
withMaybeCString Maybe FilePath
uname ((Maybe (Ptr CChar) -> IO ()) -> IO ())
-> (Maybe (Ptr CChar) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Maybe (Ptr CChar)
unameC ->
    Maybe FilePath -> (Maybe (Ptr CChar) -> IO ()) -> IO ()
forall a. Maybe FilePath -> (Maybe (Ptr CChar) -> IO a) -> IO a
withMaybeCString Maybe FilePath
gname ((Maybe (Ptr CChar) -> IO ()) -> IO ())
-> (Maybe (Ptr CChar) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Maybe (Ptr CChar)
gnameC ->
    (Maybe (IO ()) -> IO ()) -> [Maybe (IO ())] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Maybe (IO ()) -> IO ()
forall (f :: * -> *). Applicative f => Maybe (f ()) -> f ()
maybeDo
        [ Ptr ArchiveEntry -> Ptr CChar -> IO ()
archiveEntrySetUname Ptr ArchiveEntry
entry (Ptr CChar -> IO ()) -> Maybe (Ptr CChar) -> Maybe (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Ptr CChar)
unameC
        , Ptr ArchiveEntry -> Ptr CChar -> IO ()
archiveEntrySetGname Ptr ArchiveEntry
entry (Ptr CChar -> IO ()) -> Maybe (Ptr CChar) -> Maybe (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Ptr CChar)
gnameC
        , IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (Ptr ArchiveEntry -> LaInt64 -> IO ()
archiveEntrySetUid Ptr ArchiveEntry
entry (Id -> LaInt64
coerce Id
uid))
        , IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (Ptr ArchiveEntry -> LaInt64 -> IO ()
archiveEntrySetGid Ptr ArchiveEntry
entry (Id -> LaInt64
coerce Id
gid))
        ]

setTime :: ModTime -> Ptr ArchiveEntry -> IO ()
setTime :: ModTime -> Ptr ArchiveEntry -> IO ()
setTime (CTime
time', LaInt64
nsec) Ptr ArchiveEntry
entry = Ptr ArchiveEntry -> CTime -> LaInt64 -> IO ()
archiveEntrySetMtime Ptr ArchiveEntry
entry CTime
time' LaInt64
nsec

packEntries :: (Foldable t) => Ptr Archive -> t Entry -> ArchiveM ()
packEntries :: Ptr Archive -> t Entry -> ArchiveM ()
packEntries Ptr Archive
a = (Entry -> ArchiveM ()) -> t Entry -> ArchiveM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Ptr Archive -> Entry -> ArchiveM ()
archiveEntryAdd Ptr Archive
a)

-- Get a number of bytes appropriate for creating the archive.
entriesSz :: (Foldable t, Integral a) => t Entry -> a
entriesSz :: t Entry -> a
entriesSz = Sum a -> a
forall a. Sum a -> a
getSum (Sum a -> a) -> (t Entry -> Sum a) -> t Entry -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entry -> Sum a) -> t Entry -> Sum a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> Sum a
forall a. a -> Sum a
Sum (a -> Sum a) -> (Entry -> a) -> Entry -> Sum a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> a
forall a. Integral a => Entry -> a
entrySz)
    where entrySz :: Entry -> a
entrySz Entry
e = a
512 a -> a -> a
forall a. Num a => a -> a -> a
+ a
512 a -> a -> a
forall a. Num a => a -> a -> a
* (EntryContent -> a
forall p. Num p => EntryContent -> p
contentSz (Entry -> EntryContent
content Entry
e) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
512 a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)
          contentSz :: EntryContent -> p
contentSz (NormalFile ByteString
str) = Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> p) -> Int -> p
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
str
          contentSz EntryContent
Directory        = p
0
          contentSz (Symlink FilePath
fp Symlink
_)   = p
1 p -> p -> p
forall a. Num a => a -> a -> a
+ Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
fp)
          contentSz (Hardlink FilePath
fp)    = Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> p) -> Int -> p
forall a b. (a -> b) -> a -> b
$ FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
fp --idk if this is right

-- | Returns a 'BS.ByteString' containing a tar archive with the 'Entry's
--
-- @since 1.0.0.0
entriesToBS :: Foldable t => t Entry -> BS.ByteString
entriesToBS :: t Entry -> ByteString
entriesToBS = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> (t Entry -> IO ByteString) -> t Entry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveM ByteString -> IO ByteString
forall a. ArchiveM a -> IO a
noFail (ArchiveM ByteString -> IO ByteString)
-> (t Entry -> ArchiveM ByteString) -> t Entry -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM ByteString
forall (t :: * -> *).
Foldable t =>
(Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM ByteString
entriesToBSGeneral Ptr Archive -> IO ArchiveResult
archiveWriteSetFormatPaxRestricted
{-# NOINLINE entriesToBS #-}

-- | Returns a 'BS.ByteString' containing a @.7z@ archive with the 'Entry's
--
-- @since 1.0.0.0
entriesToBS7zip :: Foldable t => t Entry -> BS.ByteString
entriesToBS7zip :: t Entry -> ByteString
entriesToBS7zip = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> (t Entry -> IO ByteString) -> t Entry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveM ByteString -> IO ByteString
forall a. ArchiveM a -> IO a
noFail (ArchiveM ByteString -> IO ByteString)
-> (t Entry -> ArchiveM ByteString) -> t Entry -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM ByteString
forall (t :: * -> *).
Foldable t =>
(Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM ByteString
entriesToBSGeneral Ptr Archive -> IO ArchiveResult
archiveWriteSetFormat7zip
{-# NOINLINE entriesToBS7zip #-}

-- | Returns a 'BS.ByteString' containing a zip archive with the 'Entry's
--
-- @since 1.0.0.0
entriesToBSzip :: Foldable t => t Entry -> BS.ByteString
entriesToBSzip :: t Entry -> ByteString
entriesToBSzip = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> (t Entry -> IO ByteString) -> t Entry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveM ByteString -> IO ByteString
forall a. ArchiveM a -> IO a
noFail (ArchiveM ByteString -> IO ByteString)
-> (t Entry -> ArchiveM ByteString) -> t Entry -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM ByteString
forall (t :: * -> *).
Foldable t =>
(Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM ByteString
entriesToBSGeneral Ptr Archive -> IO ArchiveResult
archiveWriteSetFormatZip
{-# NOINLINE entriesToBSzip #-}

-- This is for things we don't think will fail. When making a 'BS.ByteString'
-- from a bunch of 'Entry's, for instance, we don't anticipate any errors
noFail :: ArchiveM a -> IO a
noFail :: ArchiveM a -> IO a
noFail ArchiveM a
act = do
    Either ArchiveResult a
res <- ArchiveM a -> IO (Either ArchiveResult a)
forall a. ArchiveM a -> IO (Either ArchiveResult a)
runArchiveM ArchiveM a
act
    case Either ArchiveResult a
res of
        Right a
x -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
        Left ArchiveResult
_  -> FilePath -> IO a
forall a. HasCallStack => FilePath -> a
error FilePath
"Should not fail."

-- | Internal function to be used with 'archive_write_set_format_pax' etc.
entriesToBSGeneral :: (Foldable t) => (Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM BS.ByteString
entriesToBSGeneral :: (Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM ByteString
entriesToBSGeneral Ptr Archive -> IO ArchiveResult
modifier t Entry
hsEntries' = do
    Ptr Archive
a <- IO (Ptr Archive) -> ExceptT ArchiveResult IO (Ptr Archive)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Ptr Archive)
archiveWriteNew
    IO ArchiveResult -> ArchiveM ()
ignore (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO ArchiveResult
modifier Ptr Archive
a
    Int -> (Ptr CChar -> ArchiveM ByteString) -> ArchiveM ByteString
forall a b c. Int -> (Ptr a -> ExceptT b IO c) -> ExceptT b IO c
allocaBytesArchiveM Int
forall a. Integral a => a
bufSize ((Ptr CChar -> ArchiveM ByteString) -> ArchiveM ByteString)
-> (Ptr CChar -> ArchiveM ByteString) -> ArchiveM ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buffer -> do
        (ArchiveResult
err, CSize
usedSz) <- IO (ArchiveResult, CSize)
-> ExceptT ArchiveResult IO (ArchiveResult, CSize)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ArchiveResult, CSize)
 -> ExceptT ArchiveResult IO (ArchiveResult, CSize))
-> IO (ArchiveResult, CSize)
-> ExceptT ArchiveResult IO (ArchiveResult, CSize)
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr CChar -> CSize -> IO (ArchiveResult, CSize)
forall a.
Ptr Archive -> Ptr a -> CSize -> IO (ArchiveResult, CSize)
archiveWriteOpenMemory Ptr Archive
a Ptr CChar
buffer CSize
forall a. Integral a => a
bufSize
        IO ArchiveResult -> ArchiveM ()
handle (ArchiveResult -> IO ArchiveResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ArchiveResult
err)
        Ptr Archive -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
Ptr Archive -> t Entry -> ArchiveM ()
packEntries Ptr Archive
a t Entry
hsEntries'
        IO ArchiveResult -> ArchiveM ()
handle (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO ArchiveResult
archiveWriteClose Ptr Archive
a
        ByteString
res <- IO ByteString -> ArchiveM ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ArchiveM ByteString)
-> IO ByteString -> ArchiveM ByteString
forall a b. (a -> b) -> a -> b
$ (CStringLen -> IO ByteString) -> Ptr CChar -> Int -> IO ByteString
forall a b c. ((a, b) -> c) -> a -> b -> c
curry CStringLen -> IO ByteString
packCStringLen Ptr CChar
buffer (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
usedSz)
        IO ArchiveResult -> ArchiveM ()
ignore (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO ArchiveResult
archiveFree Ptr Archive
a
        ByteString -> ArchiveM ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
res

    where bufSize :: Integral a => a
          bufSize :: a
bufSize = t Entry -> a
forall (t :: * -> *) a. (Foldable t, Integral a) => t Entry -> a
entriesSz t Entry
hsEntries'

filePacker :: (Traversable t) => (FilePath -> t Entry -> ArchiveM ()) -> FilePath -> t FilePath -> ArchiveM ()
filePacker :: (FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
filePacker FilePath -> t Entry -> ArchiveM ()
f FilePath
tar t FilePath
fps = FilePath -> t Entry -> ArchiveM ()
f FilePath
tar (t Entry -> ArchiveM ())
-> ExceptT ArchiveResult IO (t Entry) -> ArchiveM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (t Entry) -> ExceptT ArchiveResult IO (t Entry)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((FilePath -> IO Entry) -> t FilePath -> IO (t Entry)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO Entry
mkEntry t FilePath
fps)

-- | @since 2.0.0.0
packToFile :: Traversable t
           => FilePath -- ^ @.tar@ archive to be created
           -> t FilePath -- ^ Files to include
           -> ArchiveM ()
packToFile :: FilePath -> t FilePath -> ArchiveM ()
packToFile = (FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
forall (t :: * -> *).
Traversable t =>
(FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
filePacker FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
FilePath -> t Entry -> ArchiveM ()
entriesToFile

-- | @since 2.0.0.0
packToFileZip :: Traversable t
              => FilePath
              -> t FilePath
              -> ArchiveM ()
packToFileZip :: FilePath -> t FilePath -> ArchiveM ()
packToFileZip = (FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
forall (t :: * -> *).
Traversable t =>
(FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
filePacker FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
FilePath -> t Entry -> ArchiveM ()
entriesToFileZip

-- | @since 2.0.0.0
packToFile7Zip :: Traversable t
               => FilePath
               -> t FilePath
               -> ArchiveM ()
packToFile7Zip :: FilePath -> t FilePath -> ArchiveM ()
packToFile7Zip = (FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
forall (t :: * -> *).
Traversable t =>
(FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
filePacker FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
FilePath -> t Entry -> ArchiveM ()
entriesToFile7Zip

-- | @since 2.2.3.0
packToFileCpio :: Traversable t
               => FilePath
               -> t FilePath
               -> ArchiveM ()
packToFileCpio :: FilePath -> t FilePath -> ArchiveM ()
packToFileCpio = (FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
forall (t :: * -> *).
Traversable t =>
(FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
filePacker FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
FilePath -> t Entry -> ArchiveM ()
entriesToFileCpio

-- | @since 2.2.4.0
packToFileXar :: Traversable t
              => FilePath
              -> t FilePath
              -> ArchiveM ()
packToFileXar :: FilePath -> t FilePath -> ArchiveM ()
packToFileXar = (FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
forall (t :: * -> *).
Traversable t =>
(FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
filePacker FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
FilePath -> t Entry -> ArchiveM ()
entriesToFileXar

-- | Write some entries to a file, creating a tar archive. This is more
-- efficient than
--
-- @
-- BS.writeFile "file.tar" (entriesToBS entries)
-- @
--
-- @since 1.0.0.0
entriesToFile :: Foldable t => FilePath -> t Entry -> ArchiveM ()
entriesToFile :: FilePath -> t Entry -> ArchiveM ()
entriesToFile = (Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
(Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
entriesToFileGeneral Ptr Archive -> IO ArchiveResult
archiveWriteSetFormatPaxRestricted
-- this is the recommended format; it is a tar archive

-- | Write some entries to a file, creating a zip archive.
--
-- @since 1.0.0.0
entriesToFileZip :: Foldable t => FilePath -> t Entry -> ArchiveM ()
entriesToFileZip :: FilePath -> t Entry -> ArchiveM ()
entriesToFileZip = (Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
(Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
entriesToFileGeneral Ptr Archive -> IO ArchiveResult
archiveWriteSetFormatZip

-- | Write some entries to a file, creating a @.7z@ archive.
--
-- @since 1.0.0.0
entriesToFile7Zip :: Foldable t => FilePath -> t Entry -> ArchiveM ()
entriesToFile7Zip :: FilePath -> t Entry -> ArchiveM ()
entriesToFile7Zip = (Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
(Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
entriesToFileGeneral Ptr Archive -> IO ArchiveResult
archiveWriteSetFormat7zip

-- | Write some entries to a file, creating a @.cpio@ archive.
--
-- @since 2.2.3.0
entriesToFileCpio :: Foldable t => FilePath -> t Entry -> ArchiveM ()
entriesToFileCpio :: FilePath -> t Entry -> ArchiveM ()
entriesToFileCpio = (Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
(Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
entriesToFileGeneral Ptr Archive -> IO ArchiveResult
archiveWriteSetFormatCpio

-- | Write some entries to a file, creating a @.xar@ archive.
--
-- @since 2.2.4.0
entriesToFileXar :: Foldable t => FilePath -> t Entry -> ArchiveM ()
entriesToFileXar :: FilePath -> t Entry -> ArchiveM ()
entriesToFileXar = (Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
(Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
entriesToFileGeneral Ptr Archive -> IO ArchiveResult
archiveWriteSetFormatXar

entriesToFileGeneral :: Foldable t => (Ptr Archive -> IO ArchiveResult) -> FilePath -> t Entry -> ArchiveM ()
entriesToFileGeneral :: (Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
entriesToFileGeneral Ptr Archive -> IO ArchiveResult
modifier FilePath
fp t Entry
hsEntries' =
    IO (Ptr Archive)
-> (Ptr Archive -> IO ArchiveResult)
-> (Ptr Archive -> ArchiveM ())
-> ArchiveM ()
forall a b c.
IO a -> (a -> IO b) -> (a -> ArchiveM c) -> ArchiveM c
bracketM
        IO (Ptr Archive)
archiveWriteNew
        Ptr Archive -> IO ArchiveResult
archiveFree
        (\Ptr Archive
a -> do
            IO ArchiveResult -> ArchiveM ()
ignore (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO ArchiveResult
modifier Ptr Archive
a
            FilePath -> (Ptr CChar -> ArchiveM ()) -> ArchiveM ()
forall a b.
FilePath -> (Ptr CChar -> ExceptT a IO b) -> ExceptT a IO b
withCStringArchiveM FilePath
fp ((Ptr CChar -> ArchiveM ()) -> ArchiveM ())
-> (Ptr CChar -> ArchiveM ()) -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
fpc ->
                IO ArchiveResult -> ArchiveM ()
handle (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr CChar -> IO ArchiveResult
archiveWriteOpenFilename Ptr Archive
a Ptr CChar
fpc
            Ptr Archive -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
Ptr Archive -> t Entry -> ArchiveM ()
packEntries Ptr Archive
a t Entry
hsEntries')

withArchiveEntry :: (Ptr ArchiveEntry -> ArchiveM a) -> ArchiveM a
withArchiveEntry :: (Ptr ArchiveEntry -> ArchiveM a) -> ArchiveM a
withArchiveEntry =
    IO (Ptr ArchiveEntry)
-> (Ptr ArchiveEntry -> IO ())
-> (Ptr ArchiveEntry -> ArchiveM a)
-> ArchiveM a
forall a b c.
IO a -> (a -> IO b) -> (a -> ArchiveM c) -> ArchiveM c
bracketM
        IO (Ptr ArchiveEntry)
archiveEntryNew
        Ptr ArchiveEntry -> IO ()
archiveEntryFree

archiveEntryAdd :: Ptr Archive -> Entry -> ArchiveM ()
archiveEntryAdd :: Ptr Archive -> Entry -> ArchiveM ()
archiveEntryAdd Ptr Archive
a (Entry FilePath
fp EntryContent
contents Permissions
perms Ownership
owner Maybe ModTime
mtime) =
    (Ptr ArchiveEntry -> ArchiveM ()) -> ArchiveM ()
forall a. (Ptr ArchiveEntry -> ArchiveM a) -> ArchiveM a
withArchiveEntry ((Ptr ArchiveEntry -> ArchiveM ()) -> ArchiveM ())
-> (Ptr ArchiveEntry -> ArchiveM ()) -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ \Ptr ArchiveEntry
entry -> do
        IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> (Ptr CChar -> IO ()) -> IO ()
forall a. FilePath -> (Ptr CChar -> IO a) -> IO a
withCString FilePath
fp ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
fpc ->
            Ptr ArchiveEntry -> Ptr CChar -> IO ()
archiveEntrySetPathname Ptr ArchiveEntry
entry Ptr CChar
fpc
        IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr ArchiveEntry -> Permissions -> IO ()
archiveEntrySetPerm Ptr ArchiveEntry
entry Permissions
perms
        IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ownership -> Ptr ArchiveEntry -> IO ()
setOwnership Ownership
owner Ptr ArchiveEntry
entry
        IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Maybe (IO ()) -> IO ()
forall (f :: * -> *). Applicative f => Maybe (f ()) -> f ()
maybeDo (ModTime -> Ptr ArchiveEntry -> IO ()
setTime (ModTime -> Ptr ArchiveEntry -> IO ())
-> Maybe ModTime -> Maybe (Ptr ArchiveEntry -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModTime
mtime Maybe (Ptr ArchiveEntry -> IO ())
-> Maybe (Ptr ArchiveEntry) -> Maybe (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArchiveEntry -> Maybe (Ptr ArchiveEntry)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr ArchiveEntry
entry)
        EntryContent -> Ptr Archive -> Ptr ArchiveEntry -> ArchiveM ()
contentAdd EntryContent
contents Ptr Archive
a Ptr ArchiveEntry
entry