module Codec.Archive.Internal.Pack ( entriesToFile
                                   , entriesToFileZip
                                   , entriesToFile7Zip
                                   , entriesToFileCpio
                                   , entriesToFileXar
                                   , entriesToFileShar
                                   , entriesToFileGeneral
                                   , entriesToBS
                                   , entriesToBSGeneral
                                   , entriesToBSzip
                                   , entriesToBS7zip
                                   , filePacker
                                   , packEntries
                                   , noFail
                                   , packToFile
                                   , packToFileZip
                                   , packToFile7Zip
                                   , packToFileCpio
                                   , packToFileXar
                                   , packToFileShar
                                   , archiveEntryAdd
                                   , contentAdd
                                   ) where

import           Codec.Archive.Foreign
import           Codec.Archive.Internal.Monad
import           Codec.Archive.Internal.Pack.Common
import           Codec.Archive.Types
import           Control.Monad                      (forM_, void)
import           Control.Monad.IO.Class             (MonadIO (..))
import           Data.ByteString                    (packCStringLen)
import qualified Data.ByteString                    as BS
import qualified Data.ByteString.Lazy               as BSL
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.Concurrent                 (newForeignPtr)
import           Foreign.ForeignPtr                 (castForeignPtr)
import           Foreign.Ptr                        (castPtr)
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_

-- archive_error_string
contentAdd :: EntryContent FilePath BS.ByteString -> ArchivePtr -> ArchiveEntryPtr -> ArchiveM ()
contentAdd :: EntryContent FilePath ByteString
-> ArchivePtr -> ArchiveEntryPtr -> ArchiveM ()
contentAdd (NormalFile ByteString
contents) ArchivePtr
a ArchiveEntryPtr
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
$ ArchiveEntryPtr -> Maybe FileType -> IO ()
archiveEntrySetFiletype ArchiveEntryPtr
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
$ ArchiveEntryPtr -> LaInt64 -> IO ()
archiveEntrySetSize ArchiveEntryPtr
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
$ ArchivePtr -> ArchiveEntryPtr -> IO ArchiveResult
archiveWriteHeader ArchivePtr
a ArchiveEntryPtr
entry
    -- forM_ (BSL.toChunks contents) $ \b ->
    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
$ ArchivePtr -> Ptr CChar -> CSize -> IO LaInt64
forall a. ArchivePtr -> Ptr a -> CSize -> IO LaInt64
archiveWriteData ArchivePtr
a Ptr CChar
buff (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)
contentAdd EntryContent FilePath ByteString
Directory ArchivePtr
a ArchiveEntryPtr
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
$ ArchiveEntryPtr -> Maybe FileType -> IO ()
archiveEntrySetFiletype ArchiveEntryPtr
entry (FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
FtDirectory)
    IO ArchiveResult -> ArchiveM ()
