module Codec.Archive.Unpack ( hsEntries
                            , unpackEntriesFp
                            , unpackArchive
                            , readArchiveFile
                            , readArchiveBS
                            , unpackToDir
                            ) where

import           Codec.Archive.Common
import           Codec.Archive.Foreign
import           Codec.Archive.Monad
import           Codec.Archive.Types
import           Control.Monad          (void, (<=<))
import           Control.Monad.IO.Class (liftIO)
import           Data.Bifunctor         (first)
import qualified Data.ByteString        as BS
import           Foreign.C.String
import           Foreign.Marshal.Alloc  (allocaBytes, free, mallocBytes)
import           Foreign.Ptr            (Ptr, nullPtr)
import           System.FilePath        ((</>))
import           System.IO.Unsafe       (unsafeDupablePerformIO)

-- | Read an archive contained in a 'BS.ByteString'. The format of the archive is
-- automatically detected.
--
-- @since 1.0.0.0
readArchiveBS :: BS.ByteString -> Either ArchiveResult [Entry]
readArchiveBS :: ByteString -> Either ArchiveResult [Entry]
readArchiveBS = IO (Either ArchiveResult [Entry]) -> Either ArchiveResult [Entry]
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either ArchiveResult [Entry]) -> Either ArchiveResult [Entry])
-> (ByteString -> IO (Either ArchiveResult [Entry]))
-> ByteString
-> Either ArchiveResult [Entry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveM [Entry] -> IO (Either ArchiveResult [Entry])
forall a. ArchiveM a -> IO (Either ArchiveResult a)
runArchiveM (ArchiveM [Entry] -> IO (Either ArchiveResult [Entry]))
-> (ByteString -> ArchiveM [Entry])
-> ByteString
-> IO (Either ArchiveResult [Entry])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr Archive -> ArchiveM [Entry])
-> (Ptr Archive, IO ()) -> ArchiveM [Entry]
forall (m :: * -> *) a.
MonadIO m =>
(Ptr Archive -> m a) -> (Ptr Archive, IO ()) -> m a
actFreeCallback Ptr Archive -> ArchiveM [Entry]
hsEntries ((Ptr Archive, IO ()) -> ArchiveM [Entry])
-> (ByteString -> ExceptT ArchiveResult IO (Ptr Archive, IO ()))
-> ByteString
-> ArchiveM [Entry]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> ExceptT ArchiveResult IO (Ptr Archive, IO ())
bsToArchive)
{-# NOINLINE readArchiveBS #-}

bsToArchive :: BS.ByteString -> ArchiveM (Ptr Archive, IO ())
bsToArchive :: ByteString -> ExceptT ArchiveResult IO (Ptr Archive, IO ())
bsToArchive ByteString
bs = 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)
archiveReadNew
    IO ArchiveResult -> ArchiveM ()
ignore (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO ArchiveResult
archiveReadSupportFormatAll Ptr Archive
a
    Ptr Any
bufPtr <- ByteString
-> (CStringLen -> ExceptT ArchiveResult IO (Ptr Any))
-> ExceptT ArchiveResult IO (Ptr Any)
forall a b.
ByteString -> (CStringLen -> ExceptT a IO b) -> ExceptT a IO b
useAsCStringLenArchiveM ByteString
bs ((CStringLen -> ExceptT ArchiveResult IO (Ptr Any))
 -> ExceptT ArchiveResult IO (Ptr Any))
-> (CStringLen -> ExceptT ArchiveResult IO (Ptr Any))
-> ExceptT ArchiveResult IO (Ptr Any)
forall a b. (a -> b) -> a -> b
$
        \(Ptr CChar
buf, Int
sz) -> do
            Ptr Any
buf' <- IO (Ptr Any) -> ExceptT ArchiveResult IO (Ptr Any)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Any) -> ExceptT ArchiveResult IO (Ptr Any))
-> IO (Ptr Any) -> ExceptT ArchiveResult IO (Ptr Any)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Any)
forall a. Int -> IO (Ptr a)
mallocBytes 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
$ Ptr Any -> Ptr CChar -> CSize -> IO ()
forall a b. Ptr a -> Ptr b -> CSize -> IO ()
hmemcpy Ptr Any
buf' Ptr CChar
buf (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)
            IO ArchiveResult -> ArchiveM ()
