{-# LANGUAGE CPP #-}

{- | Sink entries to the archive:

@
\{\-\# LANGUAGE OverloadedStrings \#\-\}

import Data.Conduit.Combinators
import Codec.Archive.Zip

main :: IO ()
main = do
    withArchive \"some.zip\" $ do
        sinkEntry \"first\"  $ sourceLazy \"hello\"
        sinkEntry \"second\" $ sourceLazy \"world\"
@

Source first entry from the archive:

@
import System.Environment (getArgs)
import Data.Conduit.Combinators
import Codec.Archive.Zip

main :: IO ()
main = do
    archivePath:_ <- getArgs
    withArchive archivePath $ do
        name:_ <- entryNames
        sourceEntry name $ sinkFile name
@

List entries in the archive:

@
import System.Environment (getArgs)
import Codec.Archive.Zip

main :: IO ()
main = do
    archivePath:_ <- getArgs
    names <- withArchive archivePath entryNames
    mapM_ putStrLn names
@
-}

module Codec.Archive.Zip
    ( -- * Archive monad
      Archive
    , withArchive

    -- * Operations
    , getComment
    , setComment
    , entryNames

    -- * Conduit interface
    , sourceEntry
    , sinkEntry
    , sinkEntryUncompressed

    -- * High level functions
    , extractFiles
    , addFiles
    , addFilesAs

    -- * Deprecated
    , fileNames
    , getSource
    , getSink
    ) where

import           Prelude hiding (readFile, zip)
import           Control.Monad (foldM, forM_)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as B (empty)
import           Data.List (find)
import           Data.Maybe (fromMaybe)
import           Data.Time (UTCTime, getCurrentTime)
import           Data.Word (Word32)
import           System.Directory (createDirectoryIfMissing, doesFileExist, getModificationTime)
import           System.FilePath ((</>), dropDrive, takeDirectory)
import           System.IO (Handle, IOMode(..), SeekMode(..), hClose, hSeek, hTell, openFile, withFile)

import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Control.Monad.State (StateT, evalStateT, get, gets, modify, put)
import           Control.Monad.Trans.Resource (ResourceT, MonadResource)
import           Conduit (PrimMonad, MonadThrow)
import           Data.Conduit (Void, ConduitT, runConduitRes, (.|))
import qualified Data.Conduit.Binary as CB (isolate)
import qualified Data.Conduit.Combinators as CC (sinkFile, sinkHandle, sourceFile, sourceIOHandle)
import qualified Data.Conduit.List as CL (map)
import qualified Data.Conduit.Internal as CI (zipSinks)
import           Data.Conduit.Zlib (WindowBits(..), compress, decompress)

import           Codec.Archive.Zip.Internal
import           Codec.Archive.Zip.Util


------------------------------------------------------------------------------
-- Archive monad
type Archive = StateT Zip IO


data Zip = Zip
    { Zip -> FilePath
zipFilePath               :: FilePath
    , Zip -> [FileHeader]
zipFileHeaders            :: [FileHeader]
    , Zip -> Int
zipCentralDirectoryOffset :: Int
    , Zip -> ByteString
zipComment                :: ByteString
    } deriving (Int -> Zip -> ShowS
[Zip] -> ShowS
Zip -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Zip] -> ShowS
$cshowList :: [Zip] -> ShowS
show :: Zip -> FilePath
$cshow :: Zip -> FilePath
showsPrec :: Int -> Zip -> ShowS
$cshowsPrec :: Int -> Zip -> ShowS
Show)


withArchive :: MonadIO m => FilePath -> Archive a -> m a
withArchive :: forall (m :: * -> *) a. MonadIO m => FilePath -> Archive a -> m a
withArchive FilePath
path Archive a
ar = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Zip
zip <- forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (FilePath -> IO Bool
doesFileExist FilePath
path)
               (FilePath -> IO Zip
readZip FilePath
path)
               (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> Zip
emptyZip FilePath
path)

    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Archive a
ar Zip
zip


readZip :: FilePath -> IO Zip
readZip :: FilePath -> IO Zip
readZip FilePath
f =
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
f IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
        End
e  <- Handle -> IO End
readEnd Handle
h
        CentralDirectory
cd <- Handle -> End -> IO CentralDirectory
readCentralDirectory Handle
h End
e
        forall (m :: * -> *) a. Monad m => a -> m a
return Zip { zipFilePath :: FilePath
zipFilePath    = FilePath
f
                   , zipFileHeaders :: [FileHeader]
zipFileHeaders = CentralDirectory -> [FileHeader]
cdFileHeaders CentralDirectory
cd
                   , zipCentralDirectoryOffset :: Int
zipCentralDirectoryOffset =
                         End -> Int
endCentralDirectoryOffset End
e
                   , zipComment :: ByteString
zipComment     = End -> ByteString
endZipComment End
e
                   }


emptyZip :: FilePath -> Zip
emptyZip :: FilePath -> Zip
emptyZip FilePath
f = Zip { zipFilePath :: FilePath
zipFilePath               = FilePath
f
                 , zipFileHeaders :: [FileHeader]
zipFileHeaders            = []
                 , zipCentralDirectoryOffset :: Int
zipCentralDirectoryOffset = Int
0
                 , zipComment :: ByteString
zipComment                = ByteString
B.empty
                 }


------------------------------------------------------------------------------
-- Operations
entryNames :: Archive [FilePath]
entryNames :: Archive [FilePath]
entryNames = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map FileHeader -> FilePath
fhFileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zip -> [FileHeader]
zipFileHeaders


getComment :: Archive ByteString
getComment :: Archive ByteString
getComment = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Zip -> ByteString
zipComment


setComment :: ByteString -> Archive ()
setComment :: ByteString -> Archive ()
setComment ByteString
comment = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \Zip
zip ->  Zip
zip { zipComment :: ByteString
zipComment = ByteString
comment }


------------------------------------------------------------------------------
-- Conduit interface
-- | Stream the contents of an archive entry to the specified sink.
sourceEntry :: FilePath -> ConduitT ByteString Void (ResourceT IO) a -> Archive a
sourceEntry :: forall a.
FilePath -> ConduitT ByteString Void (ResourceT IO) a -> Archive a
sourceEntry FilePath
e ConduitT ByteString Void (ResourceT IO) a
sink = do
    Zip
zip <- forall s (m :: * -> *). MonadState s m => m s
get
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
Zip -> FilePath -> ConduitT () ByteString m ()
sourceFile Zip
zip FilePath
e forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT ByteString Void (ResourceT IO) a
sink


-- | Stream data from the specified source to an archive entry.
sinkEntry :: FilePath -> ConduitT () ByteString (ResourceT IO) () -> Archive ()
sinkEntry :: FilePath -> ConduitT () ByteString (ResourceT IO) () -> Archive ()
sinkEntry FilePath
e ConduitT () ByteString (ResourceT IO) ()
source = do
    Zip
zip  <- forall s (m :: * -> *). MonadState s m => m s
get
    UTCTime
time <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    Zip
zip' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes forall a b. (a -> b) -> a -> b
$ ConduitT () ByteString (ResourceT IO) ()
source forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
Zip
-> FilePath
-> CompressionMethod
-> UTCTime
-> ConduitT ByteString Void m Zip
sinkFile Zip
zip FilePath
e CompressionMethod
Deflate UTCTime
time
    forall s (m :: * -> *). MonadState s m => s -> m ()
put Zip
zip'


-- | Stream data from the specified source to an uncompressed archive entry.
sinkEntryUncompressed :: FilePath -> ConduitT () ByteString (ResourceT IO) () -> Archive ()
sinkEntryUncompressed :: FilePath -> ConduitT () ByteString (ResourceT IO) () -> Archive ()
sinkEntryUncompressed FilePath
f ConduitT () ByteString (ResourceT IO) ()
source = do
    Zip
zip  <- forall s (m :: * -> *). MonadState s m => m s
get
    UTCTime
time <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    Zip
zip' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes forall a b. (a -> b) -> a -> b
$ ConduitT () ByteString (ResourceT IO) ()
source forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
Zip
-> FilePath
-> CompressionMethod
-> UTCTime
-> ConduitT ByteString Void m Zip
sinkFile Zip
zip FilePath
f CompressionMethod
NoCompression UTCTime
time
    forall s (m :: * -> *). MonadState s m => s -> m ()
put Zip
zip'

sourceFile :: (PrimMonad m, MonadThrow m, MonadResource m) => Zip -> FilePath -> ConduitT () ByteString m ()
sourceFile :: forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
Zip -> FilePath -> ConduitT () ByteString m ()
sourceFile Zip
zip FilePath
f =
    forall {i}. ConduitT i ByteString m ()
source forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *).
Monad m =>
Int -> ConduitT ByteString ByteString m ()
CB.isolate (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ FileHeader -> Word32
fhCompressedSize FileHeader
fileHeader)
           forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT ByteString ByteString m ()