lenient (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ ArchivePtr -> ArchiveEntryPtr -> IO ArchiveResult
archiveWriteHeader ArchivePtr
a ArchiveEntryPtr
entry
    IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ ArchivePtr -> IO ()
archiveClearError ArchivePtr
a
contentAdd (Symlink FilePath
fp Symlink
st) ArchivePtr
a ArchiveEntryPtr
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
$ ArchiveEntryPtr -> Maybe FileType -> IO ()
archiveEntrySetFiletype ArchiveEntryPtr
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
$ ArchiveEntryPtr -> Symlink -> IO ()
archiveEntrySetSymlinkType ArchiveEntryPtr
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 ->
        ArchiveEntryPtr -> Ptr CChar -> IO ()
archiveEntrySetSymlink ArchiveEntryPtr
entry Ptr CChar
fpc
    IO ArchiveResult -> ArchiveM ()
lenient (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ ArchivePtr -> ArchiveEntryPtr -> IO ArchiveResult
archiveWriteHeader ArchivePtr
a ArchiveEntryPtr
entry
    IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ ArchivePtr -> IO ()
archiveClearError ArchivePtr
a
contentAdd (Hardlink FilePath
fp) ArchivePtr
a ArchiveEntryPtr
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
$ ArchiveEntryPtr -> Maybe FileType -> IO ()
archiveEntrySetFiletype ArchiveEntryPtr
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 ->
        ArchiveEntryPtr -> Ptr CChar -> IO ()
archiveEntrySetHardlink ArchiveEntryPtr
entry Ptr CChar
fpc
    IO ArchiveResult -> ArchiveM ()
lenient (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ ArchivePtr -> ArchiveEntryPtr -> IO ArchiveResult
archiveWriteHeader ArchivePtr
a ArchiveEntryPtr
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 -> ArchiveEntryPtr -> IO ()
setOwnership :: Ownership -> ArchiveEntryPtr -> IO ()
setOwnership (Ownership Maybe FilePath
uname Maybe FilePath
gname Id
uid Id
gid) ArchiveEntryPtr
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
        [ ArchiveEntryPtr -> Ptr CChar -> IO ()
archiveEntrySetUname ArchiveEntryPtr
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
        , ArchiveEntryPtr -> Ptr CChar -> IO ()
archiveEntrySetGname ArchiveEntryPtr
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 (ArchiveEntryPtr -> LaInt64 -> IO ()
archiveEntrySetUid ArchiveEntryPtr
entry (Id -> LaInt64
coerce Id
uid))
        , IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (ArchiveEntryPtr -> LaInt64 -> IO ()
archiveEntrySetGid ArchiveEntryPtr
entry (Id -> LaInt64
coerce Id
gid))
        ]

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

packEntries :: (Foldable t) => ArchivePtr -> t (Entry FilePath BS.ByteString) -> ArchiveM ()
packEntries :: ArchivePtr -> t (Entry FilePath ByteString) -> ArchiveM ()
packEntries ArchivePtr
a = (Entry FilePath ByteString -> ArchiveM ())
-> t (Entry FilePath ByteString) -> ArchiveM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ArchivePtr -> Entry FilePath ByteString -> ArchiveM ()
archiveEntryAdd ArchivePtr
a)

-- Get a number of bytes appropriate for creating the archive.
entriesSz :: (Foldable t, Integral a) => t (Entry FilePath BS.ByteString) -> a
entriesSz :: t (Entry FilePath ByteString) -> a
entriesSz = Sum a -> a
forall a. Sum a -> a
getSum (Sum a -> a)
-> (t (Entry FilePath ByteString) -> Sum a)
-> t (Entry FilePath ByteString)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entry FilePath ByteString -> Sum a)
-> t (Entry FilePath ByteString) -> 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 FilePath ByteString -> a)
-> Entry FilePath ByteString
-> Sum a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry FilePath ByteString -> a
forall a (t :: * -> *) a.
(Integral a, Foldable t) =>
Entry (t a) ByteString -> a
entrySz)
    where entrySz :: Entry (t a) ByteString -> a