handle (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr CChar -> CSize -> IO ArchiveResult
forall a. Ptr Archive -> Ptr a -> CSize -> IO ArchiveResult
archiveReadOpenMemory Ptr Archive
a Ptr CChar
buf (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)
            Ptr Any -> ExceptT ArchiveResult IO (Ptr Any)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr Any
buf'
    (Ptr Archive, IO ())
-> ExceptT ArchiveResult IO (Ptr Archive, IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr Archive
a, Ptr Any -> IO ()
forall a. Ptr a -> IO ()
free Ptr Any
bufPtr)

-- | Read an archive from a file. The format of the archive is automatically
-- detected.
--
-- @since 1.0.0.0
readArchiveFile :: FilePath -> ArchiveM [Entry]
readArchiveFile :: FilePath -> ArchiveM [Entry]
readArchiveFile FilePath
fp = IO (Ptr Archive)
-> (Ptr Archive -> ArchiveM [Entry]) -> ArchiveM [Entry]
forall a.
IO (Ptr Archive) -> (Ptr Archive -> ArchiveM a) -> ArchiveM a
actFree IO (Ptr Archive)
archiveReadNew (\Ptr Archive
a -> FilePath -> Ptr Archive -> ArchiveM ()
archiveFile FilePath
fp Ptr Archive
a ArchiveM () -> ArchiveM [Entry] -> ArchiveM [Entry]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Ptr Archive -> ArchiveM [Entry]
hsEntries Ptr Archive
a)
-- actFree hsEntries <=< a dorchiveFile

archiveFile :: FilePath -> Ptr Archive -> ArchiveM ()
archiveFile :: FilePath -> Ptr Archive -> ArchiveM ()
archiveFile FilePath
fp 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
cpath ->
    IO ArchiveResult -> ArchiveM ()
ignore (Ptr Archive -> IO ArchiveResult
archiveReadSupportFormatAll Ptr Archive
a) ArchiveM () -> ArchiveM () -> ArchiveM ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
    IO ArchiveResult -> ArchiveM ()
handle (Ptr Archive -> Ptr CChar -> CSize -> IO ArchiveResult
archiveReadOpenFilename Ptr Archive
a Ptr CChar
cpath CSize
10240)

-- | This is more efficient than
--
-- @
-- unpackToDir "llvm" =<< BS.readFile "llvm.tar"
-- @
unpackArchive :: FilePath -- ^ Filepath pointing to archive
              -> FilePath -- ^ Dirctory to unpack in
              -> ArchiveM ()
unpackArchive :: FilePath -> FilePath -> ArchiveM ()
unpackArchive FilePath
tarFp FilePath
dirFp =
    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)
archiveReadNew
        Ptr Archive -> IO ArchiveResult
archiveFree
        (\Ptr Archive
a ->
            FilePath -> Ptr Archive -> ArchiveM ()
archiveFile FilePath
tarFp Ptr Archive
a ArchiveM () -> ArchiveM () -> ArchiveM ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
            Ptr Archive -> FilePath -> ArchiveM ()
unpackEntriesFp Ptr Archive
a FilePath
dirFp)

readEntry :: Ptr Archive -> Ptr ArchiveEntry -> IO Entry
readEntry :: Ptr Archive -> Ptr ArchiveEntry -> IO Entry
readEntry Ptr Archive
a Ptr ArchiveEntry
entry =
    FilePath
-> EntryContent
-> Permissions
-> Ownership
-> Maybe ModTime
-> Entry
Entry
        (FilePath
 -> EntryContent
 -> Permissions
 -> Ownership
 -> Maybe ModTime
 -> Entry)
-> IO FilePath
-> IO
     (EntryContent
      -> Permissions -> Ownership -> Maybe ModTime -> Entry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr CChar -> IO FilePath
peekCString (Ptr CChar -> IO FilePath) -> IO (Ptr CChar) -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr ArchiveEntry -> IO (Ptr CChar)
archiveEntryPathname Ptr ArchiveEntry
entry)
        IO
  (EntryContent
   -> Permissions -> Ownership -> Maybe ModTime -> Entry)
