module Streamly.External.Archive.Internal.Foreign
  ( Archive,
    Entry,
    FileType (..),
    archive_read_new,
    archive_read_support_filter_all,
    archive_read_support_format_all,
    archive_read_support_format_gnutar,
    blockSize,
    archive_read_open_filename,
    archive_read_next_header,
    archive_entry_filetype,
    archive_entry_pathname,
    archive_entry_pathname_utf8,
    archive_entry_size,
    alloc_archive_read_data_buffer,
    archive_read_data,
    archive_read_data_block,
    archive_read_free,
  )
where

import Control.Exception (Exception, mask_, throw)
import Control.Monad (when)
import Data.Bits ((.&.))
import Data.ByteString (ByteString, packCString, packCStringLen)
import qualified Data.ByteString as B
import Data.Int (Int64)
import Foreign (FunPtr, Ptr, nullPtr, peek)
import Foreign.C.String (CString, peekCString, withCString)
import Foreign.C.Types (CChar, CInt (CInt), CSize (CSize))
import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr)
import Foreign.Marshal.Alloc (mallocBytes)
import System.Posix.Types (CMode (CMode), CSsize (CSsize))

data CArchive

data CEntry

foreign import ccall unsafe "archive.h archive_errno"
  c_archive_errno :: Ptr CArchive -> IO CInt

foreign import ccall unsafe "archive.h archive_error_string"
  c_archive_error_string :: Ptr CArchive -> IO CString

foreign import ccall unsafe "archive.h archive_read_new"
  c_archive_read_new :: IO (Ptr CArchive)

foreign import ccall unsafe "archive.h archive_read_support_filter_all"
  c_archive_read_support_filter_all :: Ptr CArchive -> IO CInt

foreign import ccall unsafe "archive.h archive_read_support_format_all"
  c_archive_read_support_format_all :: Ptr CArchive -> IO CInt

foreign import ccall unsafe "archive.h archive_read_support_format_gnutar"
  c_archive_read_support_format_gnutar :: Ptr CArchive -> IO CInt

foreign import ccall unsafe "archive.h archive_read_open_filename"
  c_archive_read_open_filename :: Ptr CArchive -> CString -> CSize -> IO CInt

foreign import ccall unsafe "archive.h archive_read_next_header2"
  c_archive_read_next_header2 :: Ptr CArchive -> Ptr CEntry -> IO CInt

foreign import ccall unsafe "archive.h archive_read_data"
  -- Todo: Think about la_ssize_t on non-POSIX.
  c_archive_read_data :: Ptr CArchive -> Ptr CChar -> CSize -> IO CSsize

foreign import ccall unsafe "archive.h archive_read_data_block"
  c_archive_read_data_block :: Ptr CArchive -> Ptr (Ptr CChar) -> Ptr CSize -> Ptr Int64 -> IO CInt

foreign import ccall unsafe "archive.h archive_read_free"
  c_archive_read_free :: Ptr CArchive -> IO CInt

foreign import ccall unsafe "archive_entry.h archive_entry_filetype"
  c_archive_entry_filetype :: Ptr CEntry -> IO CMode -- Todo: Think about type on non-POSIX.

foreign import ccall unsafe "archive_entry.h archive_entry_new"
  c_archive_entry_new :: IO (Ptr CEntry)

-- Similar to c_free_finalizer from ByteString.
foreign import ccall unsafe "static archive_entry.h &archive_entry_free"
  c_archive_entry_free_finalizer :: FunPtr (Ptr CEntry -> IO ())

foreign import ccall unsafe "archive_entry.h archive_entry_pathname"
  c_archive_entry_pathname :: Ptr CEntry -> IO CString

foreign import ccall unsafe "archive_entry.h archive_entry_pathname_utf8"
  c_archive_entry_pathname_utf8 :: Ptr CEntry -> IO CString

foreign import ccall unsafe "archive_entry.h archive_entry_size"
  c_archive_entry_size :: Ptr CEntry -> IO Int64

foreign import ccall unsafe "archive_entry.h archive_entry_size_is_set"
  c_archive_entry_size_is_set :: Ptr CEntry -> IO CInt

