{-# LANGUAGE TypeApplications #-}

module Streamly.External.Zip.Internal where

import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe
import Foreign
import Foreign.C.String
import Foreign.C.Types
import Streamly.Data.Unfold (Unfold)
import Streamly.External.Zip.Internal.Error
import Streamly.External.Zip.Internal.Foreign
import Streamly.Internal.Data.IOFinalizer
import qualified Streamly.Internal.Data.Unfold as U
import Text.Printf

-- | A zip archive.
newtype Zip
  = -- A ForeignPtr works because zip_discard() returns void.
    Zip (ForeignPtr Zip_t)

-- (*) Certain libzip functionality (e.g., flags) has been commented out because it is currently not
-- applicable for this library, e.g., because this library is currently read-only.

data OpenFlag
  = -- Most libzip flags not included; see (*).

    -- | Perform additional stricter consistency checks on the archive, and error if they fail.
    O_CHECKCONS
  deriving (OpenFlag -> OpenFlag -> Bool
(OpenFlag -> OpenFlag -> Bool)
-> (OpenFlag -> OpenFlag -> Bool) -> Eq OpenFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenFlag -> OpenFlag -> Bool
== :: OpenFlag -> OpenFlag -> Bool
$c/= :: OpenFlag -> OpenFlag -> Bool
/= :: OpenFlag -> OpenFlag -> Bool
Eq, Eq OpenFlag
Eq OpenFlag =>
(OpenFlag -> OpenFlag -> Ordering)
-> (OpenFlag -> OpenFlag -> Bool)
-> (OpenFlag -> OpenFlag -> Bool)
-> (OpenFlag -> OpenFlag -> Bool)
-> (OpenFlag -> OpenFlag -> Bool)
-> (OpenFlag -> OpenFlag -> OpenFlag)
-> (OpenFlag -> OpenFlag -> OpenFlag)
-> Ord OpenFlag
OpenFlag -> OpenFlag -> Bool
OpenFlag -> OpenFlag -> Ordering
OpenFlag -> OpenFlag -> OpenFlag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OpenFlag -> OpenFlag -> Ordering
compare :: OpenFlag -> OpenFlag -> Ordering
$c< :: OpenFlag -> OpenFlag -> Bool
< :: OpenFlag -> OpenFlag -> Bool
$c<= :: OpenFlag -> OpenFlag -> Bool
<= :: OpenFlag -> OpenFlag -> Bool
$c> :: OpenFlag -> OpenFlag -> Bool
> :: OpenFlag -> OpenFlag -> Bool
$c>= :: OpenFlag -> OpenFlag -> Bool
>= :: OpenFlag -> OpenFlag -> Bool
$cmax :: OpenFlag -> OpenFlag -> OpenFlag
max :: OpenFlag -> OpenFlag -> OpenFlag
$cmin :: OpenFlag -> OpenFlag -> OpenFlag
min :: OpenFlag -> OpenFlag -> OpenFlag
Ord)

-- | /Internal/.
openFlags :: Map OpenFlag CInt
openFlags :: Map OpenFlag CInt
openFlags =
  [(OpenFlag, CInt)] -> Map OpenFlag CInt
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (OpenFlag
O_CHECKCONS, CInt
forall a. Num a => a
zip_checkcons)
    -- (O_CREATE, zip_create), -- See (*).
    -- (O_EXCL, zip_excl),
    -- (O_TRUNCATE, zip_truncate)
    -- (O_RDONLY, zip_rdonly)
    ]

-- | Opens the zip archive at the given file path.
--
-- /Warning/: To satisfy low-level libzip requirements, please use each 'Zip' from one thread
-- only—or make sure to synchronize its use. Note that it is perfectly fine to open multiple 'Zip's
-- for a single zip file on disk.
openZip :: FilePath -> [OpenFlag] -> IO Zip
openZip :: String -> [OpenFlag] -> IO Zip
openZip String
fp [OpenFlag]
flags =
  -- This library is currently read-only; always open the archive in read-only mode; see (*).
  let flags' :: CInt