-> IO EntryContent
-> IO (Permissions -> Ownership -> Maybe ModTime -> Entry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr Archive -> Ptr ArchiveEntry -> IO EntryContent
readContents Ptr Archive
a Ptr ArchiveEntry
entry
        IO (Permissions -> Ownership -> Maybe ModTime -> Entry)
-> IO Permissions -> IO (Ownership -> Maybe ModTime -> Entry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArchiveEntry -> IO Permissions
archiveEntryPerm Ptr ArchiveEntry
entry
        IO (Ownership -> Maybe ModTime -> Entry)
-> IO Ownership -> IO (Maybe ModTime -> Entry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArchiveEntry -> IO Ownership
readOwnership Ptr ArchiveEntry
entry
        IO (Maybe ModTime -> Entry) -> IO (Maybe ModTime) -> IO Entry
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArchiveEntry -> IO (Maybe ModTime)
readTimes Ptr ArchiveEntry
entry

-- | Yield the next entry in an archive
getHsEntry :: Ptr Archive -> IO (Maybe Entry)
getHsEntry :: Ptr Archive -> IO (Maybe Entry)
getHsEntry Ptr Archive
a = do
    Maybe (Ptr ArchiveEntry)
entry <- Ptr Archive -> IO (Maybe (Ptr ArchiveEntry))
getEntry Ptr Archive
a
    case Maybe (Ptr ArchiveEntry)
entry of
        Maybe (Ptr ArchiveEntry)
Nothing -> Maybe Entry -> IO (Maybe Entry)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Entry
forall a. Maybe a
Nothing
        Just Ptr ArchiveEntry
x  -> Entry -> Maybe Entry
forall a. a -> Maybe a
Just (Entry -> Maybe Entry) -> IO Entry -> IO (Maybe Entry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Archive -> Ptr ArchiveEntry -> IO Entry
readEntry Ptr Archive
a Ptr ArchiveEntry
x

-- | Return a list of 'Entry's.
hsEntries :: Ptr Archive -> ArchiveM [Entry]
hsEntries :: Ptr Archive -> ArchiveM [Entry]
hsEntries Ptr Archive
a = do
    Maybe Entry
next <- IO (Maybe Entry) -> ExceptT ArchiveResult IO (Maybe Entry)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Entry) -> ExceptT ArchiveResult IO (Maybe Entry))
-> IO (Maybe Entry) -> ExceptT ArchiveResult IO (Maybe Entry)
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO (Maybe Entry)
getHsEntry Ptr Archive
a
    case Maybe Entry
next of
        Maybe Entry
Nothing -> [Entry] -> ArchiveM [Entry]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Just Entry
x  -> (Entry
xEntry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
:) ([Entry] -> [Entry]) -> ArchiveM [Entry] -> ArchiveM [Entry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Archive -> ArchiveM [Entry]
hsEntries Ptr Archive
a

-- | Unpack an archive in a given directory
unpackEntriesFp :: Ptr Archive -> FilePath -> ArchiveM ()
unpackEntriesFp :: Ptr Archive -> FilePath -> ArchiveM ()
unpackEntriesFp Ptr Archive
a FilePath
fp = do
    Maybe (Ptr ArchiveEntry)
res <- IO (Maybe (Ptr ArchiveEntry))
-> ExceptT ArchiveResult IO (Maybe (Ptr ArchiveEntry))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Ptr ArchiveEntry))
 -> ExceptT ArchiveResult IO (Maybe (Ptr ArchiveEntry)))
-> IO (Maybe (Ptr ArchiveEntry))
-> ExceptT ArchiveResult IO (Maybe (Ptr ArchiveEntry))
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO (Maybe (Ptr ArchiveEntry))
getEntry Ptr Archive
a
    case Maybe (Ptr ArchiveEntry)
res of
        Maybe (Ptr ArchiveEntry)
Nothing -> () -> ArchiveM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just Ptr ArchiveEntry
x  -> do
            Ptr CChar
preFile <- IO (Ptr CChar) -> ExceptT ArchiveResult IO (Ptr CChar)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr CChar) -> ExceptT ArchiveResult IO (Ptr CChar))
-> IO (Ptr CChar) -> ExceptT ArchiveResult IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Ptr ArchiveEntry -> IO (Ptr CChar)
archiveEntryPathname Ptr ArchiveEntry
x
            FilePath
file <- IO FilePath -> ExceptT ArchiveResult IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> ExceptT ArchiveResult IO FilePath)
-> IO FilePath -> ExceptT ArchiveResult IO FilePath
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> IO FilePath
peekCString Ptr CChar
preFile
            let file' :: FilePath
file' = FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
file
            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
file' ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
fileC ->
                Ptr ArchiveEntry -> Ptr CChar -> IO ()
archiveEntrySetPathname Ptr ArchiveEntry
x Ptr CChar
fileC
            Maybe FileType
ft <- IO (Maybe FileType) -> ExceptT ArchiveResult IO (Maybe FileType)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FileType) -> ExceptT ArchiveResult IO (Maybe FileType))
-> IO (Maybe FileType) -> ExceptT ArchiveResult IO (Maybe FileType)
forall a b. (a -> b) -> a -> b
$ Ptr ArchiveEntry -> IO (Maybe FileType)
archiveEntryFiletype Ptr ArchiveEntry
x
            case Maybe FileType
ft of
                Just{} ->
                    IO ArchiveResult -> ArchiveM ()
ignore (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr ArchiveEntry -> Flags -> IO ArchiveResult
archiveReadExtract Ptr Archive
a Ptr ArchiveEntry
x Flags
archiveExtractTime
                Maybe FileType
Nothing -> do
                    FilePath
hardlink <- IO FilePath -> ExceptT ArchiveResult IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> ExceptT ArchiveResult IO FilePath)
-> IO FilePath -> ExceptT ArchiveResult IO FilePath
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> IO FilePath
peekCString (Ptr CChar -> IO FilePath) -> IO (Ptr CChar) -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr ArchiveEntry -> IO (Ptr CChar)
archiveEntryHardlink Ptr ArchiveEntry
x
                    let hardlink' :: FilePath
hardlink' = FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
hardlink
                    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
hardlink' ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
hl ->
                        Ptr ArchiveEntry -> Ptr CChar -> IO ()
archiveEntrySetHardlink Ptr ArchiveEntry
x Ptr CChar
hl
                    IO ArchiveResult -> ArchiveM ()
ignore (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr ArchiveEntry -> Flags -> IO ArchiveResult
archiveReadExtract Ptr Archive
a Ptr ArchiveEntry
x Flags
archiveExtractTime
            IO ArchiveResult -> ArchiveM ()
ignore (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO ArchiveResult
archiveReadDataSkip Ptr Archive
a
            Ptr Archive -> FilePath -> ArchiveM ()
unpackEntriesFp Ptr Archive
a FilePath
fp

readBS :: Ptr Archive -> Int -> IO BS.ByteString
readBS :: Ptr Archive -> Int -> IO ByteString
readBS Ptr Archive
a Int
sz =
    Int -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
sz ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buff ->
        Ptr Archive -> Ptr CChar -> CSize -> IO LaSSize
forall a. Ptr Archive -> Ptr a -> CSize -> IO LaSSize
archiveReadData Ptr Archive
a Ptr CChar
buff (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) IO LaSSize -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
        CStringLen -> IO ByteString
BS.packCStringLen (Ptr CChar
buff, Int
sz)

readContents :: Ptr Archive -> Ptr ArchiveEntry -> IO EntryContent
readContents :: Ptr Archive -> Ptr ArchiveEntry -> IO EntryContent
readContents Ptr Archive
a Ptr ArchiveEntry
entry = Maybe FileType -> IO EntryContent
go (Maybe FileType -> IO EntryContent)
-> IO (Maybe FileType) -> IO EntryContent
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr ArchiveEntry -> IO (Maybe FileType)
archiveEntryFiletype Ptr ArchiveEntry
entry
    where go :: Maybe FileType -> IO EntryContent
go Maybe FileType
Nothing            = FilePath -> EntryContent
Hardlink (FilePath -> EntryContent) -> IO FilePath -> IO EntryContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr CChar -> IO FilePath
peekCString (Ptr CChar -> IO FilePath) -> IO (Ptr CChar) -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr ArchiveEntry -> IO (Ptr CChar)
archiveEntryHardlink Ptr ArchiveEntry
entry)
          go (Just FileType
FtRegular)   = ByteString -> EntryContent
NormalFile (ByteString -> EntryContent) -> IO ByteString -> IO EntryContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr Archive -> Int -> IO ByteString
readBS Ptr Archive
a (Int -> IO ByteString) -> IO Int -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Int
sz)
          go (Just FileType
FtLink)      = FilePath -> Symlink -> EntryContent
Symlink (FilePath -> Symlink -> EntryContent)
-> IO FilePath -> IO (Symlink -> EntryContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr CChar -> IO FilePath
peekCString (Ptr CChar -> IO FilePath) -> IO (Ptr CChar) -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr ArchiveEntry -> IO (Ptr CChar)
archiveEntrySymlink Ptr ArchiveEntry
entry) IO (Symlink -> EntryContent) -> IO Symlink -> IO EntryContent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArchiveEntry -> IO Symlink
archiveEntrySymlinkType Ptr ArchiveEntry
entry
          go (Just FileType
FtDirectory) = EntryContent -> IO EntryContent
forall (f :: * -> *) a. Applicative f => a -> f a
pure EntryContent
Directory
          go (Just FileType
_)           = FilePath -> IO EntryContent
forall a. HasCallStack => FilePath -> a
error FilePath
"Unsupported filetype"
          sz :: IO Int