-- Documented libarchive return codes.
data RetCode
  = RetCodeEOF
  | RetCodeOK
  | RetCodeRETRY
  | RetCodeWARN
  | RetCodeFAILED
  | RetCodeFATAL
  deriving (Int -> RetCode -> ShowS
[RetCode] -> ShowS
RetCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RetCode] -> ShowS
$cshowList :: [RetCode] -> ShowS
show :: RetCode -> String
$cshow :: RetCode -> String
showsPrec :: Int -> RetCode -> ShowS
$cshowsPrec :: Int -> RetCode -> ShowS
Show)

retCodes :: [(CInt, RetCode)]
retCodes :: [(CInt, RetCode)]
retCodes =
  [ (CInt
1, RetCode
RetCodeEOF),
    (CInt
0, RetCode
RetCodeOK),
    (-CInt
10, RetCode
RetCodeRETRY),
    (-CInt
20, RetCode
RetCodeWARN),
    (-CInt
25, RetCode
RetCodeFAILED),
    (-CInt
30, RetCode
RetCodeFATAL)
  ]

data ArchiveError = ArchiveError
  { ArchiveError -> String
err_function :: !String,
    ArchiveError -> Either CInt RetCode
err_retcode :: !(Either CInt RetCode),
    ArchiveError -> Int
err_number :: !Int,
    ArchiveError -> String
err_string :: !String
  }
  deriving (Int -> ArchiveError -> ShowS
[ArchiveError] -> ShowS
ArchiveError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArchiveError] -> ShowS
$cshowList :: [ArchiveError] -> ShowS
show :: ArchiveError -> String
$cshow :: ArchiveError -> String
showsPrec :: Int -> ArchiveError -> ShowS
$cshowsPrec :: Int -> ArchiveError -> ShowS
Show)

instance Exception ArchiveError

newtype ErrorString = ErrorString String deriving (Int -> ErrorString -> ShowS
[ErrorString] -> ShowS
ErrorString -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorString] -> ShowS
$cshowList :: [ErrorString] -> ShowS
show :: ErrorString -> String
$cshow :: ErrorString -> String
showsPrec :: Int -> ErrorString -> ShowS
$cshowsPrec :: Int -> ErrorString -> ShowS
Show)

instance Exception ErrorString

archive_error_string :: Ptr CArchive -> IO String
archive_error_string :: Ptr CArchive -> IO String
archive_error_string Ptr CArchive
aptr = do
  CString
cstr <- Ptr CArchive -> IO CString
c_archive_error_string Ptr CArchive
aptr
  if CString
cstr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
    then forall (m :: * -> *) a. Monad m => a -> m a
return String
"archive_error_string returned NULL"
    else CString -> IO String
peekCString CString
cstr

throwArchiveError :: String -> CInt -> Ptr CArchive -> IO noReturn
throwArchiveError :: forall noReturn. String -> CInt -> Ptr CArchive -> IO noReturn
throwArchiveError String
fn CInt
rc Ptr CArchive
aptr = do
  Int
num <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CArchive -> IO CInt
c_archive_errno Ptr CArchive
aptr
  String
str <- Ptr CArchive -> IO String
archive_error_string Ptr CArchive
aptr
  forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$
    ArchiveError
      { err_function :: String
err_function = String
fn,
        err_retcode :: Either CInt RetCode
err_retcode = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left CInt
rc) forall a b. b -> Either a b
Right (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CInt
rc [(CInt, RetCode)]
retCodes),
        err_number :: Int
err_number = Int
num,
        err_string :: String
err_string = String
str
      }

newtype Archive = Archive (Ptr CArchive)

newtype Entry = Entry (ForeignPtr CEntry)

data FileType
  = FileTypeRegular
  | FileTypeSymlink
  | FileTypeSocket
  | FileTypeCharDevice
  | FileTypeBlockDevice
  | FileTypeDirectory
  | FileTypeNamedPipe
  deriving (Int -> FileType -> ShowS
[FileType] -> ShowS
FileType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileType] -> ShowS
$cshowList :: [FileType] -> ShowS
show :: FileType -> String
$cshow :: FileType -> String
showsPrec :: Int -> FileType -> ShowS
$cshowsPrec :: Int -> FileType -> ShowS
Show, FileType -> FileType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c== :: FileType -> FileType -> Bool
Eq)

