module Codec.Archive.Zip.Internal where

import           Prelude hiding (readFile)
import           Control.Monad (unless)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as B (hGet, hPut, length, pack, empty)
import           Data.Serialize (Get, Put, getByteString, getWord16le, getWord32le, putByteString, putWord16le, putWord32le, runPut, skip)
import           Data.Time (UTCTime)
import           Data.Word (Word16, Word32)
import           System.IO (Handle, SeekMode(..), hFileSize, hSeek, hTell)

import           Data.ByteString.UTF8 (fromString, toString)

import           Codec.Archive.Zip.Util


calculateFileDataOffset :: Handle -> FileHeader -> IO Integer
calculateFileDataOffset :: Handle -> FileHeader -> IO Integer
calculateFileDataOffset Handle
h FileHeader
fh = do
    Integer
lfhLength <- Handle -> FileHeader -> IO Integer
readLocalFileHeaderLength Handle
h FileHeader
fh
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileHeader -> Word32
fhRelativeOffset FileHeader
fh) forall a. Num a => a -> a -> a
+ Integer
lfhLength


------------------------------------------------------------------------------
-- Overall zipfile format:
--   [local file header + file data + data_descriptor] . . .
--   [central directory] end of central directory record


------------------------------------------------------------------------------
-- Local file header:
--
-- local file header signature     4 bytes  (0x04034b50)
-- version needed to extract       2 bytes
-- general purpose bit flag        2 bytes
-- compression method              2 bytes
-- last mod file time              2 bytes
-- last mod file date              2 bytes
-- crc-32                          4 bytes
-- compressed size                 4 bytes
-- uncompressed size               4 bytes
-- file name length                2 bytes
-- extra field length              2 bytes
--
-- file name (variable size)
-- extra field (variable size)

localFileHeaderConstantLength :: Int
localFileHeaderConstantLength :: Int
localFileHeaderConstantLength = Int
4 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2


readLocalFileHeaderLength :: Handle -> FileHeader -> IO Integer
readLocalFileHeaderLength :: Handle -> FileHeader -> IO Integer
readLocalFileHeaderLength Handle
h FileHeader
header =
    forall a. Get a -> ByteString -> a
runGet' Get Integer
getLocalFileHeaderLength forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> FileHeader -> IO ByteString
hGetLocalFileHeader Handle
h FileHeader
header


-- Gets length of the local file header, i.e. sum of lengths of its
-- constant and variable parts.
getLocalFileHeaderLength :: Get Integer
getLocalFileHeaderLength :: Get Integer
getLocalFileHeaderLength = do
    Word32 -> Get ()
signature Word32
0x04034b50
    Int -> Get ()
skip forall a b. (a -> b) -> a -> b
$ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
+ Int
4
    Integer
fileNameLength    <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
    Integer
extraFieldLength  <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
localFileHeaderConstantLength
           forall a. Num a => a -> a -> a
+ Integer
fileNameLength
           forall a. Num a => a -> a -> a
+ Integer
extraFieldLength


writeLocalFileHeader :: Handle -> FileHeader -> IO ()
writeLocalFileHeader :: Handle -> FileHeader -> IO ()
writeLocalFileHeader Handle
h FileHeader
fh =
    Handle -> ByteString -> IO ()
B.hPut Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ FileHeader -> Put
putLocalFileHeader FileHeader
fh


putLocalFileHeader :: FileHeader -> Put
putLocalFileHeader :: FileHeader -> Put
putLocalFileHeader FileHeader
fh = do
    Putter Word32
putWord32le Word32
0x04034b50
    Putter Word16
putWord16le Word16
20  -- version needed to extract (>= 2.0)
    Putter Word16
putWord16le forall a b. (a -> b) -> a -> b
$ FileHeader -> Word16
fhBitFlag FileHeader
fh
    Putter Word16
putWord16le Word16
compressionMethod
    Putter Word16
putWord16le forall a b. (a -> b) -> a -> b
$ MSDOSDateTime -> Word16
msDOSTime MSDOSDateTime
modTime
    Putter Word16
putWord16le forall a b. (a -> b) -> a -> b
$ MSDOSDateTime -> Word16
msDOSDate MSDOSDateTime
modTime
    Putter Word32