decomp
  where
    source :: ConduitT i ByteString m ()
source = forall (m :: * -> *) i.
MonadResource m =>
IO Handle -> ConduitT i ByteString m ()
CC.sourceIOHandle forall a b. (a -> b) -> a -> b
$ do
        Handle
h      <- FilePath -> IOMode -> IO Handle
openFile (Zip -> FilePath
zipFilePath Zip
zip) IOMode
ReadMode
        Integer
offset <- Handle -> FileHeader -> IO Integer
calculateFileDataOffset Handle
h FileHeader
fileHeader
        Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
offset
        forall (m :: * -> *) a. Monad m => a -> m a
return Handle
h

    fileHeader :: FileHeader
fileHeader =
        forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error FilePath
"No such file.") forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\FileHeader
fh -> FilePath
f forall a. Eq a => a -> a -> Bool
== FileHeader -> FilePath
fhFileName FileHeader
fh)
                                          forall a b. (a -> b) -> a -> b
$ Zip -> [FileHeader]
zipFileHeaders Zip
zip

    decomp :: ConduitT ByteString ByteString m ()
decomp =
        case FileHeader -> CompressionMethod
fhCompressionMethod FileHeader
fileHeader of
          CompressionMethod
NoCompression -> forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map forall a. a -> a
id
          CompressionMethod