entrySz Entry (t a) ByteString
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 (t a) ByteString -> a
forall p (t :: * -> *) a.
(Num p, Foldable t) =>
EntryContent (t a) ByteString -> p
contentSz (Entry (t a) ByteString -> EntryContent (t a) ByteString
forall fp e. Entry fp e -> EntryContent fp e
content Entry (t a) ByteString
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 (t a) ByteString -> 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 (t a) ByteString
Directory        = p
0
          contentSz (Symlink t a
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 (t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
fp)
          contentSz (Hardlink t a
fp)    = Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> p) -> Int -> p
forall a b. (a -> b) -> a -> b
$ t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
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 FilePath BS.ByteString) -> BS.ByteString
entriesToBS :: t (Entry FilePath ByteString) -> ByteString
entriesToBS = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> (t (Entry FilePath ByteString) -> IO ByteString)
-> t (Entry FilePath ByteString)
-> 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 FilePath ByteString) -> ArchiveM ByteString)
-> t (Entry FilePath ByteString)
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ArchivePtr -> IO ArchiveResult)
-> t (Entry FilePath ByteString) -> ArchiveM ByteString
forall (t :: * -> *).
Foldable t =>
(ArchivePtr -> IO ArchiveResult)
-> t (Entry FilePath ByteString) -> ArchiveM ByteString
entriesToBSGeneral ArchivePtr -> 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 FilePath BS.ByteString) -> BS.ByteString
entriesToBS7zip :: t (Entry FilePath ByteString) -> ByteString
entriesToBS7zip = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> (t (Entry FilePath ByteString) -> IO ByteString)
-> t (Entry FilePath ByteString)
-> 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 FilePath ByteString) -> ArchiveM ByteString)
-> t (Entry FilePath ByteString)
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ArchivePtr -> IO ArchiveResult)
-> t (Entry FilePath ByteString) -> ArchiveM ByteString
forall (t :: * -> *).
Foldable t =>
(ArchivePtr -> IO ArchiveResult)
-> t (Entry FilePath ByteString) -> ArchiveM ByteString
entriesToBSGeneral ArchivePtr -> 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 FilePath BS.ByteString) -> BS.ByteString
entriesToBSzip :: t (Entry FilePath ByteString) -> ByteString
entriesToBSzip = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> (t (Entry FilePath ByteString) -> IO ByteString)
-> t (Entry FilePath ByteString)
-> 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 FilePath ByteString) -> ArchiveM ByteString)
-> t (Entry FilePath ByteString)
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ArchivePtr -> IO ArchiveResult)
-> t (Entry FilePath ByteString) -> ArchiveM ByteString
forall (t :: * -> *).
Foldable t =>
(ArchivePtr -> IO ArchiveResult)
-> t (Entry FilePath ByteString) -> ArchiveM ByteString
entriesToBSGeneral ArchivePtr -> 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
        -- FIXME: ArchiveFailed is recoverable and whatnot
        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) => (ArchivePtr -> IO ArchiveResult) -> t (Entry FilePath BS.ByteString) -> ArchiveM BS.ByteString
entriesToBSGeneral :: (ArchivePtr -> IO ArchiveResult)
-> t (Entry FilePath ByteString) -> ArchiveM ByteString
entriesToBSGeneral ArchivePtr -> IO ArchiveResult
modifier t (Entry FilePath ByteString)
hsEntries' = do
    Ptr Archive
preA <- IO (Ptr Archive) -> ExceptT ArchiveResult IO (Ptr Archive)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Ptr Archive)
archiveWriteNew
    ArchivePtr
a <- IO ArchivePtr -> ExceptT ArchiveResult IO ArchivePtr
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ArchivePtr -> ExceptT ArchiveResult IO ArchivePtr)
-> IO ArchivePtr -> ExceptT ArchiveResult IO ArchivePtr
forall a b. (a -> b) -> a -> b
$ ForeignPtr Any -> ArchivePtr
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr (ForeignPtr Any -> ArchivePtr)
-> IO (ForeignPtr Any) -> IO ArchivePtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Any -> IO () -> IO (ForeignPtr Any)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr (Ptr Archive -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Archive
preA) (IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO CInt
archiveFree Ptr Archive
preA)
    IO ArchiveResult -> ArchiveM ()
ignore (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ ArchivePtr -> IO ArchiveResult
modifier ArchivePtr
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
$ ArchivePtr -> Ptr CChar -> CSize -> IO (ArchiveResult, CSize)
forall a. ArchivePtr -> Ptr a -> CSize -> IO (ArchiveResult, CSize)
archiveWriteOpenMemory ArchivePtr
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)
        ArchivePtr -> t (Entry FilePath ByteString) -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
ArchivePtr -> t (Entry FilePath ByteString) -> ArchiveM ()
packEntries ArchivePtr
a t (Entry FilePath ByteString)
hsEntries'
        IO ArchiveResult -> ArchiveM ()
handle (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ ArchivePtr -> IO ArchiveResult
archiveWriteClose ArchivePtr
a
        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)

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