sz = LaSSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LaSSize -> Int) -> IO LaSSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr ArchiveEntry -> IO LaSSize
archiveEntrySize Ptr ArchiveEntry
entry

archiveGetterHelper :: (Ptr ArchiveEntry -> IO a) -> (Ptr ArchiveEntry -> IO Bool) -> Ptr ArchiveEntry -> IO (Maybe a)
archiveGetterHelper :: (Ptr ArchiveEntry -> IO a)
-> (Ptr ArchiveEntry -> IO Bool)
-> Ptr ArchiveEntry
-> IO (Maybe a)
archiveGetterHelper Ptr ArchiveEntry -> IO a
get Ptr ArchiveEntry -> IO Bool
check Ptr ArchiveEntry
entry = do
    Bool
check' <- Ptr ArchiveEntry -> IO Bool
check Ptr ArchiveEntry
entry
    if Bool
check'
        then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr ArchiveEntry -> IO a
get Ptr ArchiveEntry
entry
        else Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

archiveGetterNull :: (Ptr ArchiveEntry -> IO CString) -> Ptr ArchiveEntry -> IO (Maybe String)
archiveGetterNull :: (Ptr ArchiveEntry -> IO (Ptr CChar))
-> Ptr ArchiveEntry -> IO (Maybe FilePath)
archiveGetterNull Ptr ArchiveEntry -> IO (Ptr CChar)
get Ptr ArchiveEntry
entry = do
    Ptr CChar
res <- Ptr ArchiveEntry -> IO (Ptr CChar)
get Ptr ArchiveEntry
entry
    if Ptr CChar
res Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
        then Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
        else (FilePath -> Maybe FilePath) -> IO FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Ptr CChar -> IO FilePath
peekCString Ptr CChar
res)

readOwnership :: Ptr ArchiveEntry -> IO Ownership
readOwnership :: Ptr ArchiveEntry -> IO Ownership
readOwnership Ptr ArchiveEntry
entry =
    Maybe FilePath -> Maybe FilePath -> Id -> Id -> Ownership
Ownership
        (Maybe FilePath -> Maybe FilePath -> Id -> Id -> Ownership)
-> IO (Maybe FilePath)
-> IO (Maybe FilePath -> Id -> Id -> Ownership)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr ArchiveEntry -> IO (Ptr CChar))
-> Ptr ArchiveEntry -> IO (Maybe FilePath)
archiveGetterNull Ptr ArchiveEntry -> IO (Ptr CChar)
archiveEntryUname Ptr ArchiveEntry
entry
        IO (Maybe FilePath -> Id -> Id -> Ownership)
-> IO (Maybe FilePath) -> IO (Id -> Id -> Ownership)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr ArchiveEntry -> IO (Ptr CChar))
-> Ptr ArchiveEntry -> IO (Maybe FilePath)
archiveGetterNull Ptr ArchiveEntry -> IO (Ptr CChar)
archiveEntryGname Ptr ArchiveEntry
entry
        IO (Id -> Id -> Ownership) -> IO Id -> IO (Id -> Ownership)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (LaSSize -> Id
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LaSSize -> Id) -> IO LaSSize -> IO Id
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr ArchiveEntry -> IO LaSSize
archiveEntryUid Ptr ArchiveEntry
entry)
        IO (Id -> Ownership) -> IO Id -> IO Ownership
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (LaSSize -> Id
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LaSSize -> Id) -> IO LaSSize -> IO Id
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr ArchiveEntry -> IO LaSSize
archiveEntryGid Ptr ArchiveEntry
entry)