archive_read_new :: IO Archive
archive_read_new :: IO Archive
archive_read_new = do
  Ptr CArchive
aptr <- IO (Ptr CArchive)
c_archive_read_new
  if Ptr CArchive
aptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
    then forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ String -> ErrorString
ErrorString String
"archive_read_new returned NULL"
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ptr CArchive -> Archive
Archive Ptr CArchive
aptr

archive_read_support_filter_all :: Archive -> IO ()
archive_read_support_filter_all :: Archive -> IO ()
archive_read_support_filter_all (Archive Ptr CArchive
aptr) = do
  CInt
rc <- Ptr CArchive -> IO CInt
c_archive_read_support_filter_all Ptr CArchive
aptr
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc forall a. Eq a => a -> a -> Bool
/= CInt
0) forall a b. (a -> b) -> a -> b
$ forall noReturn. String -> CInt -> Ptr CArchive -> IO noReturn
throwArchiveError String
"archive_read_support_filter_all" CInt
rc Ptr CArchive
aptr

archive_read_support_format_all :: Archive -> IO ()
archive_read_support_format_all :: Archive -> IO ()
archive_read_support_format_all (Archive Ptr CArchive
aptr) = do
  CInt
rc <- Ptr CArchive -> IO CInt
c_archive_read_support_format_all Ptr CArchive
aptr
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc forall a. Eq a => a -> a -> Bool
/= CInt
0) forall a b. (a -> b) -> a -> b
$ forall noReturn. String -> CInt -> Ptr CArchive -> IO noReturn
throwArchiveError String
"archive_read_support_format_all" CInt
rc Ptr CArchive
aptr

archive_read_support_format_gnutar :: Archive -> IO ()
archive_read_support_format_gnutar :: Archive -> IO ()
archive_read_support_format_gnutar (Archive Ptr CArchive
aptr) = do
  CInt
rc <- Ptr CArchive -> IO CInt
c_archive_read_support_format_gnutar Ptr CArchive
aptr
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc forall a. Eq a => a -> a -> Bool
/= CInt
0) forall a b. (a -> b) -> a -> b
$ forall noReturn. String -> CInt -> Ptr CArchive -> IO noReturn
throwArchiveError String
"archive_read_support_format_gnutar" CInt
rc Ptr CArchive
aptr

-- Fixed block size for now.
{-# INLINE blockSize #-}
blockSize :: (Num a) => a
blockSize :: forall a. Num a => a
blockSize = a
4096

archive_read_open_filename :: Archive -> FilePath -> IO ()
archive_read_open_filename :: Archive -> String -> IO ()
archive_read_open_filename (Archive Ptr CArchive
aptr) String
fp =
  forall a. String -> (CString -> IO a) -> IO a
withCString String
fp forall a b. (a -> b) -> a -> b
$ \CString
cstr -> do
    CInt
rc <- Ptr CArchive -> CString -> CSize -> IO CInt
c_archive_read_open_filename Ptr CArchive
aptr CString
cstr forall a. Num a => a
blockSize
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc forall a. Eq a => a -> a -> Bool
/= CInt
0) forall a b. (a -> b) -> a -> b
$ forall noReturn. String -> CInt -> Ptr CArchive -> IO noReturn
throwArchiveError String
"archive_read_open_filename" CInt
rc Ptr CArchive
aptr

-- | Returns 'Nothing' if we have reached the end of the archive.
{-# INLINE archive_read_next_header #-}
archive_read_next_header :: Archive -> IO (Maybe Entry)
archive_read_next_header :: Archive -> IO (Maybe Entry)
archive_read_next_header (Archive Ptr CArchive
aptr) = do
  ForeignPtr CEntry
fpe <- forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ IO (Ptr CEntry)
c_archive_entry_new forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr CEntry -> IO ())
c_archive_entry_free_finalizer
  CInt
rc <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CEntry
fpe forall a b. (a -> b) -> a -> b
$ Ptr CArchive -> Ptr CEntry -> IO CInt
c_archive_read_next_header2 Ptr CArchive
aptr
  if CInt
rc forall a. Eq a => a -> a -> Bool
== CInt
1 -- EOF.
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    else
      if CInt