flags' = CInt
forall a. Num a => a
zip_rdonly CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. Map OpenFlag CInt -> [OpenFlag] -> CInt
forall flagType a.
(Ord flagType, Bits a, Num a) =>
Map flagType a -> [flagType] -> a
combineFlags Map OpenFlag CInt
openFlags [OpenFlag]
flags
   in String -> (Ptr CChar -> IO Zip) -> IO Zip
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
fp ((Ptr CChar -> IO Zip) -> IO Zip)
-> (Ptr CChar -> IO Zip) -> IO Zip
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
fpc -> (Ptr CInt -> IO Zip) -> IO Zip
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Zip) -> IO Zip) -> (Ptr CInt -> IO Zip) -> IO Zip
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
errp -> IO Zip -> IO Zip
forall a. IO a -> IO a
mask_ (IO Zip -> IO Zip) -> IO Zip -> IO Zip
forall a b. (a -> b) -> a -> b
$ do
        Ptr Zip_t
zipp <- Ptr CChar -> CInt -> Ptr CInt -> IO (Ptr Zip_t)
c_zip_open Ptr CChar
fpc CInt
flags' Ptr CInt
errp
        if Ptr Zip_t
zipp Ptr Zip_t -> Ptr Zip_t -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Zip_t
forall a. Ptr a
nullPtr
          then do
            String
err <- CInt -> IO String
libzipErrToString (CInt -> IO String) -> IO CInt -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
errp
            String -> String -> IO Zip
forall (m :: * -> *) a. String -> String -> m a
throwError String
"openZip" String
err
          else ForeignPtr Zip_t -> Zip
Zip (ForeignPtr Zip_t -> Zip) -> IO (ForeignPtr Zip_t) -> IO Zip
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizerPtr Zip_t -> Ptr Zip_t -> IO (ForeignPtr Zip_t)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr Zip_t
c_zip_discard_ptr Ptr Zip_t
zipp

-- See (*).
-- data NumEntriesFlag
--   = -- | The original number of entries is returned.
--     NE_FL_UNCHANGED
--   deriving (Eq, Ord)

-- numEntriesFlags :: Map NumEntriesFlag Zip_flags_t
-- numEntriesFlags =
--   M.fromList
--     [(NEF_FL_UNCHANGED, zip_fl_unchanged)]

-- getNumEntries :: Zip -> [NumEntriesFlag] -> IO Int

-- | Gets the number of entries in the given archive.
getNumEntries :: Zip -> IO Int
getNumEntries :: Zip -> IO Int
getNumEntries (Zip ForeignPtr Zip_t
zipfp) =
  let flags' :: Zip_flags_t
flags' = Zip_flags_t
0 -- combineFlags numEntriesFlags flags; see (*).
   in do
        Zip_int64_t
num <- ForeignPtr Zip_t -> (Ptr Zip_t -> IO Zip_int64_t) -> IO Zip_int64_t
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Zip_t
zipfp ((Ptr Zip_t -> IO Zip_int64_t) -> IO Zip_int64_t)
-> (Ptr Zip_t -> IO Zip_int64_t) -> IO Zip_int64_t
forall a b. (a -> b) -> a -> b
$ \Ptr Zip_t
zipp -> Ptr Zip_t -> Zip_flags_t -> IO Zip_int64_t
c_zip_get_num_entries Ptr Zip_t
zipp Zip_flags_t
flags'
        if Zip_int64_t
num Zip_int64_t -> Zip_int64_t -> Bool
forall a. Ord a => a -> a -> Bool
< Zip_int64_t
0
          then -- c_zip_get_num_entries should not return -1 here, for zipp is known to be non-NULL.
            String -> String -> IO Int
forall (m :: * -> *) a. String -> String -> m a
throwError String
"getNumEntries" String
"unexpected"
          else Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Zip_int64_t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Zip_int64_t
num