putWord32le forall a b. (a -> b) -> a -> b
$ FileHeader -> Word32
fhCRC32 FileHeader
fh
    Putter Word32
putWord32le forall a b. (a -> b) -> a -> b
$ FileHeader -> Word32
fhCompressedSize FileHeader
fh
    Putter Word32
putWord32le forall a b. (a -> b) -> a -> b
$ FileHeader -> Word32
fhUncompressedSize FileHeader
fh
    Putter Word16
putWord16le forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
fromString forall a b. (a -> b) -> a -> b
$ FileHeader -> FilePath
fhFileName FileHeader
fh
    Putter Word16
putWord16le forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length forall a b. (a -> b) -> a -> b
$ FileHeader -> ByteString
fhExtraField FileHeader
fh
    ByteString -> Put
putByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
fromString forall a b. (a -> b) -> a -> b
$ FileHeader -> FilePath
fhFileName FileHeader
fh
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ FileHeader -> ByteString
fhExtraField FileHeader
fh
  where
    modTime :: MSDOSDateTime
modTime = UTCTime -> MSDOSDateTime
utcTimeToMSDOSDateTime forall a b. (a -> b) -> a -> b
$ FileHeader -> UTCTime
fhLastModified FileHeader
fh
    compressionMethod :: Word16
compressionMethod = case FileHeader -> CompressionMethod
fhCompressionMethod FileHeader
fh of
                          CompressionMethod
NoCompression -> Word16
0
                          CompressionMethod
Deflate       -> Word16
8


-- Gets constant part of the local file header.
hGetLocalFileHeader :: Handle -> FileHeader -> IO ByteString
hGetLocalFileHeader :: Handle -> FileHeader -> IO ByteString
hGetLocalFileHeader Handle
h FileHeader
fh = do
    Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
offset
    Handle -> Int -> IO ByteString
B.hGet Handle
h Int
localFileHeaderConstantLength
  where
    offset :: Integer
offset = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ FileHeader -> Word32
fhRelativeOffset FileHeader
fh


localFileHeaderLength :: FileHeader -> Word32
localFileHeaderLength :: FileHeader -> Word32
localFileHeaderLength FileHeader
fh =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
4 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2
               forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (FileHeader -> FilePath
fhFileName FileHeader
fh) forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length (FileHeader -> ByteString
fhExtraField FileHeader
fh)


------------------------------------------------------------------------------
-- Data descriptor
--
-- crc-32                          4 bytes
-- compressed size                 4 bytes
-- uncompressed size               4 bytes
data DataDescriptor = DataDescriptor
    { DataDescriptor -> Word32
ddCRC32            :: Word32
    , DataDescriptor -> Word32
ddCompressedSize   :: Word32
    , DataDescriptor -> Word32
ddUncompressedSize :: Word32
    } deriving (Int -> DataDescriptor -> ShowS
[DataDescriptor] -> ShowS
DataDescriptor -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DataDescriptor] -> ShowS
$cshowList :: [DataDescriptor] -> ShowS
show :: DataDescriptor -> FilePath
$cshow :: DataDescriptor -> FilePath
showsPrec :: Int -> DataDescriptor -> ShowS
$cshowsPrec :: Int -> DataDescriptor -> ShowS
Show)


writeDataDescriptor :: Handle -> DataDescriptor -> IO ()
writeDataDescriptor :: Handle -> DataDescriptor -> IO ()
writeDataDescriptor Handle
h DataDescriptor
dd =
    Handle -> ByteString -> IO ()
B.hPut Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ DataDescriptor -> Put
putDataDescriptor DataDescriptor
dd


putDataDescriptor :: DataDescriptor -> Put
putDataDescriptor :: DataDescriptor -> Put
putDataDescriptor DataDescriptor
dd = do
--    putWord32le 0x08074b50
    Putter Word32
putWord32le forall a b. (a -> b) -> a -> b
$ DataDescriptor -> Word32
ddCRC32 DataDescriptor
dd
    Putter Word32
putWord32le forall a b. (a -> b) -> a -> b
$ DataDescriptor -> Word32
ddCompressedSize DataDescriptor
dd
    Putter Word32
putWord32le forall a b. (a -> b) -> a -> b
$ DataDescriptor -> Word32
ddUncompressedSize DataDescriptor
dd