readTimes :: Ptr ArchiveEntry -> IO (Maybe ModTime)
readTimes :: Ptr ArchiveEntry -> IO (Maybe ModTime)
readTimes = (Ptr ArchiveEntry -> IO ModTime)
-> (Ptr ArchiveEntry -> IO Bool)
-> Ptr ArchiveEntry
-> IO (Maybe ModTime)
forall a.
(Ptr ArchiveEntry -> IO a)
-> (Ptr ArchiveEntry -> IO Bool)
-> Ptr ArchiveEntry
-> IO (Maybe a)
archiveGetterHelper Ptr ArchiveEntry -> IO ModTime
go Ptr ArchiveEntry -> IO Bool
archiveEntryMtimeIsSet
    where go :: Ptr ArchiveEntry -> IO ModTime
go Ptr ArchiveEntry
entry =
            (,) (CTime -> LaSSize -> ModTime)
-> IO CTime -> IO (LaSSize -> ModTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr ArchiveEntry -> IO CTime
archiveEntryMtime Ptr ArchiveEntry
entry IO (LaSSize -> ModTime) -> IO LaSSize -> IO ModTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArchiveEntry -> IO LaSSize
archiveEntryMtimeNsec Ptr ArchiveEntry
entry

-- | Get the next 'ArchiveEntry' in an 'Archive'
getEntry :: Ptr Archive -> IO (Maybe (Ptr ArchiveEntry))
getEntry :: Ptr Archive -> IO (Maybe (Ptr ArchiveEntry))
getEntry Ptr Archive
a = do
    let done :: ArchiveResult -> Bool
done ArchiveResult
ArchiveOk    = Bool
False
        done ArchiveResult
ArchiveRetry = Bool
False
        done ArchiveResult
_            = Bool
True
    (Bool
stop, Ptr ArchiveEntry
res) <- (ArchiveResult -> Bool)
-> (ArchiveResult, Ptr ArchiveEntry) -> (Bool, Ptr ArchiveEntry)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ArchiveResult -> Bool
done ((ArchiveResult, Ptr ArchiveEntry) -> (Bool, Ptr ArchiveEntry))
-> IO (ArchiveResult, Ptr ArchiveEntry)
-> IO (Bool, Ptr ArchiveEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Archive -> IO (ArchiveResult, Ptr ArchiveEntry)
archiveReadNextHeader Ptr Archive
a
    Maybe (Ptr ArchiveEntry) -> IO (Maybe (Ptr ArchiveEntry))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Ptr ArchiveEntry) -> IO (Maybe (Ptr ArchiveEntry)))
-> Maybe (Ptr ArchiveEntry) -> IO (Maybe (Ptr ArchiveEntry))
forall a b. (a -> b) -> a -> b
$ if Bool
stop
        then Maybe (Ptr ArchiveEntry)
forall a. Maybe a
Nothing
        else Ptr ArchiveEntry -> Maybe (Ptr ArchiveEntry)
forall a. a -> Maybe a
Just Ptr ArchiveEntry
res

unpackToDir :: FilePath -- ^ Directory to unpack in
            -> BS.ByteString -- ^ 'BS.ByteString' containing archive
            -> ArchiveM ()
unpackToDir :: FilePath -> ByteString -> ArchiveM ()
unpackToDir FilePath
fp ByteString
bs = do
    (Ptr Archive
a, IO ()
act) <- ByteString -> ExceptT ArchiveResult IO (Ptr Archive, IO ())
bsToArchive ByteString
bs
    Ptr Archive -> FilePath -> ArchiveM ()
unpackEntriesFp Ptr Archive
a FilePath
fp
    IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
act
    ExceptT ArchiveResult IO ArchiveResult -> ArchiveM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT ArchiveResult IO ArchiveResult -> ArchiveM ())
-> ExceptT ArchiveResult IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ IO ArchiveResult -> ExceptT ArchiveResult IO ArchiveResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ArchiveResult -> ExceptT ArchiveResult IO ArchiveResult)
-> IO ArchiveResult -> ExceptT ArchiveResult IO ArchiveResult
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO ArchiveResult
archiveFree Ptr Archive
a