data PathFlag
  = --
    --   -- | The original unchanged filename is returned. -- See (*).
    --   P_FL_UNCHANGED

    -- | Return the unmodified names as it is in the ZIP archive.
    P_FL_ENC_RAW
  | -- | (Default.) Guess the encoding of the name in the ZIP archive and convert it to UTF-8, if
    -- necessary. (Only CP-437 and UTF-8 are recognized.)
    P_FL_ENC_GUESS
  | -- | Follow the ZIP specification and expect CP-437 encoded names in the ZIP archive (except if
    -- they are explicitly marked as UTF-8). Convert it to UTF-8.
    P_FL_ENC_STRICT
  deriving (PathFlag -> PathFlag -> Bool
(PathFlag -> PathFlag -> Bool)
-> (PathFlag -> PathFlag -> Bool) -> Eq PathFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathFlag -> PathFlag -> Bool
== :: PathFlag -> PathFlag -> Bool
$c/= :: PathFlag -> PathFlag -> Bool
/= :: PathFlag -> PathFlag -> Bool
Eq, Eq PathFlag
Eq PathFlag =>
(PathFlag -> PathFlag -> Ordering)
-> (PathFlag -> PathFlag -> Bool)
-> (PathFlag -> PathFlag -> Bool)
-> (PathFlag -> PathFlag -> Bool)
-> (PathFlag -> PathFlag -> Bool)
-> (PathFlag -> PathFlag -> PathFlag)
-> (PathFlag -> PathFlag -> PathFlag)
-> Ord PathFlag
PathFlag -> PathFlag -> Bool
PathFlag -> PathFlag -> Ordering
PathFlag -> PathFlag -> PathFlag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PathFlag -> PathFlag -> Ordering
compare :: PathFlag -> PathFlag -> Ordering
$c< :: PathFlag -> PathFlag -> Bool
< :: PathFlag -> PathFlag -> Bool
$c<= :: PathFlag -> PathFlag -> Bool
<= :: PathFlag -> PathFlag -> Bool
$c> :: PathFlag -> PathFlag -> Bool
> :: PathFlag -> PathFlag -> Bool
$c>= :: PathFlag -> PathFlag -> Bool
>= :: PathFlag -> PathFlag -> Bool
$cmax :: PathFlag -> PathFlag -> PathFlag
max :: PathFlag -> PathFlag -> PathFlag
$cmin :: PathFlag -> PathFlag -> PathFlag
min :: PathFlag -> PathFlag -> PathFlag
Ord)

-- | /Internal/.
pathFlags :: Map PathFlag Zip_flags_t
pathFlags :: Map PathFlag Zip_flags_t
pathFlags =
  [(PathFlag, Zip_flags_t)] -> Map PathFlag Zip_flags_t
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ -- (P_FL_UNCHANGED, zip_fl_unchanged) -- See (*).
      (PathFlag
P_FL_ENC_RAW, Zip_flags_t
forall a. Num a => a
zip_fl_enc_raw),
      (PathFlag
P_FL_ENC_GUESS, Zip_flags_t
forall a. Num a => a
zip_fl_enc_guess),
      (PathFlag
P_FL_ENC_STRICT, Zip_flags_t
forall a. Num a => a
zip_fl_enc_strict)
    ]

-- | Gets the path (e.g., @"foo.txt"@, @"foo/"@, or @"foo/bar.txt"@) of the file at the given
-- 0-based index in the given zip archive. Please use 'getNumEntries' to find the upper bound for
-- the index.
getPathByIndex :: Zip -> Int -> [PathFlag] -> IO ByteString
getPathByIndex :: Zip -> Int -> [PathFlag] -> IO ByteString
getPathByIndex (Zip ForeignPtr Zip_t
zipfp) Int
idx [PathFlag]
flags =
  let flags' :: Zip_flags_t