------------------------------------------------------------------------------
-- Central directory structure:
--
-- [file header 1]
-- ...
-- [file header n]

data CentralDirectory = CentralDirectory
    { CentralDirectory -> [FileHeader]
cdFileHeaders      :: [FileHeader]
    } deriving (Int -> CentralDirectory -> ShowS
[CentralDirectory] -> ShowS
CentralDirectory -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CentralDirectory] -> ShowS
$cshowList :: [CentralDirectory] -> ShowS
show :: CentralDirectory -> FilePath
$cshow :: CentralDirectory -> FilePath
showsPrec :: Int -> CentralDirectory -> ShowS
$cshowsPrec :: Int -> CentralDirectory -> ShowS
Show)


readCentralDirectory :: Handle -> End -> IO CentralDirectory
readCentralDirectory :: Handle -> End -> IO CentralDirectory
readCentralDirectory Handle
h End
e =
    forall a. Get a -> ByteString -> a
runGet' Get CentralDirectory
getCentralDirectory forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> End -> IO ByteString
hGetCentralDirectory Handle
h End
e


writeCentralDirectory :: Handle -> CentralDirectory -> IO ()
writeCentralDirectory :: Handle -> CentralDirectory -> IO ()
writeCentralDirectory Handle
h CentralDirectory
cd =
    Handle -> ByteString -> IO ()
B.hPut Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ CentralDirectory -> Put
putCentralDirectory CentralDirectory
cd


putCentralDirectory :: CentralDirectory -> Put
putCentralDirectory :: CentralDirectory -> Put
putCentralDirectory CentralDirectory
cd =
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FileHeader -> Put
putFileHeader forall a b. (a -> b) -> a -> b
$ CentralDirectory -> [FileHeader]
cdFileHeaders CentralDirectory
cd


getCentralDirectory :: Get CentralDirectory
getCentralDirectory :: Get CentralDirectory
getCentralDirectory = do
    [FileHeader]
headers <- forall (m :: * -> *) a.
(Monad m, Functor m) =>
m (Maybe a) -> m [a]
many forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> Get (Maybe a)
maybeEmpty forall a b. (a -> b) -> a -> b
$ Get FileHeader
getFileHeader
    forall (m :: * -> *) a. Monad m => a -> m a
return CentralDirectory { cdFileHeaders :: [FileHeader]
cdFileHeaders = [FileHeader]
headers }


hGetCentralDirectory :: Handle -> End -> IO ByteString
hGetCentralDirectory :: Handle -> End -> IO ByteString
hGetCentralDirectory Handle
h End
e = do
    Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset
    Handle -> Int -> IO ByteString
B.hGet Handle
h Int
size
  where
    size :: Int
size   = End -> Int
endCentralDirectorySize End
e
    offset :: Int
offset = End -> Int
endCentralDirectoryOffset End
e


------------------------------------------------------------------------------
-- File header:
--
-- central file header signature   4 bytes  (0x02014b50)
-- version made by                 2 bytes
-- version needed to extract       2 bytes
-- general purpose bit flag        2 bytes
-- compression method              2 bytes
-- last mod file time              2 bytes
-- last mod file date              2 bytes
-- crc-32                          4 bytes
-- compressed size                 4 bytes
-- uncompressed size               4 bytes
-- file name length                2 bytes
-- extra field length              2 bytes
-- file comment length             2 bytes
-- disk number start               2 bytes
-- internal file attributes        2 bytes
-- external file attributes        4 bytes
-- relative offset of local header 4 bytes

-- file name (variable size)
-- extra field (variable size)
-- file comment (variable size)