Deflate       -> forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
WindowBits -> ConduitT ByteString ByteString m ()
decompress forall a b. (a -> b) -> a -> b
$ Int -> WindowBits
WindowBits (-Int
15)


sinkFile :: (PrimMonad m, MonadThrow m, MonadResource m)
         => Zip -> FilePath -> CompressionMethod -> UTCTime -> ConduitT ByteString Void m Zip
sinkFile :: forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
Zip
-> FilePath
-> CompressionMethod
-> UTCTime
-> ConduitT ByteString Void m Zip
sinkFile Zip
zip FilePath
f CompressionMethod
compression UTCTime
time = do
    Handle
h  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
openFile (Zip -> FilePath
zipFilePath Zip
zip) IOMode
ReadWriteMode  -- not WriteMode because if the file already exists, then it would be truncated to zero length
    FileHeader
fh <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle
-> Zip -> FilePath -> CompressionMethod -> UTCTime -> IO FileHeader
appendLocalFileHeader Handle
h Zip
zip FilePath
f CompressionMethod
compression UTCTime
time
    DataDescriptor
dd <- forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
Handle
-> CompressionMethod -> ConduitT ByteString Void m DataDescriptor
sinkData Handle
h CompressionMethod
compression
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        Handle -> DataDescriptor -> Integer -> IO ()
writeDataDescriptorFields Handle
h DataDescriptor
dd Integer
offset
        let zip' :: Zip
zip' = Zip -> FileHeader -> DataDescriptor -> Zip
updateZip Zip
zip FileHeader
fh DataDescriptor
dd
        Handle -> Zip -> IO ()
writeFinish Handle
h Zip
zip'
        Handle -> IO ()
hClose Handle
h
        forall (m :: * -> *) a. Monad m => a -> m a
return Zip
zip'
  where
    offset :: Integer
offset = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Zip -> Int
zipCentralDirectoryOffset Zip
zip


------------------------------------------------------------------------------
-- High level functions

-- | Appends files to the 'Zip'. The file paths are used verbatim as zip entry
-- names, save for the application of 'dropDrive'.
addFiles :: [FilePath] -> Archive ()
addFiles :: [FilePath] -> Archive ()
addFiles = ShowS -> [FilePath] -> Archive ()
addFilesAs forall a. a -> a
id

-- | Appends files to the 'Zip' using a function to transform the file paths
-- into zip entry names. Useful when dealing with absolute paths. 'dropDrive'
-- is applied to the paths before the supplied function.
addFilesAs :: (FilePath -> FilePath) -> [FilePath] -> Archive ()
addFilesAs :: ShowS -> [FilePath] -> Archive ()
addFilesAs ShowS
funPath [FilePath]
fs = do
    Zip
zip <- forall s (m :: * -> *). MonadState s m => m s
get
    Zip
zip' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile (Zip -> FilePath
zipFilePath Zip
zip) IOMode
ReadWriteMode forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
        Zip