flags' = Map PathFlag Zip_flags_t -> [PathFlag] -> Zip_flags_t
forall flagType a.
(Ord flagType, Bits a, Num a) =>
Map flagType a -> [flagType] -> a
combineFlags Map PathFlag Zip_flags_t
pathFlags [PathFlag]
flags
   in ForeignPtr Zip_t -> (Ptr Zip_t -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Zip_t
zipfp ((Ptr Zip_t -> IO ByteString) -> IO ByteString)
-> (Ptr Zip_t -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Zip_t
zipp -> do
        Ptr CChar
name <- Ptr Zip_t -> Zip_uint64_t -> Zip_flags_t -> IO (Ptr CChar)
c_zip_get_name Ptr Zip_t
zipp (Int -> Zip_uint64_t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) Zip_flags_t
flags'
        if Ptr CChar
name Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
          then do
            String
err <- ByteString -> String
BC.unpack (ByteString -> String) -> IO ByteString -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr CChar -> IO ByteString
B.packCString (Ptr CChar -> IO ByteString) -> IO (Ptr CChar) -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Zip_t -> IO (Ptr CChar)
c_zip_strerror Ptr Zip_t
zipp)
            String -> String -> IO ByteString
forall (m :: * -> *) a. String -> String -> m a
throwError String
"getPathByIndex" String
err
          else Ptr CChar -> IO ByteString
B.packCString Ptr CChar
name

-- | A file inside of a 'Zip' archive.
--
-- /Internal/.
data File
  = File
      !(Ptr Zip_file_t) -- ForeignPtr does not work because zip_fclose() does not return void.
      !IOFinalizer

data GetFileFlag
  = -- | Read the compressed data. Otherwise the data is uncompressed when reading.
    GF_FL_COMPRESSED
  -- -- | Read the original data from the zip archive, ignoring any changes made to the file.
  --  GF_FL_UNCHANGED
  deriving (GetFileFlag -> GetFileFlag -> Bool
(GetFileFlag -> GetFileFlag -> Bool)
-> (GetFileFlag -> GetFileFlag -> Bool) -> Eq GetFileFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetFileFlag -> GetFileFlag -> Bool
== :: GetFileFlag -> GetFileFlag -> Bool
$c/= :: GetFileFlag -> GetFileFlag -> Bool
/= :: GetFileFlag -> GetFileFlag -> Bool
Eq, Eq GetFileFlag
Eq GetFileFlag =>
(GetFileFlag -> GetFileFlag -> Ordering)
-> (GetFileFlag -> GetFileFlag -> Bool)
-> (GetFileFlag -> GetFileFlag -> Bool)
-> (GetFileFlag -> GetFileFlag -> Bool)
-> (GetFileFlag -> GetFileFlag -> Bool)
-> (GetFileFlag -> GetFileFlag -> GetFileFlag)
-> (GetFileFlag -> GetFileFlag -> GetFileFlag)
-> Ord GetFileFlag
GetFileFlag -> GetFileFlag -> Bool
GetFileFlag -> GetFileFlag -> Ordering
GetFileFlag -> GetFileFlag -> GetFileFlag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GetFileFlag -> GetFileFlag -> Ordering
compare :: GetFileFlag -> GetFileFlag -> Ordering
$c< :: GetFileFlag -> GetFileFlag -> Bool
< :: GetFileFlag -> GetFileFlag -> Bool
$c<= :: GetFileFlag -> GetFileFlag -> Bool
<= :: GetFileFlag -> GetFileFlag -> Bool
$c> :: GetFileFlag -> GetFileFlag -> Bool
> :: GetFileFlag -> GetFileFlag -> Bool
$c>= :: GetFileFlag -> GetFileFlag -> Bool
>= :: GetFileFlag -> GetFileFlag -> Bool
$cmax :: GetFileFlag -> GetFileFlag -> GetFileFlag
max :: GetFileFlag -> GetFileFlag -> GetFileFlag
$cmin :: GetFileFlag -> GetFileFlag -> GetFileFlag
min :: GetFileFlag -> GetFileFlag -> GetFileFlag
Ord)

-- /Internal/.
getFileFlags :: Map GetFileFlag Zip_flags_t
getFileFlags :: Map GetFileFlag Zip_flags_t
getFileFlags =
  [(GetFileFlag, Zip_flags_t)] -> Map GetFileFlag Zip_flags_t
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    [ (GetFileFlag
GF_FL_COMPRESSED, Zip_flags_t
forall a. Num a => a
zip_fl_compressed)
    -- (GF_FL_UNCHANGED, zip_fl_unchanged)
    ]

-- | We don't publicly expose getting a 'File' (and then unfolding from it) because we don't want
-- users to unfold from the same 'File' more than once. (libzip’s @c_zip_fread@ isn’t designed for
-- iterating through a file more than once.)
--
-- /Internal/.
getFileByPathOrIndex :: Zip -> [GetFileFlag] -> Either String Int -> IO File
getFileByPathOrIndex :: Zip -> [GetFileFlag] -> Either String Int -> IO File
getFileByPathOrIndex (Zip ForeignPtr Zip_t
zipfp) [GetFileFlag]
flags Either String Int
pathOrIdx = IO File -> IO File
forall a. IO a -> IO a
mask_ (IO File -> IO File) -> IO File -> IO File
forall a b. (a -> b) -> a -> b
$ do
  let flags' :: Zip_flags_t
flags' = Map GetFileFlag Zip_flags_t -> [GetFileFlag] -> Zip_flags_t
forall flagType a.
(Ord flagType, Bits a, Num a) =>
Map flagType a -> [flagType] -> a
combineFlags Map GetFileFlag Zip_flags_t
getFileFlags [GetFileFlag]
flags
  Ptr Zip_file_t
filep <- case Either String Int
pathOrIdx of
    Left String
path ->
      String -> (Ptr CChar -> IO (Ptr Zip_file_t)) -> IO (Ptr Zip_file_t)
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
path ((Ptr CChar -> IO (Ptr Zip_file_t)) -> IO (Ptr Zip_file_t))
-> (Ptr CChar -> IO (Ptr Zip_file_t)) -> IO (Ptr Zip_file_t)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
pathc -> ForeignPtr Zip_t
-> (Ptr Zip_t -> IO (Ptr Zip_file_t)) -> IO (Ptr Zip_file_t)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Zip_t
zipfp ((Ptr Zip_t -> IO (Ptr Zip_file_t)) -> IO (Ptr Zip_file_t))
-> (Ptr Zip_t -> IO (Ptr Zip_file_t)) -> IO (Ptr Zip_file_t)
forall a b. (a -> b) -> a -> b
$ \Ptr Zip_t
zipp -> do
        Ptr Zip_file_t
filep <- Ptr Zip_t -> Ptr CChar -> Zip_flags_t -> IO (Ptr Zip_file_t)
c_zip_fopen Ptr Zip_t
zipp Ptr CChar
pathc Zip_flags_t
flags'
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Zip_file_t
filep Ptr Zip_file_t -> Ptr Zip_file_t -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Zip_file_t
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          String
err <- ByteString -> String
BC.unpack (ByteString -> String) -> IO ByteString -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr CChar -> IO ByteString
B.packCString (Ptr CChar -> IO ByteString) -> IO (Ptr CChar) -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Zip_t -> IO (Ptr CChar)
c_zip_strerror Ptr Zip_t
zipp)
          -- Keep zip alive (at least) until we have gotten the above error. This should take care
          -- of touchForeignPtr’s “divergence” caveat. Ref (**).
          ForeignPtr Zip_t -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Zip_t