data FileHeader = FileHeader
    { FileHeader -> Word16
fhBitFlag                :: Word16
    , FileHeader -> CompressionMethod
fhCompressionMethod      :: CompressionMethod
    , FileHeader -> UTCTime
fhLastModified           :: UTCTime
    , FileHeader -> Word32
fhCRC32                  :: Word32
    , FileHeader -> Word32
fhCompressedSize         :: Word32
    , FileHeader -> Word32
fhUncompressedSize       :: Word32
    , FileHeader -> Word16
fhInternalFileAttributes :: Word16
    , FileHeader -> Word32
fhExternalFileAttributes :: Word32
    , FileHeader -> Word32
fhRelativeOffset         :: Word32
    , FileHeader -> FilePath
fhFileName               :: FilePath
    , FileHeader -> ByteString
fhExtraField             :: ByteString
    , FileHeader -> ByteString
fhFileComment            :: ByteString
    } deriving (Int -> FileHeader -> ShowS
[FileHeader] -> ShowS
FileHeader -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FileHeader] -> ShowS
$cshowList :: [FileHeader] -> ShowS
show :: FileHeader -> FilePath
$cshow :: FileHeader -> FilePath
showsPrec :: Int -> FileHeader -> ShowS
$cshowsPrec :: Int -> FileHeader -> ShowS
Show)


data CompressionMethod = NoCompression
                       | Deflate
                         deriving (Int -> CompressionMethod -> ShowS
[CompressionMethod] -> ShowS
CompressionMethod -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CompressionMethod] -> ShowS
$cshowList :: [CompressionMethod] -> ShowS
show :: CompressionMethod -> FilePath
$cshow :: CompressionMethod -> FilePath
showsPrec :: Int -> CompressionMethod -> ShowS
$cshowsPrec :: Int -> CompressionMethod -> ShowS
Show)


getFileHeader :: Get FileHeader
getFileHeader :: Get FileHeader
getFileHeader = do
    Word32 -> Get ()
signature Word32
0x02014b50
    Int -> Get ()
skip Int
2
    Word16
versionNeededToExtract <- Get Word16
getWord16le
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word16
versionNeededToExtract forall a. Ord a => a -> a -> Bool
<= Word16
20) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"This archive requires zip >= 2.0 to extract."
    Word16
bitFlag                <- Get Word16
getWord16le
    Word16
rawCompressionMethod   <- Get Word16
getWord16le
    CompressionMethod
compessionMethod       <- case Word16
rawCompressionMethod of
                                Word16
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return CompressionMethod
NoCompression
                                Word16
8 -> forall (m :: * -> *) a. Monad m => a -> m a
return CompressionMethod
Deflate
                                Word16
_ -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown compression method "
                                          forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Word16
rawCompressionMethod
    Word16
lastModFileTime        <- Get Word16
getWord16le
    Word16
lastModFileDate        <- Get Word16
getWord16le
    Word32
crc32                  <- Get Word32
getWord32le
    Word32
compressedSize         <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
    Word32
uncompressedSize       <- Get Word32
getWord32le
    Int
fileNameLength         <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
    Int
extraFieldLength       <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
    Int
fileCommentLength      <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
    Int -> Get ()
skip Int
2
    Word16
internalFileAttributes <- Get Word16
getWord16le
    Word32
externalFileAttributes <- Get Word32
getWord32le
    Word32
relativeOffset         <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
    ByteString
fileName               <- Int -> Get ByteString
getByteString Int
fileNameLength
    ByteString
extraField             <- Int -> Get ByteString
getByteString Int
extraFieldLength
    ByteString
fileComment            <- Int -> Get ByteString
getByteString Int
fileCommentLength
    forall (m :: * -> *) a. Monad m => a -> m a
return FileHeader
               { fhBitFlag :: Word16
fhBitFlag                = Word16
bitFlag
               , fhCompressionMethod :: CompressionMethod
fhCompressionMethod      = CompressionMethod
compessionMethod
               , fhLastModified :: UTCTime
fhLastModified           = Word16 -> Word16 -> UTCTime
toUTC Word16
lastModFileDate Word16
lastModFileTime
               , fhCRC32 :: Word32
fhCRC32                  = Word32
crc32
               , fhCompressedSize :: Word32
fhCompressedSize         = Word32
compressedSize
               , fhUncompressedSize :: Word32
fhUncompressedSize       = Word32
uncompressedSize
               , fhInternalFileAttributes :: Word16
fhInternalFileAttributes = Word16
internalFileAttributes
               , fhExternalFileAttributes :: Word32
fhExternalFileAttributes = Word32
externalFileAttributes
               , fhRelativeOffset :: Word32
fhRelativeOffset         = Word32
relativeOffset
               , fhFileName :: FilePath
fhFileName               = ByteString -> FilePath
toString ByteString
fileName
               , fhExtraField :: ByteString
fhExtraField             = ByteString
extraField
               , fhFileComment :: ByteString
fhFileComment            = ByteString
fileComment
               }
  where
    toUTC :: Word16 -> Word16 -> UTCTime