zip' <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (ShowS -> Handle -> Zip -> FilePath -> IO Zip
addFile ShowS
funPath Handle
h) Zip
zip [FilePath]
fs
        Handle -> Zip -> IO ()
writeFinish Handle
h Zip
zip'
        forall (m :: * -> *) a. Monad m => a -> m a
return Zip
zip'
    forall s (m :: * -> *). MonadState s m => s -> m ()
put Zip
zip'

-- | Extracts files from the 'Zip' to a directory.
extractFiles :: [FilePath] -> FilePath -> Archive ()
extractFiles :: [FilePath] -> FilePath -> Archive ()
extractFiles [FilePath]
fs FilePath
dir = do
    Zip
zip <- forall s (m :: * -> *). MonadState s m => m s
get
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
fs forall a b. (a -> b) -> a -> b
$ \FilePath
fileName -> do
        Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> ShowS
</> ShowS
takeDirectory FilePath
fileName
        forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
Zip -> FilePath -> ConduitT () ByteString m ()
sourceFile Zip
zip FilePath
fileName forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) o.
MonadResource m =>
FilePath -> ConduitT ByteString o m ()
CC.sinkFile (FilePath
dir FilePath -> ShowS
</> FilePath
fileName)


------------------------------------------------------------------------------
-- Low level functions

-- | Appends file to the 'Zip'.
addFile :: (FilePath -> FilePath) -> Handle -> Zip -> FilePath -> IO Zip
addFile :: ShowS -> Handle -> Zip -> FilePath -> IO Zip
addFile ShowS
funPath Handle
h Zip
zip FilePath
f = do
#if MIN_VERSION_directory(1,2,0)
    UTCTime
m  <- FilePath -> IO UTCTime
getModificationTime FilePath
f
#else
    m  <- clockTimeToUTCTime <$> getModificationTime f
#endif
    FileHeader
fh <- Handle
-> Zip -> FilePath -> CompressionMethod -> UTCTime -> IO FileHeader
appendLocalFileHeader Handle
h Zip
zip (ShowS
funPath forall a b. (a -> b) -> a -> b
$ ShowS
dropDrive FilePath
f) CompressionMethod
Deflate UTCTime
m
    DataDescriptor
dd <- forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
CC.sourceFile FilePath
f forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
Handle
-> CompressionMethod -> ConduitT ByteString Void m DataDescriptor
sinkData Handle
h CompressionMethod
Deflate
    Handle -> DataDescriptor -> Integer -> IO ()
writeDataDescriptorFields Handle
h DataDescriptor
dd Integer
offset
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Zip -> FileHeader -> DataDescriptor -> Zip
updateZip Zip
zip FileHeader
fh DataDescriptor
dd
  where
    offset :: Integer
offset = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Zip -> Int
zipCentralDirectoryOffset Zip
zip


appendLocalFileHeader :: Handle -> Zip -> FilePath -> CompressionMethod
                      -> UTCTime -> IO FileHeader
appendLocalFileHeader :: Handle
-> Zip -> FilePath -> CompressionMethod -> UTCTime -> IO FileHeader
appendLocalFileHeader Handle
h Zip
zip FilePath
f CompressionMethod
compression UTCTime
time = do
    Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
offset
    Handle -> FileHeader -> IO ()
writeLocalFileHeader Handle
h FileHeader
fh
    forall (m :: * -> *) a. Monad m => a -> m a
return FileHeader
fh
  where
    offset :: Integer
offset = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Zip -> Int
zipCentralDirectoryOffset Zip
zip
    fh :: FileHeader
fh     = FilePath -> CompressionMethod -> UTCTime -> Word32 -> FileHeader
mkFileHeader FilePath
f CompressionMethod
compression UTCTime
time (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
offset)