zipfp
          String -> String -> IO ()
forall (m :: * -> *) a. String -> String -> m a
throwError String
"Error opening file at path" String
err
        Ptr Zip_file_t -> IO (Ptr Zip_file_t)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Zip_file_t
filep
    Right Int
idx ->
      ForeignPtr Zip_t
-> (Ptr Zip_t -> IO (Ptr Zip_file_t)) -> IO (Ptr Zip_file_t)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Zip_t
zipfp ((Ptr Zip_t -> IO (Ptr Zip_file_t)) -> IO (Ptr Zip_file_t))
-> (Ptr Zip_t -> IO (Ptr Zip_file_t)) -> IO (Ptr Zip_file_t)
forall a b. (a -> b) -> a -> b
$ \Ptr Zip_t
zipp -> do
        Ptr Zip_file_t
filep <- Ptr Zip_t -> Zip_uint64_t -> Zip_flags_t -> IO (Ptr Zip_file_t)
c_zip_fopen_index Ptr Zip_t
zipp (Int -> Zip_uint64_t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) Zip_flags_t
flags'
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr Zip_file_t
filep Ptr Zip_file_t -> Ptr Zip_file_t -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Zip_file_t
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          String
err <- ByteString -> String
BC.unpack (ByteString -> String) -> IO ByteString -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr CChar -> IO ByteString
B.packCString (Ptr CChar -> IO ByteString) -> IO (Ptr CChar) -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Zip_t -> IO (Ptr CChar)
c_zip_strerror Ptr Zip_t
zipp)
          ForeignPtr Zip_t -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Zip_t
