{-# LANGUAGE CPP #-}
module Codec.Archive.Zip
(
Archive
, withArchive
, getComment
, setComment
, entryNames
, sourceEntry
, sinkEntry
, sinkEntryUncompressed
, extractFiles
, addFiles
, addFilesAs
, 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
type Archive = StateT Zip IO
data Zip = Zip
{ Zip -> FilePath
zipFilePath :: FilePath
, :: [FileHeader]
, Zip -> Int
zipCentralDirectoryOffset :: Int
, :: 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
}
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
= forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Zip -> ByteString
zipComment
setComment :: ByteString -> Archive ()
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 }
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
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'
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
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
addFiles :: [FilePath] -> Archive ()
addFiles :: [FilePath] -> Archive ()
addFiles = ShowS -> [FilePath] -> Archive ()
addFilesAs forall a. a -> a
id
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'
extractFiles :: [FilePath] -> FilePath -> Archive ()
[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)
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
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
FilePath
f CompressionMethod
compression UTCTime
lastModified Word32
relativeOffset =
FileHeader { fhBitFlag :: Word16
fhBitFlag = Word16
2
, 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)
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)
(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)
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 ()