mkFileHeader :: FilePath -> CompressionMethod -> UTCTime -> Word32 -> FileHeader
mkFileHeader :: FilePath -> CompressionMethod -> UTCTime -> Word32 -> FileHeader
mkFileHeader FilePath
f CompressionMethod
compression UTCTime
lastModified Word32
relativeOffset =
    FileHeader { fhBitFlag :: Word16
fhBitFlag                = Word16
2  -- max compression for deflate compression method
               , fhCompressionMethod :: CompressionMethod
fhCompressionMethod      = CompressionMethod
compression
               , fhLastModified :: UTCTime
fhLastModified           = UTCTime
lastModified
               , fhCRC32 :: Word32
fhCRC32                  = Word32
0
               , fhCompressedSize :: Word32
fhCompressedSize         = Word32
0
               , fhUncompressedSize :: Word32
fhUncompressedSize       = Word32
0
               , fhInternalFileAttributes :: Word16
fhInternalFileAttributes = Word16
0
               , fhExternalFileAttributes :: Word32
fhExternalFileAttributes = Word32
0
               , fhRelativeOffset :: Word32
fhRelativeOffset         = Word32
relativeOffset
               , fhFileName :: FilePath
fhFileName               = FilePath
f
               , fhExtraField :: ByteString
fhExtraField             = ByteString
B.empty
               , fhFileComment :: ByteString
fhFileComment            = ByteString
B.empty
               }


sinkData :: (PrimMonad m, MonadThrow m, MonadResource m)
         => Handle -> CompressionMethod -> ConduitT ByteString Void m DataDescriptor
sinkData :: forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
Handle
-> CompressionMethod -> ConduitT ByteString Void m DataDescriptor
sinkData Handle
h CompressionMethod
compression = do
    ((Int
uncompressedSize, Word32
crc32), Int
compressedSize) <-
        case CompressionMethod
compression of
          CompressionMethod
NoCompression -> forall (m :: * -> *) i r r'.
Monad m =>
ConduitT i Void m r
-> ConduitT i Void m r' -> ConduitT i Void m (r, r')
CI.zipSinks forall (m :: * -> *).
MonadResource m =>
ConduitT ByteString Void m (Int, Word32)
sizeCrc32Sink forall (m :: * -> *).
MonadResource m =>
ConduitT ByteString Void m Int
sizeDataSink
          CompressionMethod
Deflate       -> forall (m :: * -> *) i r r'.
Monad m =>
ConduitT i Void m r
-> ConduitT i Void m r' -> ConduitT i Void m (r, r')
CI.zipSinks forall (m :: * -> *).
MonadResource m =>
ConduitT ByteString Void m (Int, Word32)
sizeCrc32Sink forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
ConduitT ByteString Void m Int
compressSink
    forall (m :: * -> *) a. Monad m => a -> m a
return DataDescriptor
               { ddCRC32 :: Word32
ddCRC32            = Word32
crc32
               , ddCompressedSize :: Word32
ddCompressedSize   = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
compressedSize
               , ddUncompressedSize :: Word32
ddUncompressedSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
uncompressedSize
               }
  where
    compressSink :: (PrimMonad m, MonadThrow m, MonadResource m) => ConduitT ByteString Void m Int
    compressSink :: forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
ConduitT ByteString Void m Int
compressSink = forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
Int -> WindowBits -> ConduitT ByteString ByteString m ()
compress Int
6 (Int -> WindowBits
WindowBits (-Int
15)) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *).
MonadResource m =>
ConduitT ByteString Void m Int
sizeDataSink

    sizeCrc32Sink :: MonadResource m => ConduitT ByteString Void m (Int, Word32)
    sizeCrc32Sink :: forall (m :: * -> *).
MonadResource m =>
ConduitT ByteString Void m (Int, Word32)
sizeCrc32Sink =  forall (m :: * -> *) i r r'.
Monad m =>
ConduitT i Void m r
-> ConduitT i Void m r' -> ConduitT i Void m (r, r')
CI.zipSinks forall (m :: * -> *). Monad m => ConduitT ByteString Void m Int
sizeSink forall (m :: * -> *). Monad m => ConduitT ByteString Void m Word32
crc32Sink

    sizeDataSink :: MonadResource m => ConduitT ByteString Void m Int
    sizeDataSink :: forall (m :: * -> *).
MonadResource m =>
ConduitT ByteString Void m Int
sizeDataSink  = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) i r r'.
Monad m =>
ConduitT i Void m r
-> ConduitT i Void m r' -> ConduitT i Void m (r, r')
CI.zipSinks forall (m :: * -> *). Monad m => ConduitT ByteString Void m Int
sizeSink (forall (m :: * -> *) o.
MonadIO m =>
Handle -> ConduitT ByteString o m ()
CC.sinkHandle Handle
h)


-- Writes data descriptor fields (crc-32, compressed size and
-- uncompressed size) in the middle of the local file header.
writeDataDescriptorFields :: Handle -> DataDescriptor -> Integer -> IO ()
writeDataDescriptorFields :: Handle -> DataDescriptor -> Integer -> IO ()
writeDataDescriptorFields Handle
h DataDescriptor
dd Integer
offset = do
    Integer