zipfp -- See (**).
          String -> String -> IO ()
forall (m :: * -> *) a. String -> String -> m a
throwError String
"Error opening file at index" String
err
        Ptr Zip_file_t -> IO (Ptr Zip_file_t)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Zip_file_t
filep
  IOFinalizer
ref <- IO () -> IO IOFinalizer
forall (m :: * -> *) a. MonadIO m => IO a -> m IOFinalizer
newIOFinalizer (IO () -> IO IOFinalizer) -> IO () -> IO IOFinalizer
forall a b. (a -> b) -> a -> b
$ do
    CInt
ret <- Ptr Zip_file_t -> IO CInt
c_zip_fclose Ptr Zip_file_t
filep
    ForeignPtr Zip_t -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Zip_t
zipfp -- See (**).
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
ret CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> String -> IO ()
forall (m :: * -> *) a. String -> String -> m a
throwError
        String
"Error closing file"
        (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"zip_fclose() return code: %d" (forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Int CInt
ret))
  File -> IO File
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (File -> IO File) -> File -> IO File
forall a b. (a -> b) -> a -> b
$ Ptr Zip_file_t -> IOFinalizer -> File
File Ptr Zip_file_t
filep IOFinalizer
ref

-- /Internal/.
{-# INLINE unfoldFile #-}
unfoldFile :: (MonadIO m) => Unfold m (Zip, [GetFileFlag], Either String Int) ByteString
unfoldFile :: forall (m :: * -> *).
MonadIO m =>
Unfold m (Zip, [GetFileFlag], Either String Int) ByteString
unfoldFile =
  ((Zip, File, Ptr CChar, IOFinalizer)
 -> m (Step (Zip, File, Ptr CChar, IOFinalizer) ByteString))
-> ((Zip, [GetFileFlag], Either String Int)
    -> m (Zip, File, Ptr CChar, IOFinalizer))
-> Unfold m (Zip, [GetFileFlag], Either String Int) ByteString
forall s (m :: * -> *) b a.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
U.mkUnfoldM
    ( \(z :: Zip
z@(Zip ForeignPtr Zip_t
zipfp), file :: File
file@(File Ptr Zip_file_t
filep IOFinalizer
_), Ptr CChar
bufp, IOFinalizer
ref) -> IO (Step (Zip, File, Ptr CChar, IOFinalizer) ByteString)
-> m (Step (Zip, File, Ptr CChar, IOFinalizer) ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Step (Zip, File, Ptr CChar, IOFinalizer) ByteString)
 -> m (Step (Zip, File, Ptr CChar, IOFinalizer) ByteString))
-> IO (Step (Zip, File, Ptr CChar, IOFinalizer) ByteString)
-> m (Step (Zip, File, Ptr CChar, IOFinalizer) ByteString)
forall a b. (a -> b) -> a -> b
$ do
        Zip_int64_t
bytesRead <- Ptr Zip_file_t -> Ptr CChar -> Zip_uint64_t -> IO Zip_int64_t
c_zip_fread Ptr Zip_file_t
filep Ptr CChar
bufp Zip_uint64_t
chunkSize
        if Zip_int64_t
bytesRead Zip_int64_t -> Zip_int64_t -> Bool
forall a. Ord a => a -> a -> Bool
< Zip_int64_t
0
          then
            String
-> String
-> IO (Step (Zip, File, Ptr CChar, IOFinalizer) ByteString)
forall (m :: * -> *) a. String -> String -> m a
throwError
              String
"Error reading file"
              (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"zip_fread() return value: %d" (forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Int Zip_int64_t
bytesRead))
          else
            if Zip_int64_t
bytesRead Zip_int64_t -> Zip_int64_t -> Bool
forall a. Eq a => a -> a -> Bool
== Zip_int64_t
0
              then do
                IOFinalizer -> IO ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
ref
                -- Keep zip alive for (at least) the duration of the unfold. See also (**).
                ForeignPtr Zip_t -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Zip_t
zipfp
                Step (Zip, File, Ptr CChar, IOFinalizer) ByteString
-> IO (Step (Zip, File, Ptr CChar, IOFinalizer) ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Zip, File, Ptr CChar, IOFinalizer) ByteString
forall s a. Step s a
U.Stop
              else do
                ByteString
bs <- CStringLen -> IO ByteString
B.packCStringLen (Ptr CChar
bufp, Zip_int64_t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Zip_int64_t
bytesRead)
                Step (Zip, File, Ptr CChar, IOFinalizer) ByteString
-> IO (Step (Zip, File, Ptr CChar, IOFinalizer) ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Zip, File, Ptr CChar, IOFinalizer) ByteString
 -> IO (Step (Zip, File, Ptr CChar, IOFinalizer) ByteString))