filePacker :: (Traversable t) => (FilePath -> t (Entry FilePath BS.ByteString) -> ArchiveM ()) -> FilePath -> t FilePath -> ArchiveM ()
filePacker :: (FilePath -> t (Entry FilePath ByteString) -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
filePacker FilePath -> t (Entry FilePath ByteString) -> ArchiveM ()
f FilePath
tar t FilePath
fps = FilePath -> t (Entry FilePath ByteString) -> ArchiveM ()
f FilePath
tar (t (Entry FilePath ByteString) -> ArchiveM ())
-> ExceptT ArchiveResult IO (t (Entry FilePath ByteString))
-> ArchiveM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (t (Entry FilePath ByteString))
-> ExceptT ArchiveResult IO (t (Entry FilePath ByteString))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((FilePath -> IO (Entry FilePath ByteString))
-> t FilePath -> IO (t (Entry FilePath ByteString))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO (Entry FilePath ByteString)
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 FilePath ByteString) -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
forall (t :: * -> *).
Traversable t =>
(FilePath -> t (Entry FilePath ByteString) -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
filePacker FilePath -> t (Entry FilePath ByteString) -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
FilePath -> t (Entry FilePath ByteString) -> ArchiveM ()
entriesToFile

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

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

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

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

-- | @since 3.0.0.0
packToFileShar :: Traversable t
              => FilePath
              -> t FilePath
              -> ArchiveM ()
packToFileShar :: FilePath -> t FilePath -> ArchiveM ()
packToFileShar = (FilePath -> t (Entry FilePath ByteString) -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
forall (t :: * -> *).
Traversable t =>
(FilePath -> t (Entry FilePath ByteString) -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
filePacker FilePath -> t (Entry FilePath ByteString) -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
FilePath -> t (Entry FilePath ByteString) -> ArchiveM ()
entriesToFileShar

-- | 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 FilePath BS.ByteString) -> ArchiveM ()
entriesToFile :: FilePath -> t (Entry FilePath ByteString) -> ArchiveM ()
entriesToFile = (ArchivePtr -> IO ArchiveResult)
-> FilePath -> t (Entry FilePath ByteString) -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
(ArchivePtr -> IO ArchiveResult)
-> FilePath -> t (Entry FilePath ByteString) -> ArchiveM ()
entriesToFileGeneral ArchivePtr -> 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 FilePath BS.ByteString) -> ArchiveM ()
entriesToFileZip :: FilePath -> t (Entry FilePath ByteString) -> ArchiveM ()
entriesToFileZip = (ArchivePtr -> IO ArchiveResult)
-> FilePath -> t (Entry FilePath ByteString) -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
(ArchivePtr -> IO ArchiveResult)
-> FilePath -> t (Entry FilePath ByteString) -> ArchiveM ()
entriesToFileGeneral ArchivePtr -> IO ArchiveResult
archiveWriteSetFormatZip

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

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

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

-- | Write some entries to a file, creating a @.shar@ archive.
--
-- @since 3.0.0.0
entriesToFileShar :: Foldable t => FilePath -> t (Entry FilePath BS.ByteString) -> ArchiveM ()
entriesToFileShar :: FilePath -> t (Entry FilePath ByteString) -> ArchiveM ()
entriesToFileShar = (ArchivePtr -> IO ArchiveResult)
-> FilePath -> t (Entry FilePath ByteString) -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
(ArchivePtr -> IO ArchiveResult)
-> FilePath -> t (Entry FilePath ByteString) -> ArchiveM ()
entriesToFileGeneral ArchivePtr -> IO ArchiveResult
archiveWriteSetFormatShar

entriesToFileGeneral :: Foldable t => (ArchivePtr -> IO ArchiveResult) -> FilePath -> t (Entry FilePath BS.ByteString) -> ArchiveM ()
entriesToFileGeneral :: (ArchivePtr -> IO ArchiveResult)
-> FilePath -> t (Entry FilePath ByteString) -> ArchiveM ()
entriesToFileGeneral ArchivePtr -> IO ArchiveResult
modifier FilePath
fp t (Entry FilePath ByteString)
hsEntries' = do
    Ptr Archive
p <- IO (Ptr Archive) -> ExceptT ArchiveResult IO (Ptr Archive)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Ptr Archive)
archiveWriteNew
    ArchivePtr
fptr <- IO ArchivePtr -> ExceptT ArchiveResult IO ArchivePtr
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ArchivePtr -> ExceptT ArchiveResult IO ArchivePtr)
-> IO ArchivePtr -> ExceptT ArchiveResult IO ArchivePtr
forall a b. (a -> b) -> a -> b
$ ForeignPtr Any -> ArchivePtr
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr (ForeignPtr Any -> ArchivePtr)
-> IO (ForeignPtr Any) -> IO ArchivePtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Any -> IO () -> IO (ForeignPtr Any)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr (Ptr Archive -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Archive
p) (IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO CInt
archiveFree Ptr Archive
p)
    ArchivePtr -> ArchiveM ()