toUTC Word16
date Word16
time =
        MSDOSDateTime -> UTCTime
msDOSDateTimeToUTCTime MSDOSDateTime { msDOSDate :: Word16
msDOSDate = Word16
date
                                             , msDOSTime :: Word16
msDOSTime = Word16
time
                                             }


putFileHeader :: FileHeader -> Put
putFileHeader :: FileHeader -> Put
putFileHeader FileHeader
fh = do
    Putter Word32
putWord32le Word32
0x02014b50
    Putter Word16
putWord16le Word16
0   -- version made by
    Putter Word16
putWord16le Word16
20  -- version needed to extract (>= 2.0)
    Putter Word16
putWord16le forall a b. (a -> b) -> a -> b
$ FileHeader -> Word16
fhBitFlag FileHeader
fh
    Putter Word16
putWord16le Word16
compressionMethod
    Putter Word16
putWord16le forall a b. (a -> b) -> a -> b
$ MSDOSDateTime -> Word16
msDOSTime MSDOSDateTime
modTime
    Putter Word16
putWord16le forall a b. (a -> b) -> a -> b
$ MSDOSDateTime -> Word16
msDOSDate MSDOSDateTime
modTime
    Putter Word32
putWord32le forall a b. (a -> b) -> a -> b
$ FileHeader -> Word32
fhCRC32 FileHeader
fh
    Putter Word32
putWord32le forall a b. (a -> b) -> a -> b
$ FileHeader -> Word32
fhCompressedSize FileHeader
fh
    Putter Word32
putWord32le forall a b. (a -> b) -> a -> b
$ FileHeader -> Word32
fhUncompressedSize FileHeader
fh
    Putter Word16
putWord16le forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
fromString forall a b. (a -> b) -> a -> b
$ FileHeader -> FilePath
fhFileName FileHeader
fh
    Putter Word16
putWord16le forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length forall a b. (a -> b) -> a -> b
$ FileHeader -> ByteString
fhExtraField FileHeader
fh
    Putter Word16
putWord16le forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length forall a b. (a -> b) -> a -> b
$ FileHeader -> ByteString
fhFileComment FileHeader
fh
    Putter Word16
putWord16le Word16
0  -- disk number start
    Putter Word16
putWord16le forall a b. (a -> b) -> a -> b
$ FileHeader -> Word16
fhInternalFileAttributes FileHeader
fh
    Putter Word32
putWord32le forall a b. (a -> b) -> a -> b
$ FileHeader -> Word32
fhExternalFileAttributes FileHeader
fh
    Putter Word32
putWord32le forall a b. (a -> b) -> a -> b
$ FileHeader -> Word32
fhRelativeOffset FileHeader
fh
    ByteString -> Put
putByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
fromString forall a b. (a -> b) -> a -> b
$ FileHeader -> FilePath
fhFileName FileHeader
fh
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ FileHeader -> ByteString
fhExtraField FileHeader
fh
    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ FileHeader -> ByteString
fhFileComment FileHeader
fh
  where
    modTime :: MSDOSDateTime
modTime = UTCTime -> MSDOSDateTime
utcTimeToMSDOSDateTime forall a b. (a -> b) -> a -> b
$ FileHeader -> UTCTime
fhLastModified FileHeader
fh
    compressionMethod :: Word16
compressionMethod = case FileHeader -> CompressionMethod
fhCompressionMethod FileHeader
fh of
                          CompressionMethod
NoCompression -> Word16
0
                          CompressionMethod
Deflate       -> Word16
8


fileHeaderLength :: FileHeader -> Word32
fileHeaderLength :: FileHeader -> Word32
fileHeaderLength FileHeader
fh =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
4 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
+ Int
4
               forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (FileHeader -> FilePath
fhFileName FileHeader
fh) forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length (FileHeader -> ByteString
fhExtraField FileHeader
fh)
               forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length (FileHeader -> ByteString
fhFileComment FileHeader
fh)