rc forall a. Ord a => a -> a -> Bool
< CInt
0
        then forall noReturn. String -> CInt -> Ptr CArchive -> IO noReturn
throwArchiveError String
"archive_read_next_header" CInt
rc Ptr CArchive
aptr
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr CEntry -> Entry
Entry forall a b. (a -> b) -> a -> b
$ ForeignPtr CEntry
fpe

{-# INLINE fileTypeAeIFMT #-}
fileTypeAeIFMT :: CMode
fileTypeAeIFMT :: CMode
fileTypeAeIFMT = CMode
0o0170000

{-# INLINE fileTypes #-}
fileTypes :: [(CMode, FileType)]
fileTypes :: [(CMode, FileType)]
fileTypes =
  [ (CMode
0o0100000, FileType
FileTypeRegular),
    (CMode
0o0120000, FileType
FileTypeSymlink),
    (CMode
0o0140000, FileType
FileTypeSocket),
    (CMode
0o0020000, FileType
FileTypeCharDevice),
    (CMode
0o0060000, FileType
FileTypeBlockDevice),
    (CMode
0o0040000, FileType
FileTypeDirectory),
    (CMode
0o0010000, FileType
FileTypeNamedPipe)
  ]

{-# INLINE archive_entry_filetype #-}
archive_entry_filetype :: Entry -> IO (Maybe FileType)
archive_entry_filetype :: Entry -> IO (Maybe FileType)
archive_entry_filetype (Entry ForeignPtr CEntry
feptr) = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CEntry
feptr forall a b. (a -> b) -> a -> b
$ \Ptr CEntry
eptr -> do
  CMode
i <- Ptr CEntry -> IO CMode
c_archive_entry_filetype Ptr CEntry
eptr
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (CMode
i forall a. Bits a => a -> a -> a
.&. CMode
fileTypeAeIFMT) [(CMode, FileType)]
fileTypes

{-# INLINE archive_entry_pathname #-}
archive_entry_pathname :: Entry -> IO (Maybe ByteString)
archive_entry_pathname :: Entry -> IO (Maybe ByteString)
archive_entry_pathname (Entry ForeignPtr CEntry
feptr) = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CEntry
feptr forall a b. (a -> b) -> a -> b
$ \Ptr CEntry
eptr -> do
  CString
cstr <- Ptr CEntry -> IO CString
c_archive_entry_pathname Ptr CEntry
eptr
  if CString
cstr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
packCString CString
cstr

{-# INLINE archive_entry_pathname_utf8 #-}
archive_entry_pathname_utf8 :: Entry -> IO (Maybe ByteString)
archive_entry_pathname_utf8 :: Entry -> IO (Maybe ByteString)
archive_entry_pathname_utf8 (Entry ForeignPtr CEntry
feptr) = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CEntry
feptr forall a b. (a -> b) -> a -> b
$ \Ptr CEntry
eptr -> do
  CString
cstr <- Ptr CEntry -> IO CString
c_archive_entry_pathname_utf8 Ptr CEntry
eptr
  if CString
cstr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
packCString CString
cstr

{-# INLINE archive_entry_size #-}
archive_entry_size :: Entry -> IO (Maybe Int)
archive_entry_size :: Entry -> IO (Maybe Int)
archive_entry_size (Entry ForeignPtr CEntry
feptr) = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CEntry
feptr forall a b. (a -> b) -> a -> b
$ \Ptr CEntry
eptr -> do
  Bool
size_is_set <- (forall a. Eq a => a -> a -> Bool
/= CInt
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CEntry -> IO CInt
c_archive_entry_size_is_set Ptr CEntry
eptr
  if Bool
size_is_set
    then forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CEntry -> IO Int64
c_archive_entry_size Ptr CEntry
eptr
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Please free after use.
alloc_archive_read_data_buffer :: IO (Ptr CChar)
alloc_archive_read_data_buffer :: IO CString
alloc_archive_read_data_buffer = forall a. Int -> IO (Ptr a)
mallocBytes forall a. Num a => a
blockSize

-- | Returns 'Nothing' if there is no more data for the current entry.
-- Pass in a buffer allocated with 'alloc_archive_read_data_buffer'.
{-# INLINE archive_read_data #-}
archive_read_data :: Archive -> Ptr CChar -> IO (Maybe ByteString)
archive_read_data :: Archive -> CString -> IO (Maybe ByteString)
archive_read_data (Archive Ptr CArchive
aptr) CString
buf = do
  CSsize
rb <- Ptr CArchive -> CString -> CSize -> IO CSsize
c_archive_read_data Ptr CArchive
aptr CString
buf forall a. Num a => a
blockSize
  if CSsize
rb forall a. Eq a => a -> a -> Bool
== CSsize
0
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    else
      if CSsize
rb forall a. Ord a => a -> a -> Bool
< CSsize
0
        then forall noReturn. String -> CInt -> Ptr CArchive -> IO noReturn
throwArchiveError String
"archive_read_data" (forall a b. (Integral a, Num b) => a -> b
fromIntegral CSsize
rb) Ptr CArchive
aptr
        else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
packCStringLen (CString
buf, forall a b. (Integral a, Num b) => a -> b
fromIntegral CSsize
rb)

{-# INLINE archive_read_data_block #-}
archive_read_data_block ::
  Archive ->
  Ptr (Ptr CChar) ->
  Ptr CSize ->
  Ptr Int64 ->
  Int64 ->
  IO (ByteString, Bool)
archive_read_data_block :: Archive
-> Ptr CString
-> Ptr CSize
-> Ptr Int64
-> Int64
-> IO (ByteString, Bool)
archive_read_data_block (Archive Ptr CArchive
aptr) Ptr CString
buf Ptr CSize
sz Ptr Int64
offs Int64
pos = do
  CInt
rc <- Ptr CArchive -> Ptr CString -> Ptr CSize -> Ptr Int64 -> IO CInt
c_archive_read_data_block Ptr CArchive
aptr Ptr CString
buf Ptr CSize
sz Ptr Int64
offs
  if CInt
rc forall a. Ord a => a -> a -> Bool
< CInt
0
    then forall noReturn. String -> CInt -> Ptr CArchive -> IO noReturn
throwArchiveError String
"archive_read_data_block" (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
rc) Ptr CArchive
aptr
    else
      if CInt
rc forall a. Eq a => a -> a -> Bool
== CInt
0 Bool -> Bool -> Bool
|| CInt
rc forall a. Eq a => a -> a -> Bool
== CInt
1
        then do
          -- OK or EOF.
          ByteString
bs <- forall a. Storable a => Ptr a -> IO a
peek Ptr CString
buf forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CString
buf' -> forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
sz forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CSize
sz' -> CStringLen -> IO ByteString
packCStringLen (CString
buf', forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
sz')
          Int64
offs' <- forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
offs
          -- pos: Where we are currently located and where the data goes normally (for non-sparse
          -- files). offs': Where libarchive is asking us to position the data.
          if Int64
offs' forall a. Eq a => a -> a -> Bool
== Int64
pos
            then forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs, CInt
rc forall a. Eq a => a -> a -> Bool
== CInt
1)
            else
              if Int64
offs' forall a. Ord a => a -> a -> Bool
> Int64
pos
                then do
                  -- For a sparse file, we need to prepend zeroes to the normal data.
                  let diff :: Int64
diff = Int64
offs' forall a. Num a => a -> a -> a
- Int64
pos
                  let bs' :: ByteString
bs' = Int -> Word8 -> ByteString
B.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
diff) Word8
0 ByteString -> ByteString -> ByteString
`B.append` ByteString
bs
                  forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs', CInt
rc forall a. Eq a => a -> a -> Bool
== CInt
1)
                else forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ String -> ErrorString
ErrorString String
"archive_read_data_block: unexpected offset"
        else forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ String -> ErrorString
ErrorString String
"archive_read_data_block: unexpected return code"

archive_read_free :: Archive -> IO ()
archive_read_free :: Archive -> IO ()
archive_read_free (Archive Ptr CArchive
aptr) = do
  CInt
rc <- Ptr CArchive -> IO CInt
c_archive_read_free Ptr CArchive
aptr
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc forall a. Eq a => a -> a -> Bool
/= CInt
0) forall a b. (a -> b) -> a -> b
$ forall noReturn. String -> CInt -> Ptr CArchive -> IO noReturn
throwArchiveError String
"archive_read_free" CInt
rc Ptr CArchive
aptr