act ArchivePtr
fptr

    where act :: ArchivePtr -> ArchiveM ()
act ArchivePtr
a = do
                IO ArchiveResult -> ArchiveM ()
ignore (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ ArchivePtr -> IO ArchiveResult
modifier ArchivePtr
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
$ ArchivePtr -> Ptr CChar -> IO ArchiveResult
archiveWriteOpenFilename ArchivePtr
a Ptr CChar
fpc
                ArchivePtr -> t (Entry FilePath ByteString) -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
ArchivePtr -> t (Entry FilePath ByteString) -> ArchiveM ()
packEntries ArchivePtr
a t (Entry FilePath ByteString)
hsEntries'

withArchiveEntry :: (ArchiveEntryPtr -> ArchiveM a) -> ArchiveM a
withArchiveEntry :: (ArchiveEntryPtr -> ArchiveM a) -> ArchiveM a
withArchiveEntry = ((ArchiveEntryPtr -> ArchiveM a)
-> ExceptT ArchiveResult IO ArchiveEntryPtr -> ArchiveM a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ArchiveEntryPtr -> ExceptT ArchiveResult IO ArchiveEntryPtr
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ArchiveEntryPtr
archiveEntryNew)

archiveEntryAdd :: ArchivePtr -> Entry FilePath BS.ByteString -> ArchiveM ()
archiveEntryAdd :: ArchivePtr -> Entry FilePath ByteString -> ArchiveM ()
archiveEntryAdd ArchivePtr
a (Entry FilePath
fp EntryContent FilePath ByteString
contents Permissions
perms Ownership
owner Maybe ModTime
mtime) =
    (ArchiveEntryPtr -> ArchiveM ()) -> ArchiveM ()
forall a. (ArchiveEntryPtr -> ArchiveM a) -> ArchiveM a
withArchiveEntry ((ArchiveEntryPtr -> ArchiveM ()) -> ArchiveM ())
-> (ArchiveEntryPtr -> ArchiveM ()) -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ \ArchiveEntryPtr
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 ->
            ArchiveEntryPtr -> Ptr CChar -> IO ()
archiveEntrySetPathname ArchiveEntryPtr
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
$ ArchiveEntryPtr -> Permissions -> IO ()
archiveEntrySetPerm ArchiveEntryPtr
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 -> ArchiveEntryPtr -> IO ()
setOwnership Ownership
owner ArchiveEntryPtr
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 -> ArchiveEntryPtr -> IO ()
setTime (ModTime -> ArchiveEntryPtr -> IO ())
-> Maybe ModTime -> Maybe (ArchiveEntryPtr -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModTime
mtime Maybe (ArchiveEntryPtr -> IO ())
-> Maybe ArchiveEntryPtr -> Maybe (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ArchiveEntryPtr -> Maybe ArchiveEntryPtr
forall (f :: * -> *) a. Applicative f => a -> f a
pure ArchiveEntryPtr
entry)
        EntryContent FilePath ByteString
-> ArchivePtr -> ArchiveEntryPtr -> ArchiveM ()
contentAdd EntryContent FilePath ByteString
contents ArchivePtr
a ArchiveEntryPtr
entry