------------------------------------------------------------------------------
-- End of central directory record:
--
-- end of central dir signature    4 bytes  (0x06054b50)
-- number of this disk             2 bytes
-- number of the disk with the
-- start of the central directory  2 bytes
-- total number of entries in the
-- central directory on this disk  2 bytes
-- total number of entries in
-- the central directory           2 bytes
-- size of the central directory   4 bytes
-- offset of start of central
-- directory with respect to
-- the starting disk number        4 bytes
-- .ZIP file comment length        2 bytes
-- .ZIP file comment       (variable size)

data End = End
    { End -> Int
endCentralDirectorySize   :: Int
    , End -> Int
endCentralDirectoryOffset :: Int
    , End -> ByteString
endZipComment             :: ByteString
    } deriving (Int -> End -> ShowS
[End] -> ShowS
End -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [End] -> ShowS
$cshowList :: [End] -> ShowS
show :: End -> FilePath
$cshow :: End -> FilePath
showsPrec :: Int -> End -> ShowS
$cshowsPrec :: Int -> End -> ShowS
Show)


readEnd :: Handle -> IO End
readEnd :: Handle -> IO End
readEnd Handle
h =
    forall a. Get a -> ByteString -> a
runGet' Get End
getEnd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ByteString
hGetEnd Handle
h


getEnd :: Get End
getEnd :: Get End
getEnd = do
   Int -> Get ()
skip forall a b. (a -> b) -> a -> b
$ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
+ Int
2
   Int
size          <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
   Int
offset        <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
   Int
commentLength <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
   ByteString
comment       <- Int -> Get ByteString
getByteString Int
commentLength
   forall (m :: * -> *) a. Monad m => a -> m a
return End { endCentralDirectorySize :: Int
endCentralDirectorySize   = Int
size
              , endCentralDirectoryOffset :: Int
endCentralDirectoryOffset = Int
offset
              , endZipComment :: ByteString
endZipComment             = ByteString
comment
              }


-- TODO: find a better way to find the end of central dir signature
hGetEnd :: Handle -> IO ByteString
hGetEnd :: Handle -> IO ByteString
hGetEnd Handle
h = do
    Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
SeekFromEnd (-Integer
4)
    IO ByteString
loop
  where
    loop :: IO ByteString
loop = do
        ByteString
s <- Handle -> Int -> IO ByteString
B.hGet Handle
h Int
4

        if ByteString
s forall a. Eq a => a -> a -> Bool
== [Word8] -> ByteString
B.pack (forall a. [a] -> [a]
reverse [Word8
0x06, Word8
0x05, Word8
0x4b, Word8
0x50])
          then IO ByteString
get
          else IO ByteString
next

    get :: IO ByteString
get = do
        Integer
size   <- Handle -> IO Integer
hFileSize Handle
h
        Integer
offset <- Handle -> IO Integer
hTell Handle
h
        Handle -> Int -> IO ByteString
B.hGet Handle
h forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
size forall a. Num a => a -> a -> a
- Integer
offset)

    next :: IO ByteString
next = do
        Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
RelativeSeek (-Integer
5)
        IO ByteString
loop


writeEnd :: Handle -> Int -> Word32 -> Int -> IO ()
writeEnd :: Handle -> Int -> Word32 -> Int -> IO ()
writeEnd Handle
h Int
number Word32
size Int
offset =
     Handle -> ByteString -> IO ()
B.hPut Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ Int -> Word32 -> Int -> Put
putEnd Int
number Word32
size Int
offset


putEnd :: Int -> Word32 -> Int -> Put
putEnd :: Int -> Word32 -> Int -> Put
putEnd Int
number Word32
size Int
offset = do
    Putter Word32
putWord32le Word32
0x06054b50
    Putter Word16
putWord16le Word16
0                      -- disk number
    Putter Word16
putWord16le Word16
0                      -- disk number of central directory
    Putter Word16
putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
number  -- number of entries this disk
    Putter Word16
putWord16le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
number  -- number of entries
    Putter Word32
putWord32le Word32
size                   -- size of central directory
    Putter Word32
putWord32le forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset  -- offset of central dir
    -- TODO: put comment
    Putter Word16
putWord16le Word16
0
    ByteString -> Put
putByteString ByteString
B.empty