-> Step (Zip, File, Ptr CChar, IOFinalizer) ByteString
-> IO (Step (Zip, File, Ptr CChar, IOFinalizer) ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString
-> (Zip, File, Ptr CChar, IOFinalizer)
-> Step (Zip, File, Ptr CChar, IOFinalizer) ByteString
forall s a. a -> s -> Step s a
U.Yield ByteString
bs (Zip
z, File
file, Ptr CChar
bufp, IOFinalizer
ref)
    )
    ( \(z :: Zip
z@(Zip ForeignPtr Zip_t
zipfp), [GetFileFlag]
flags, Either String Int
pathOrIndex) -> IO (Zip, File, Ptr CChar, IOFinalizer)
-> m (Zip, File, Ptr CChar, IOFinalizer)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Zip, File, Ptr CChar, IOFinalizer)
 -> m (Zip, File, Ptr CChar, IOFinalizer))
-> IO (Zip, File, Ptr CChar, IOFinalizer)
-> m (Zip, File, Ptr CChar, IOFinalizer)
forall a b. (a -> b) -> a -> b
$ IO (Zip, File, Ptr CChar, IOFinalizer)
-> IO (Zip, File, Ptr CChar, IOFinalizer)
forall a. IO a -> IO a
mask_ (IO (Zip, File, Ptr CChar, IOFinalizer)
 -> IO (Zip, File, Ptr CChar, IOFinalizer))
-> IO (Zip, File, Ptr CChar, IOFinalizer)
-> IO (Zip, File, Ptr CChar, IOFinalizer)
forall a b. (a -> b) -> a -> b
$ do
        file :: File
file@(File Ptr Zip_file_t
_ IOFinalizer
fileFinalizer) <- Zip -> [GetFileFlag] -> Either String Int -> IO File
getFileByPathOrIndex Zip
z [GetFileFlag]
flags Either String Int
pathOrIndex
        Ptr CChar
bufp <- Int -> IO (Ptr CChar)
forall a. Int -> IO (Ptr a)
mallocBytes (Int -> IO (Ptr CChar)) -> Int -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Zip_uint64_t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Zip_uint64_t
chunkSize
        IOFinalizer