old <- Handle -> IO Integer
hTell Handle
h
    Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek forall a b. (a -> b) -> a -> b
$ Integer
offset forall a. Num a => a -> a -> a
+ Integer
4 forall a. Num a => a -> a -> a
+ Integer
2 forall a. Num a => a -> a -> a
+ Integer
2 forall a. Num a => a -> a -> a
+ Integer
2 forall a. Num a => a -> a -> a
+ Integer
2 forall a. Num a => a -> a -> a
+ Integer
2
    Handle -> DataDescriptor -> IO ()
writeDataDescriptor Handle
h DataDescriptor
dd
    Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
old


updateZip :: Zip -> FileHeader -> DataDescriptor -> Zip
updateZip :: Zip -> FileHeader -> DataDescriptor -> Zip
updateZip Zip
zip FileHeader
fh DataDescriptor
dd =
    Zip
zip { zipFileHeaders :: [FileHeader]
zipFileHeaders = Zip -> [FileHeader]
zipFileHeaders Zip
zip
                        forall a. [a] -> [a] -> [a]
++ [ FileHeader
fh { fhCRC32 :: Word32
fhCRC32            = DataDescriptor -> Word32
ddCRC32 DataDescriptor
dd
                                , fhCompressedSize :: Word32
fhCompressedSize   = DataDescriptor -> Word32
ddCompressedSize DataDescriptor
dd
                                , fhUncompressedSize :: Word32
fhUncompressedSize = DataDescriptor -> Word32
ddUncompressedSize DataDescriptor
dd
                                } ]
       , zipCentralDirectoryOffset :: Int
zipCentralDirectoryOffset = Zip -> Int
zipCentralDirectoryOffset Zip
zip
                                   forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileHeader -> Word32
localFileHeaderLength FileHeader
fh forall a. Num a => a -> a -> a
+ DataDescriptor -> Word32
ddCompressedSize DataDescriptor
dd)
       }


writeFinish :: Handle -> Zip -> IO ()
writeFinish :: Handle -> Zip -> IO ()
writeFinish Handle
h Zip
zip = do
    Handle -> CentralDirectory -> IO ()
writeCentralDirectory Handle
h forall a b. (a -> b) -> a -> b
$ [FileHeader] -> CentralDirectory
CentralDirectory (Zip -> [FileHeader]
zipFileHeaders Zip
zip)
    Handle -> Int -> Word32 -> Int -> IO ()
writeEnd Handle
h
             (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ Zip -> [FileHeader]
zipFileHeaders Zip
zip)                      -- total number of entries in the central directory on this disk
             (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map FileHeader -> Word32
fileHeaderLength forall a b. (a -> b) -> a -> b
$ Zip -> [FileHeader]
zipFileHeaders Zip
zip)
             (Zip -> Int
zipCentralDirectoryOffset Zip
zip)


------------------------------------------------------------------------------
-- Deprecated
fileNames :: Archive [FilePath]
fileNames :: Archive [FilePath]
fileNames = Archive [FilePath]
entryNames


getSource :: (MonadThrow m, PrimMonad m, MonadResource m) => FilePath -> Archive (ConduitT () ByteString m ())
getSource :: forall (m :: * -> *).
(MonadThrow m, PrimMonad m, MonadResource m) =>
FilePath -> Archive (ConduitT () ByteString m ())
getSource FilePath
f = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ \Zip
zip -> forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
Zip -> FilePath -> ConduitT () ByteString m ()
sourceFile Zip
zip FilePath
f


getSink :: (MonadThrow m, PrimMonad m, MonadResource m)
        => FilePath -> UTCTime -> Archive (ConduitT ByteString Void m ())
getSink :: forall (m :: * -> *).
(MonadThrow m, PrimMonad m, MonadResource m) =>
FilePath -> UTCTime -> Archive (ConduitT ByteString Void m ())
getSink FilePath
f UTCTime
time = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ \Zip
zip -> do
                            forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
Zip
-> FilePath
-> CompressionMethod
-> UTCTime
-> ConduitT ByteString Void m Zip
sinkFile Zip
zip FilePath
f CompressionMethod
Deflate UTCTime
time
                            forall (m :: * -> *) a. Monad m => a -> m a
return ()