ref <- IO () -> IO IOFinalizer
forall (m :: * -> *) a. MonadIO m => IO a -> m IOFinalizer
newIOFinalizer (IO () -> IO IOFinalizer) -> IO () -> IO IOFinalizer
forall a b. (a -> b) -> a -> b
$ do
          Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free Ptr CChar
bufp
          IOFinalizer -> IO ()
forall (m :: * -> *). MonadIO m => IOFinalizer -> m ()
runIOFinalizer IOFinalizer
fileFinalizer
          ForeignPtr Zip_t -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Zip_t
zipfp -- See also (**).
        (Zip, File, Ptr CChar, IOFinalizer)
-> IO (Zip, File, Ptr CChar, IOFinalizer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Zip
z, File
file, Ptr CChar
bufp, IOFinalizer
ref)
    )

-- /Internal/.
{-# INLINE chunkSize #-}
chunkSize :: Zip_uint64_t
chunkSize :: Zip_uint64_t
chunkSize = Zip_uint64_t
64000

-- /Internal/.
combineFlags :: (Ord flagType, Bits a, Num a) => Map flagType a -> [flagType] -> a
combineFlags :: forall flagType a.
(Ord flagType, Bits a, Num a) =>
Map flagType a -> [flagType] -> a
combineFlags Map flagType a
allFlags =
  (a -> flagType -> a) -> a -> [flagType] -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
    (\a
acc flagType
chosenFlag -> a
acc a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error String
"flag expected") (flagType -> Map flagType a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup flagType
chosenFlag Map flagType a
allFlags))
    a
0

-- | Creates an @Unfold@ with which one can stream data out of the entry at the given path (e.g.,
-- @"foo.txt"@, @"foo/"@, or @"foo/bar.txt"@).
unfoldFileAtPath :: (MonadIO m) => Unfold m (Zip, [GetFileFlag], String) ByteString
unfoldFileAtPath :: forall (m :: * -> *).
MonadIO m =>
Unfold m (Zip, [GetFileFlag], String) ByteString
unfoldFileAtPath = ((Zip, [GetFileFlag], String)
 -> (Zip, [GetFileFlag], Either String Int))
-> Unfold m (Zip, [GetFileFlag], Either String Int) ByteString
-> Unfold m (Zip, [GetFileFlag], String) ByteString
forall a c (m :: * -> *) b.
(a -> c) -> Unfold m c b -> Unfold m a b
U.lmap (\(Zip
z, [GetFileFlag]
fl, String
p) -> (Zip
z, [GetFileFlag]
fl, String -> Either String Int
forall a b. a -> Either a b
Left String
p)) Unfold m (Zip, [GetFileFlag], Either String Int) ByteString
forall (m :: * -> *).
MonadIO m =>
Unfold m (Zip, [GetFileFlag], Either String Int) ByteString
unfoldFile

-- | Creates an @Unfold@ with which one can stream data out of the entry at the given index. Please
-- use 'getNumEntries' to find the upper bound for the index.
unfoldFileAtIndex :: (MonadIO m) => Unfold m (Zip, [GetFileFlag], Int) ByteString
unfoldFileAtIndex :: forall (m :: * -> *).
MonadIO m =>
Unfold m (Zip, [GetFileFlag], Int) ByteString
unfoldFileAtIndex = ((Zip, [GetFileFlag], Int)
 -> (Zip, [GetFileFlag], Either String Int))
-> Unfold m (Zip, [GetFileFlag], Either String Int) ByteString
-> Unfold m (Zip, [GetFileFlag], Int) ByteString
forall a c (m :: * -> *) b.
(a -> c) -> Unfold m c b -> Unfold m a b
U.lmap (\(Zip
z, [GetFileFlag]
fl, Int
idx) -> (Zip
z, [GetFileFlag]
fl, Int -> Either String Int
forall a b. b -> Either a b
Right Int
idx)) Unfold m (Zip, [GetFileFlag], Either String Int) ByteString
forall (m :: * -> *).
MonadIO m =>
Unfold m (Zip, [GetFileFlag], Either String Int) ByteString
unfoldFile