{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ViewPatterns #-}
module Codec.Archive.Zip
(
Archive (..)
, Entry (..)
, CompressionMethod (..)
, EncryptionMethod (..)
, ZipOption (..)
, ZipException (..)
, emptyArchive
, toArchive
, toArchiveOrFail
, fromArchive
, filesInArchive
, addEntryToArchive
, deleteEntryFromArchive
, findEntryByPath
, fromEntry
, fromEncryptedEntry
, isEncryptedEntry
, toEntry
#ifndef _WINDOWS
, isEntrySymbolicLink
, symbolicLinkEntryTarget
, entryCMode
#endif
, readEntry
, writeEntry
#ifndef _WINDOWS
, writeSymbolicLinkEntry
#endif
, addFilesToArchive
, extractFilesFromArchive
) where
import Data.Time.Calendar ( toGregorian, fromGregorian )
import Data.Time.Clock ( UTCTime(..) )
import Data.Time.Clock.POSIX ( posixSecondsToUTCTime, utcTimeToPOSIXSeconds )
import Data.Time.LocalTime ( TimeOfDay(..), timeToTimeOfDay )
import Data.Bits ( shiftL, shiftR, (.&.), (.|.), xor, testBit )
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import Data.List (nub, find, intercalate)
import Data.Data (Data)
import Data.Typeable (Typeable)
import Text.Printf
import System.FilePath
import System.Directory
(doesDirectoryExist, getDirectoryContents,
createDirectoryIfMissing, getModificationTime)
import Control.Monad ( when, unless, zipWithM_ )
import qualified Control.Exception as E
import System.IO ( stderr, hPutStrLn )
import qualified Data.Digest.CRC32 as CRC32
import qualified Data.Map as M
import Control.Applicative
#ifndef _WINDOWS
import System.Posix.Files ( setFileTimes, setFileMode, fileMode, getSymbolicLinkStatus, symbolicLinkMode, readSymbolicLink, isSymbolicLink, unionFileModes, createSymbolicLink, removeLink )
import System.Posix.Types ( CMode(..) )
import Data.List (partition)
import Data.Maybe (fromJust)
#endif
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as C
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Codec.Compression.Zlib.Raw as Zlib
import System.IO.Error (isAlreadyExistsError)
manySig :: Word32 -> Get a -> Get [a]
manySig :: Word32 -> Get a -> Get [a]
manySig Word32
sig Get a
p = do
Word32
sig' <- Get Word32 -> Get Word32
forall a. Get a -> Get a
lookAhead Get Word32
getWord32le
if Word32
sig Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
sig'
then do
a
r <- Get a
p
[a]
rs <- Word32 -> Get a -> Get [a]
forall a. Word32 -> Get a -> Get [a]
manySig Word32
sig Get a
p
[a] -> Get [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Get [a]) -> [a] -> Get [a]
forall a b. (a -> b) -> a -> b
$ a
r a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rs
else [a] -> Get [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
data Archive = Archive
{ Archive -> [Entry]
zEntries :: [Entry]
, Archive -> Maybe ByteString
zSignature :: Maybe B.ByteString
, :: B.ByteString
} deriving (ReadPrec [Archive]
ReadPrec Archive
Int -> ReadS Archive
ReadS [Archive]
(Int -> ReadS Archive)
-> ReadS [Archive]
-> ReadPrec Archive
-> ReadPrec [Archive]
-> Read Archive
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Archive]
$creadListPrec :: ReadPrec [Archive]
readPrec :: ReadPrec Archive
$creadPrec :: ReadPrec Archive
readList :: ReadS [Archive]
$creadList :: ReadS [Archive]
readsPrec :: Int -> ReadS Archive
$creadsPrec :: Int -> ReadS Archive
Read, Int -> Archive -> ShowS
[Archive] -> ShowS
Archive -> String
(Int -> Archive -> ShowS)
-> (Archive -> String) -> ([Archive] -> ShowS) -> Show Archive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Archive] -> ShowS
$cshowList :: [Archive] -> ShowS
show :: Archive -> String
$cshow :: Archive -> String
showsPrec :: Int -> Archive -> ShowS
$cshowsPrec :: Int -> Archive -> ShowS
Show)
instance Binary Archive where
put :: Archive -> Put
put = Archive -> Put
putArchive
get :: Get Archive
get = Get Archive
getArchive
data Entry = Entry
{ Entry -> String
eRelativePath :: FilePath
, Entry -> CompressionMethod
eCompressionMethod :: CompressionMethod
, Entry -> EncryptionMethod
eEncryptionMethod :: EncryptionMethod
, Entry -> Integer
eLastModified :: Integer
, Entry -> Word32
eCRC32 :: Word32
, Entry -> Word32
eCompressedSize :: Word32
, Entry -> Word32
eUncompressedSize :: Word32
, :: B.ByteString
, :: B.ByteString
, Entry -> Word16
eVersionMadeBy :: Word16
, Entry -> Word16
eInternalFileAttributes :: Word16
, Entry -> Word32
eExternalFileAttributes :: Word32
, Entry -> ByteString
eCompressedData :: B.ByteString
} deriving (ReadPrec [Entry]
ReadPrec Entry
Int -> ReadS Entry
ReadS [Entry]
(Int -> ReadS Entry)
-> ReadS [Entry]
-> ReadPrec Entry
-> ReadPrec [Entry]
-> Read Entry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Entry]
$creadListPrec :: ReadPrec [Entry]
readPrec :: ReadPrec Entry
$creadPrec :: ReadPrec Entry
readList :: ReadS [Entry]
$creadList :: ReadS [Entry]
readsPrec :: Int -> ReadS Entry
$creadsPrec :: Int -> ReadS Entry
Read, Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> String
(Int -> Entry -> ShowS)
-> (Entry -> String) -> ([Entry] -> ShowS) -> Show Entry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entry] -> ShowS
$cshowList :: [Entry] -> ShowS
show :: Entry -> String
$cshow :: Entry -> String
showsPrec :: Int -> Entry -> ShowS
$cshowsPrec :: Int -> Entry -> ShowS
Show, Entry -> Entry -> Bool
(Entry -> Entry -> Bool) -> (Entry -> Entry -> Bool) -> Eq Entry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c== :: Entry -> Entry -> Bool
Eq)
data CompressionMethod = Deflate
| NoCompression
deriving (ReadPrec [CompressionMethod]
ReadPrec CompressionMethod
Int -> ReadS CompressionMethod
ReadS [CompressionMethod]
(Int -> ReadS CompressionMethod)
-> ReadS [CompressionMethod]
-> ReadPrec CompressionMethod
-> ReadPrec [CompressionMethod]
-> Read CompressionMethod
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompressionMethod]
$creadListPrec :: ReadPrec [CompressionMethod]
readPrec :: ReadPrec CompressionMethod
$creadPrec :: ReadPrec CompressionMethod
readList :: ReadS [CompressionMethod]
$creadList :: ReadS [CompressionMethod]
readsPrec :: Int -> ReadS CompressionMethod
$creadsPrec :: Int -> ReadS CompressionMethod
Read, Int -> CompressionMethod -> ShowS
[CompressionMethod] -> ShowS
CompressionMethod -> String
(Int -> CompressionMethod -> ShowS)
-> (CompressionMethod -> String)
-> ([CompressionMethod] -> ShowS)
-> Show CompressionMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompressionMethod] -> ShowS
$cshowList :: [CompressionMethod] -> ShowS
show :: CompressionMethod -> String
$cshow :: CompressionMethod -> String
showsPrec :: Int -> CompressionMethod -> ShowS
$cshowsPrec :: Int -> CompressionMethod -> ShowS
Show, CompressionMethod -> CompressionMethod -> Bool
(CompressionMethod -> CompressionMethod -> Bool)
-> (CompressionMethod -> CompressionMethod -> Bool)
-> Eq CompressionMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompressionMethod -> CompressionMethod -> Bool
$c/= :: CompressionMethod -> CompressionMethod -> Bool
== :: CompressionMethod -> CompressionMethod -> Bool
$c== :: CompressionMethod -> CompressionMethod -> Bool
Eq)
data EncryptionMethod = NoEncryption
| PKWAREEncryption Word8
deriving (ReadPrec [EncryptionMethod]
ReadPrec EncryptionMethod
Int -> ReadS EncryptionMethod
ReadS [EncryptionMethod]
(Int -> ReadS EncryptionMethod)
-> ReadS [EncryptionMethod]
-> ReadPrec EncryptionMethod
-> ReadPrec [EncryptionMethod]
-> Read EncryptionMethod
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EncryptionMethod]
$creadListPrec :: ReadPrec [EncryptionMethod]
readPrec :: ReadPrec EncryptionMethod
$creadPrec :: ReadPrec EncryptionMethod
readList :: ReadS [EncryptionMethod]
$creadList :: ReadS [EncryptionMethod]
readsPrec :: Int -> ReadS EncryptionMethod
$creadsPrec :: Int -> ReadS EncryptionMethod
Read, Int -> EncryptionMethod -> ShowS
[EncryptionMethod] -> ShowS
EncryptionMethod -> String
(Int -> EncryptionMethod -> ShowS)
-> (EncryptionMethod -> String)
-> ([EncryptionMethod] -> ShowS)
-> Show EncryptionMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncryptionMethod] -> ShowS
$cshowList :: [EncryptionMethod] -> ShowS
show :: EncryptionMethod -> String
$cshow :: EncryptionMethod -> String
showsPrec :: Int -> EncryptionMethod -> ShowS
$cshowsPrec :: Int -> EncryptionMethod -> ShowS
Show, EncryptionMethod -> EncryptionMethod -> Bool
(EncryptionMethod -> EncryptionMethod -> Bool)
-> (EncryptionMethod -> EncryptionMethod -> Bool)
-> Eq EncryptionMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncryptionMethod -> EncryptionMethod -> Bool
$c/= :: EncryptionMethod -> EncryptionMethod -> Bool
== :: EncryptionMethod -> EncryptionMethod -> Bool
$c== :: EncryptionMethod -> EncryptionMethod -> Bool
Eq)
data PKWAREVerificationType = CheckTimeByte
| CheckCRCByte
deriving (ReadPrec [PKWAREVerificationType]
ReadPrec PKWAREVerificationType
Int -> ReadS PKWAREVerificationType
ReadS [PKWAREVerificationType]
(Int -> ReadS PKWAREVerificationType)
-> ReadS [PKWAREVerificationType]
-> ReadPrec PKWAREVerificationType
-> ReadPrec [PKWAREVerificationType]
-> Read PKWAREVerificationType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PKWAREVerificationType]
$creadListPrec :: ReadPrec [PKWAREVerificationType]
readPrec :: ReadPrec PKWAREVerificationType
$creadPrec :: ReadPrec PKWAREVerificationType
readList :: ReadS [PKWAREVerificationType]
$creadList :: ReadS [PKWAREVerificationType]
readsPrec :: Int -> ReadS PKWAREVerificationType
$creadsPrec :: Int -> ReadS PKWAREVerificationType
Read, Int -> PKWAREVerificationType -> ShowS
[PKWAREVerificationType] -> ShowS
PKWAREVerificationType -> String
(Int -> PKWAREVerificationType -> ShowS)
-> (PKWAREVerificationType -> String)
-> ([PKWAREVerificationType] -> ShowS)
-> Show PKWAREVerificationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PKWAREVerificationType] -> ShowS
$cshowList :: [PKWAREVerificationType] -> ShowS
show :: PKWAREVerificationType -> String
$cshow :: PKWAREVerificationType -> String
showsPrec :: Int -> PKWAREVerificationType -> ShowS
$cshowsPrec :: Int -> PKWAREVerificationType -> ShowS
Show, PKWAREVerificationType -> PKWAREVerificationType -> Bool
(PKWAREVerificationType -> PKWAREVerificationType -> Bool)
-> (PKWAREVerificationType -> PKWAREVerificationType -> Bool)
-> Eq PKWAREVerificationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PKWAREVerificationType -> PKWAREVerificationType -> Bool
$c/= :: PKWAREVerificationType -> PKWAREVerificationType -> Bool
== :: PKWAREVerificationType -> PKWAREVerificationType -> Bool
$c== :: PKWAREVerificationType -> PKWAREVerificationType -> Bool
Eq)
data ZipOption = OptRecursive
| OptVerbose
| OptDestination FilePath
| OptLocation FilePath Bool
| OptPreserveSymbolicLinks
deriving (ReadPrec [ZipOption]
ReadPrec ZipOption
Int -> ReadS ZipOption
ReadS [ZipOption]
(Int -> ReadS ZipOption)
-> ReadS [ZipOption]
-> ReadPrec ZipOption
-> ReadPrec [ZipOption]
-> Read ZipOption
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ZipOption]
$creadListPrec :: ReadPrec [ZipOption]
readPrec :: ReadPrec ZipOption
$creadPrec :: ReadPrec ZipOption
readList :: ReadS [ZipOption]
$creadList :: ReadS [ZipOption]
readsPrec :: Int -> ReadS ZipOption
$creadsPrec :: Int -> ReadS ZipOption
Read, Int -> ZipOption -> ShowS
[ZipOption] -> ShowS
ZipOption -> String
(Int -> ZipOption -> ShowS)
-> (ZipOption -> String)
-> ([ZipOption] -> ShowS)
-> Show ZipOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZipOption] -> ShowS
$cshowList :: [ZipOption] -> ShowS
show :: ZipOption -> String
$cshow :: ZipOption -> String
showsPrec :: Int -> ZipOption -> ShowS
$cshowsPrec :: Int -> ZipOption -> ShowS
Show, ZipOption -> ZipOption -> Bool
(ZipOption -> ZipOption -> Bool)
-> (ZipOption -> ZipOption -> Bool) -> Eq ZipOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZipOption -> ZipOption -> Bool
$c/= :: ZipOption -> ZipOption -> Bool
== :: ZipOption -> ZipOption -> Bool
$c== :: ZipOption -> ZipOption -> Bool
Eq)
data ZipException =
CRC32Mismatch FilePath
| UnsafePath FilePath
| CannotWriteEncryptedEntry FilePath
deriving (Int -> ZipException -> ShowS
[ZipException] -> ShowS
ZipException -> String
(Int -> ZipException -> ShowS)
-> (ZipException -> String)
-> ([ZipException] -> ShowS)
-> Show ZipException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZipException] -> ShowS
$cshowList :: [ZipException] -> ShowS
show :: ZipException -> String
$cshow :: ZipException -> String
showsPrec :: Int -> ZipException -> ShowS
$cshowsPrec :: Int -> ZipException -> ShowS
Show, Typeable, Typeable ZipException
DataType
Constr
Typeable ZipException
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ZipException -> c ZipException)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ZipException)
-> (ZipException -> Constr)
-> (ZipException -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ZipException))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ZipException))
-> ((forall b. Data b => b -> b) -> ZipException -> ZipException)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ZipException -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipException -> r)
-> (forall u. (forall d. Data d => d -> u) -> ZipException -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> ZipException -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException)
-> Data ZipException
ZipException -> DataType
ZipException -> Constr
(forall b. Data b => b -> b) -> ZipException -> ZipException
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ZipException -> c ZipException
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ZipException
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ZipException -> u
forall u. (forall d. Data d => d -> u) -> ZipException -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ZipException -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipException -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ZipException
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ZipException -> c ZipException
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ZipException)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ZipException)
$cCannotWriteEncryptedEntry :: Constr
$cUnsafePath :: Constr
$cCRC32Mismatch :: Constr
$tZipException :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ZipException -> m ZipException
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException
gmapMp :: (forall d. Data d => d -> m d) -> ZipException -> m ZipException
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException
gmapM :: (forall d. Data d => d -> m d) -> ZipException -> m ZipException
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ZipException -> m ZipException
gmapQi :: Int -> (forall d. Data d => d -> u) -> ZipException -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ZipException -> u
gmapQ :: (forall d. Data d => d -> u) -> ZipException -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ZipException -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipException -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ZipException -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ZipException -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ZipException -> r
gmapT :: (forall b. Data b => b -> b) -> ZipException -> ZipException
$cgmapT :: (forall b. Data b => b -> b) -> ZipException -> ZipException
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ZipException)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ZipException)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ZipException)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ZipException)
dataTypeOf :: ZipException -> DataType
$cdataTypeOf :: ZipException -> DataType
toConstr :: ZipException -> Constr
$ctoConstr :: ZipException -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ZipException
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ZipException
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ZipException -> c ZipException
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ZipException -> c ZipException
$cp1Data :: Typeable ZipException
Data, ZipException -> ZipException -> Bool
(ZipException -> ZipException -> Bool)
-> (ZipException -> ZipException -> Bool) -> Eq ZipException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZipException -> ZipException -> Bool
$c/= :: ZipException -> ZipException -> Bool
== :: ZipException -> ZipException -> Bool
$c== :: ZipException -> ZipException -> Bool
Eq)
instance E.Exception ZipException
emptyArchive :: Archive
emptyArchive :: Archive
emptyArchive = Archive :: [Entry] -> Maybe ByteString -> ByteString -> Archive
Archive
{ zEntries :: [Entry]
zEntries = []
, zSignature :: Maybe ByteString
zSignature = Maybe ByteString
forall a. Maybe a
Nothing
, zComment :: ByteString
zComment = ByteString
B.empty }
toArchive :: B.ByteString -> Archive
toArchive :: ByteString -> Archive
toArchive = ByteString -> Archive
forall a. Binary a => ByteString -> a
decode
toArchiveOrFail :: B.ByteString -> Either String Archive
#if MIN_VERSION_binary(0,7,0)
toArchiveOrFail :: ByteString -> Either String Archive
toArchiveOrFail ByteString
bs = case ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, Archive)
forall a.
Binary a =>
ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
decodeOrFail ByteString
bs of
Left (ByteString
_,ByteOffset
_,String
e) -> String -> Either String Archive
forall a b. a -> Either a b
Left String
e
Right (ByteString
_,ByteOffset
_,Archive
x) -> Archive -> Either String Archive
forall a b. b -> Either a b
Right Archive
x
#else
toArchiveOrFail bs = Right $ toArchive bs
#endif
fromArchive :: Archive -> B.ByteString
fromArchive :: Archive -> ByteString
fromArchive = Archive -> ByteString
forall a. Binary a => a -> ByteString
encode
filesInArchive :: Archive -> [FilePath]
filesInArchive :: Archive -> [String]
filesInArchive = (Entry -> String) -> [Entry] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> String
eRelativePath ([Entry] -> [String])
-> (Archive -> [Entry]) -> Archive -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Archive -> [Entry]
zEntries
addEntryToArchive :: Entry -> Archive -> Archive
addEntryToArchive :: Entry -> Archive -> Archive
addEntryToArchive Entry
entry Archive
archive =
let archive' :: Archive
archive' = String -> Archive -> Archive
deleteEntryFromArchive (Entry -> String
eRelativePath Entry
entry) Archive
archive
oldEntries :: [Entry]
oldEntries = Archive -> [Entry]
zEntries Archive
archive'
in Archive
archive' { zEntries :: [Entry]
zEntries = Entry
entry Entry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
: [Entry]
oldEntries }
deleteEntryFromArchive :: FilePath -> Archive -> Archive
deleteEntryFromArchive :: String -> Archive -> Archive
deleteEntryFromArchive String
path Archive
archive =
Archive
archive { zEntries :: [Entry]
zEntries = [Entry
e | Entry
e <- Archive -> [Entry]
zEntries Archive
archive
, Bool -> Bool
not (Entry -> String
eRelativePath Entry
e String -> String -> Bool
`matches` String
path)] }
findEntryByPath :: FilePath -> Archive -> Maybe Entry
findEntryByPath :: String -> Archive -> Maybe Entry
findEntryByPath String
path Archive
archive =
(Entry -> Bool) -> [Entry] -> Maybe Entry
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Entry
e -> String
path String -> String -> Bool
`matches` Entry -> String
eRelativePath Entry
e) (Archive -> [Entry]
zEntries Archive
archive)
fromEntry :: Entry -> B.ByteString
fromEntry :: Entry -> ByteString
fromEntry Entry
entry =
CompressionMethod -> ByteString -> ByteString
decompressData (Entry -> CompressionMethod
eCompressionMethod Entry
entry) (Entry -> ByteString
eCompressedData Entry
entry)
fromEncryptedEntry :: String -> Entry -> Maybe B.ByteString
fromEncryptedEntry :: String -> Entry -> Maybe ByteString
fromEncryptedEntry String
password Entry
entry =
CompressionMethod -> ByteString -> ByteString
decompressData (Entry -> CompressionMethod
eCompressionMethod Entry
entry) (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> EncryptionMethod -> ByteString -> Maybe ByteString
decryptData String
password (Entry -> EncryptionMethod
eEncryptionMethod Entry
entry) (Entry -> ByteString
eCompressedData Entry
entry)
isEncryptedEntry :: Entry -> Bool
isEncryptedEntry :: Entry -> Bool
isEncryptedEntry Entry
entry =
case Entry -> EncryptionMethod
eEncryptionMethod Entry
entry of
(PKWAREEncryption Word8
_) -> Bool
True
EncryptionMethod
_ -> Bool
False
toEntry :: FilePath
-> Integer
-> B.ByteString
-> Entry
toEntry :: String -> Integer -> ByteString -> Entry
toEntry String
path Integer
modtime ByteString
contents =
let uncompressedSize :: ByteOffset
uncompressedSize = ByteString -> ByteOffset
B.length ByteString
contents
compressedData :: ByteString
compressedData = CompressionMethod -> ByteString -> ByteString
compressData CompressionMethod
Deflate ByteString
contents
compressedSize :: ByteOffset
compressedSize = ByteString -> ByteOffset
B.length ByteString
compressedData
(CompressionMethod
compressionMethod, ByteString
finalData, ByteOffset
finalSize) =
if ByteOffset
uncompressedSize ByteOffset -> ByteOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteOffset
compressedSize
then (CompressionMethod
NoCompression, ByteString
contents, ByteOffset
uncompressedSize)
else (CompressionMethod
Deflate, ByteString
compressedData, ByteOffset
compressedSize)
crc32 :: Word32
crc32 = ByteString -> Word32
forall a. CRC32 a => a -> Word32
CRC32.crc32 ByteString
contents
in Entry :: String
-> CompressionMethod
-> EncryptionMethod
-> Integer
-> Word32
-> Word32
-> Word32
-> ByteString
-> ByteString
-> Word16
-> Word16
-> Word32
-> ByteString
-> Entry
Entry { eRelativePath :: String
eRelativePath = ShowS
normalizePath String
path
, eCompressionMethod :: CompressionMethod
eCompressionMethod = CompressionMethod
compressionMethod
, eEncryptionMethod :: EncryptionMethod
eEncryptionMethod = EncryptionMethod
NoEncryption
, eLastModified :: Integer
eLastModified = Integer
modtime
, eCRC32 :: Word32
eCRC32 = Word32
crc32
, eCompressedSize :: Word32
eCompressedSize = ByteOffset -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
finalSize
, eUncompressedSize :: Word32
eUncompressedSize = ByteOffset -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
uncompressedSize
, eExtraField :: ByteString
eExtraField = ByteString
B.empty
, eFileComment :: ByteString
eFileComment = ByteString
B.empty
, eVersionMadeBy :: Word16
eVersionMadeBy = Word16
0
, eInternalFileAttributes :: Word16
eInternalFileAttributes = Word16
0
, eExternalFileAttributes :: Word32
eExternalFileAttributes = Word32
0
, eCompressedData :: ByteString
eCompressedData = ByteString
finalData
}
readEntry :: [ZipOption] -> FilePath -> IO Entry
readEntry :: [ZipOption] -> String -> IO Entry
readEntry [ZipOption]
opts String
path = do
Bool
isDir <- String -> IO Bool
doesDirectoryExist String
path
#ifdef _WINDOWS
let isSymLink = False
#else
FileStatus
fs <- String -> IO FileStatus
getSymbolicLinkStatus String
path
let isSymLink :: Bool
isSymLink = FileStatus -> Bool
isSymbolicLink FileStatus
fs
#endif
let path' :: String
path' = let p :: String
p = String
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ (case ShowS
forall a. [a] -> [a]
reverse String
path of
(Char
'/':String
_) -> String
""
String
_ | Bool
isDir Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isSymLink -> String
"/"
String
_ | Bool
isDir Bool -> Bool -> Bool
&& Bool
isSymLink -> String
""
| Bool
otherwise -> String
"") in
(case [(String
l,Bool
a) | OptLocation String
l Bool
a <- [ZipOption]
opts] of
((String
l,Bool
a):[(String, Bool)]
_) -> if Bool
a then String
l String -> ShowS
</> String
p else String
l String -> ShowS
</> ShowS
takeFileName String
p
[(String, Bool)]
_ -> String
p)
ByteString
contents <-
#ifndef _WINDOWS
if Bool
isSymLink
then do
String
linkTarget <- String -> IO String
readSymbolicLink String
path
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
C.pack String
linkTarget
else
#endif
if Bool
isDir
then
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
else
ByteString -> ByteString
B.fromStrict (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
S.readFile String
path
Integer
modEpochTime <- (POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer)
-> (UTCTime -> POSIXTime) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds) (UTCTime -> Integer) -> IO UTCTime -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO UTCTime
getModificationTime String
path
let entry :: Entry
entry = String -> Integer -> ByteString -> Entry
toEntry String
path' Integer
modEpochTime ByteString
contents
Entry
entryE <-
#ifdef _WINDOWS
return $ entry { eVersionMadeBy = 0x0000 }
#else
do
let fm :: FileMode
fm = if Bool
isSymLink
then FileMode -> FileMode -> FileMode
unionFileModes FileMode
symbolicLinkMode (FileStatus -> FileMode
fileMode FileStatus
fs)
else FileStatus -> FileMode
fileMode FileStatus
fs
let modes :: Word32
modes = Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32) -> Integer -> Word32
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftL (FileMode -> Integer
forall a. Integral a => a -> Integer
toInteger FileMode
fm) Int
16
Entry -> IO Entry
forall (m :: * -> *) a. Monad m => a -> m a
return (Entry -> IO Entry) -> Entry -> IO Entry
forall a b. (a -> b) -> a -> b
$ Entry
entry { eExternalFileAttributes :: Word32
eExternalFileAttributes = Word32
modes,
eVersionMadeBy :: Word16
eVersionMadeBy = Word16
0x0300 }
#endif
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ZipOption
OptVerbose ZipOption -> [ZipOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let compmethod :: String
compmethod = case Entry -> CompressionMethod
eCompressionMethod Entry
entryE of
CompressionMethod
Deflate -> (String
"deflated" :: String)
CompressionMethod
NoCompression -> String
"stored"
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> String -> String -> Float -> String
forall r. PrintfType r => String -> r
printf String
" adding: %s (%s %.f%%)" (Entry -> String
eRelativePath Entry
entryE)
String
compmethod (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Entry -> Float
compressionRatio Entry
entryE))
Entry -> IO Entry
forall (m :: * -> *) a. Monad m => a -> m a
return Entry
entryE
checkPath :: FilePath -> IO ()
checkPath :: String -> IO ()
checkPath String
fp =
IO () -> ([String] -> IO ()) -> Maybe [String] -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ZipException -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO (String -> ZipException
UnsafePath String
fp)) (\[String]
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
([String] -> Maybe [String]
resolve ([String] -> Maybe [String])
-> (String -> [String]) -> String -> Maybe [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitDirectories (String -> Maybe [String]) -> String -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ String
fp)
where
resolve :: [String] -> Maybe [String]
resolve =
([String] -> [String]) -> Maybe [String] -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> [String]
forall a. [a] -> [a]
reverse (Maybe [String] -> Maybe [String])
-> ([String] -> Maybe [String]) -> [String] -> Maybe [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [String] -> String -> Maybe [String])
-> Maybe [String] -> [String] -> Maybe [String]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Maybe [String] -> String -> Maybe [String]
forall (m :: * -> *).
MonadFail m =>
m [String] -> String -> m [String]
go ([String] -> Maybe [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
where
go :: m [String] -> String -> m [String]
go m [String]
acc String
x = do
[String]
xs <- m [String]
acc
case String
x of
String
"." -> [String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
xs
String
".." -> case [String]
xs of
[] -> String -> m [String]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"outside of root path"
(String
_:[String]
ys) -> [String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
ys
String
_ -> [String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (String
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
xs)
writeEntry :: [ZipOption] -> Entry -> IO ()
writeEntry :: [ZipOption] -> Entry -> IO ()
writeEntry [ZipOption]
opts Entry
entry = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Entry -> Bool
isEncryptedEntry Entry
entry) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
ZipException -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO (ZipException -> IO ()) -> ZipException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ZipException
CannotWriteEncryptedEntry (Entry -> String
eRelativePath Entry
entry)
let relpath :: String
relpath = Entry -> String
eRelativePath Entry
entry
String -> IO ()
checkPath String
relpath
String
path <- case [String
d | OptDestination String
d <- [ZipOption]
opts] of
(String
x:[String]
_) -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
x String -> ShowS
</> String
relpath)
[] | String -> Bool
isAbsolute String
relpath -> ZipException -> IO String
forall e a. Exception e => e -> IO a
E.throwIO (ZipException -> IO String) -> ZipException -> IO String
forall a b. (a -> b) -> a -> b
$ String -> ZipException
UnsafePath String
relpath
| Bool
otherwise -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
relpath
let dir :: String
dir = ShowS
takeDirectory String
path
Bool
exists <- String -> IO Bool
doesDirectoryExist String
dir
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dir
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ZipOption
OptVerbose ZipOption -> [ZipOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
" creating: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
dir
if Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
path) Bool -> Bool -> Bool
&& String -> Char
forall a. [a] -> a
last String
path Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ZipOption
OptVerbose ZipOption -> [ZipOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ case Entry -> CompressionMethod
eCompressionMethod Entry
entry of
CompressionMethod
Deflate -> String
" inflating: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
CompressionMethod
NoCompression -> String
"extracting: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
path
let uncompressedData :: ByteString
uncompressedData = Entry -> ByteString
fromEntry Entry
entry
if Entry -> Word32
eCRC32 Entry
entry Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Word32
forall a. CRC32 a => a -> Word32
CRC32.crc32 ByteString
uncompressedData
then String -> ByteString -> IO ()
B.writeFile String
path ByteString
uncompressedData
else ZipException -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO (ZipException -> IO ()) -> ZipException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ZipException
CRC32Mismatch String
path
#ifndef _WINDOWS
let modes :: FileMode
modes = Word32 -> FileMode
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> FileMode) -> Word32 -> FileMode
forall a b. (a -> b) -> a -> b
$ Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR (Entry -> Word32
eExternalFileAttributes Entry
entry) Int
16
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Entry -> Word16
eVersionMadeBy Entry
entry Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xFF00 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0x0300 Bool -> Bool -> Bool
&&
FileMode
modes FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
/= FileMode
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> FileMode -> IO ()
setFileMode String
path FileMode
modes
#endif
String -> Integer -> IO ()
setFileTimeStamp String
path (Entry -> Integer
eLastModified Entry
entry)
#ifndef _WINDOWS
writeSymbolicLinkEntry :: [ZipOption] -> Entry -> IO ()
writeSymbolicLinkEntry :: [ZipOption] -> Entry -> IO ()
writeSymbolicLinkEntry [ZipOption]
opts Entry
entry =
if ZipOption
OptPreserveSymbolicLinks ZipOption -> [ZipOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ZipOption]
opts
then [ZipOption] -> Entry -> IO ()
writeEntry [ZipOption]
opts Entry
entry
else do
if Entry -> Bool
isEntrySymbolicLink Entry
entry
then do
let prefixPath :: String
prefixPath = case [String
d | OptDestination String
d <- [ZipOption]
opts] of
(String
x:[String]
_) -> String
x
[String]
_ -> String
""
let targetPath :: String
targetPath = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (Entry -> Maybe String) -> Entry -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> Maybe String
symbolicLinkEntryTarget (Entry -> String) -> Entry -> String
forall a b. (a -> b) -> a -> b
$ Entry
entry
let symlinkPath :: String
symlinkPath = String
prefixPath String -> ShowS
</> Entry -> String
eRelativePath Entry
entry
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ZipOption
OptVerbose ZipOption -> [ZipOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"linking " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
symlinkPath String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
targetPath
String -> String -> IO ()
forceSymLink String
targetPath String
symlinkPath
else [ZipOption] -> Entry -> IO ()
writeEntry [ZipOption]
opts Entry
entry
forceSymLink :: FilePath -> FilePath -> IO ()
forceSymLink :: String -> String -> IO ()
forceSymLink String
target String
linkName =
String -> String -> IO ()
createSymbolicLink String
target String
linkName IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch`
(\IOError
e -> if IOError -> Bool
isAlreadyExistsError IOError
e
then String -> IO ()
removeLink String
linkName IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> String -> IO ()
createSymbolicLink String
target String
linkName
else IOError -> IO ()
forall a. IOError -> IO a
ioError IOError
e)
symbolicLinkEntryTarget :: Entry -> Maybe FilePath
symbolicLinkEntryTarget :: Entry -> Maybe String
symbolicLinkEntryTarget Entry
entry | Entry -> Bool
isEntrySymbolicLink Entry
entry = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (ByteString -> String) -> ByteString -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
C.unpack (ByteString -> Maybe String) -> ByteString -> Maybe String
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
fromEntry Entry
entry
| Bool
otherwise = Maybe String
forall a. Maybe a
Nothing
isEntrySymbolicLink :: Entry -> Bool
isEntrySymbolicLink :: Entry -> Bool
isEntrySymbolicLink Entry
entry = Entry -> FileMode
entryCMode Entry
entry FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.&. FileMode
symbolicLinkMode FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
== FileMode
symbolicLinkMode
entryCMode :: Entry -> CMode
entryCMode :: Entry -> FileMode
entryCMode Entry
entry = Word32 -> FileMode
CMode (Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
shiftR (Entry -> Word32
eExternalFileAttributes Entry
entry) Int
16)
#endif
addFilesToArchive :: [ZipOption] -> Archive -> [FilePath] -> IO Archive
addFilesToArchive :: [ZipOption] -> Archive -> [String] -> IO Archive
addFilesToArchive [ZipOption]
opts Archive
archive [String]
files = do
[String]
filesAndChildren <- if ZipOption
OptRecursive ZipOption -> [ZipOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts
#ifdef _WINDOWS
then mapM getDirectoryContentsRecursive files >>= return . nub . concat
#else
then [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String])
-> ([[String]] -> [String]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([ZipOption] -> String -> IO [String]
getDirectoryContentsRecursive' [ZipOption]
opts) [String]
files
#endif
else [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
files
[Entry]
entries <- (String -> IO Entry) -> [String] -> IO [Entry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([ZipOption] -> String -> IO Entry
readEntry [ZipOption]
opts) [String]
filesAndChildren
Archive -> IO Archive
forall (m :: * -> *) a. Monad m => a -> m a
return (Archive -> IO Archive) -> Archive -> IO Archive
forall a b. (a -> b) -> a -> b
$ (Entry -> Archive -> Archive) -> Archive -> [Entry] -> Archive
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Entry -> Archive -> Archive
addEntryToArchive Archive
archive [Entry]
entries
extractFilesFromArchive :: [ZipOption] -> Archive -> IO ()
[ZipOption]
opts Archive
archive = do
let entries :: [Entry]
entries = Archive -> [Entry]
zEntries Archive
archive
if ZipOption
OptPreserveSymbolicLinks ZipOption -> [ZipOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts
then do
#ifdef _WINDOWS
mapM_ (writeEntry opts) entries
#else
let ([Entry]
symbolicLinkEntries, [Entry]
nonSymbolicLinkEntries) = (Entry -> Bool) -> [Entry] -> ([Entry], [Entry])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Entry -> Bool
isEntrySymbolicLink [Entry]
entries
(Entry -> IO ()) -> [Entry] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ZipOption] -> Entry -> IO ()
writeEntry [ZipOption]
opts) [Entry]
nonSymbolicLinkEntries
(Entry -> IO ()) -> [Entry] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ZipOption] -> Entry -> IO ()
writeSymbolicLinkEntry [ZipOption]
opts) [Entry]
symbolicLinkEntries
#endif
else (Entry -> IO ()) -> [Entry] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([ZipOption] -> Entry -> IO ()
writeEntry [ZipOption]
opts) [Entry]
entries
normalizePath :: FilePath -> String
normalizePath :: ShowS
normalizePath String
path =
let dir :: String
dir = ShowS
takeDirectory String
path
fn :: String
fn = ShowS
takeFileName String
path
dir' :: String
dir' = case String
dir of
#ifdef _WINDOWS
(c:':':d:xs) | isLetter c
, d == '/' || d == '\\'
-> xs
#endif
String
_ -> String
dir
dirParts :: [String]
dirParts = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
".") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
splitDirectories String
dir'
in String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/" ([String]
dirParts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
fn])
matches :: FilePath -> FilePath -> Bool
matches :: String -> String -> Bool
matches String
fp1 String
fp2 = ShowS
normalizePath String
fp1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ShowS
normalizePath String
fp2
compressData :: CompressionMethod -> B.ByteString -> B.ByteString
compressData :: CompressionMethod -> ByteString -> ByteString
compressData CompressionMethod
Deflate = ByteString -> ByteString
Zlib.compress
compressData CompressionMethod
NoCompression = ByteString -> ByteString
forall a. a -> a
id
decompressData :: CompressionMethod -> B.ByteString -> B.ByteString
decompressData :: CompressionMethod -> ByteString -> ByteString
decompressData CompressionMethod
Deflate = ByteString -> ByteString
Zlib.decompress
decompressData CompressionMethod
NoCompression = ByteString -> ByteString
forall a. a -> a
id
decryptData :: String -> EncryptionMethod -> B.ByteString -> Maybe B.ByteString
decryptData :: String -> EncryptionMethod -> ByteString -> Maybe ByteString
decryptData String
_ EncryptionMethod
NoEncryption ByteString
s = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
s
decryptData String
password (PKWAREEncryption Word8
controlByte) ByteString
s =
let headerlen :: ByteOffset
headerlen = ByteOffset
12
initKeys :: (Word32, Word32, Word32)
initKeys = (Word32
305419896, Word32
591751049, Word32
878082192)
startKeys :: (Word32, Word32, Word32)
startKeys = ((Word32, Word32, Word32) -> Word8 -> (Word32, Word32, Word32))
-> (Word32, Word32, Word32)
-> ByteString
-> (Word32, Word32, Word32)
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl (Word32, Word32, Word32) -> Word8 -> (Word32, Word32, Word32)
pkwareUpdateKeys (Word32, Word32, Word32)
initKeys (String -> ByteString
C.pack String
password)
(ByteString
header, ByteString
content) = ByteOffset -> ByteString -> (ByteString, ByteString)
B.splitAt ByteOffset
headerlen (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ ((Word32, Word32, Word32), ByteString) -> ByteString
forall a b. (a, b) -> b
snd (((Word32, Word32, Word32), ByteString) -> ByteString)
-> ((Word32, Word32, Word32), ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ ((Word32, Word32, Word32)
-> Word8 -> ((Word32, Word32, Word32), Word8))
-> (Word32, Word32, Word32)
-> ByteString
-> ((Word32, Word32, Word32), ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
B.mapAccumL (Word32, Word32, Word32)
-> Word8 -> ((Word32, Word32, Word32), Word8)
pkwareDecryptByte (Word32, Word32, Word32)
startKeys ByteString
s
in if ByteString -> Word8
B.last ByteString
header Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
controlByte
then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
content
else Maybe ByteString
forall a. Maybe a
Nothing
type DecryptionCtx = (Word32, Word32, Word32)
pkwareDecryptByte :: DecryptionCtx -> Word8 -> (DecryptionCtx, Word8)
pkwareDecryptByte :: (Word32, Word32, Word32)
-> Word8 -> ((Word32, Word32, Word32), Word8)
pkwareDecryptByte keys :: (Word32, Word32, Word32)
keys@(Word32
_, Word32
_, Word32
key2) Word8
inB =
let tmp :: Word32
tmp = Word32
key2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
2
tmp' :: Word8
tmp' = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
tmp Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* (Word32
tmp Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
1)) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) :: Word8
outB :: Word8
outB = Word8
inB Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
tmp'
in ((Word32, Word32, Word32) -> Word8 -> (Word32, Word32, Word32)
pkwareUpdateKeys (Word32, Word32, Word32)
keys Word8
outB, Word8
outB)
pkwareUpdateKeys :: DecryptionCtx -> Word8 -> DecryptionCtx
pkwareUpdateKeys :: (Word32, Word32, Word32) -> Word8 -> (Word32, Word32, Word32)
pkwareUpdateKeys (Word32
key0, Word32
key1, Word32
key2) Word8
inB =
let key0' :: Word32
key0' = Word32 -> [Word8] -> Word32
forall a. CRC32 a => Word32 -> a -> Word32
CRC32.crc32Update (Word32
key0 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
0xffffffff) [Word8
inB] Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
0xffffffff
key1' :: Word32
key1' = (Word32
key1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ (Word32
key0' Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff)) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
134775813 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1
key1Byte :: Word8
key1Byte = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
key1' Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24) :: Word8
key2' :: Word32
key2' = Word32 -> [Word8] -> Word32
forall a. CRC32 a => Word32 -> a -> Word32
CRC32.crc32Update (Word32
key2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
0xffffffff) [Word8
key1Byte] Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
0xffffffff
in (Word32
key0', Word32
key1', Word32
key2')
compressionRatio :: Entry -> Float
compressionRatio :: Entry -> Float
compressionRatio Entry
entry =
if Entry -> Word32
eUncompressedSize Entry
entry Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
then Float
1
else Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Entry -> Word32
eCompressedSize Entry
entry) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Entry -> Word32
eUncompressedSize Entry
entry)
data MSDOSDateTime = MSDOSDateTime { MSDOSDateTime -> Word16
msDOSDate :: Word16
, MSDOSDateTime -> Word16
msDOSTime :: Word16
} deriving (ReadPrec [MSDOSDateTime]
ReadPrec MSDOSDateTime
Int -> ReadS MSDOSDateTime
ReadS [MSDOSDateTime]
(Int -> ReadS MSDOSDateTime)
-> ReadS [MSDOSDateTime]
-> ReadPrec MSDOSDateTime
-> ReadPrec [MSDOSDateTime]
-> Read MSDOSDateTime
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MSDOSDateTime]
$creadListPrec :: ReadPrec [MSDOSDateTime]
readPrec :: ReadPrec MSDOSDateTime
$creadPrec :: ReadPrec MSDOSDateTime
readList :: ReadS [MSDOSDateTime]
$creadList :: ReadS [MSDOSDateTime]
readsPrec :: Int -> ReadS MSDOSDateTime
$creadsPrec :: Int -> ReadS MSDOSDateTime
Read, Int -> MSDOSDateTime -> ShowS
[MSDOSDateTime] -> ShowS
MSDOSDateTime -> String
(Int -> MSDOSDateTime -> ShowS)
-> (MSDOSDateTime -> String)
-> ([MSDOSDateTime] -> ShowS)
-> Show MSDOSDateTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MSDOSDateTime] -> ShowS
$cshowList :: [MSDOSDateTime] -> ShowS
show :: MSDOSDateTime -> String
$cshow :: MSDOSDateTime -> String
showsPrec :: Int -> MSDOSDateTime -> ShowS
$cshowsPrec :: Int -> MSDOSDateTime -> ShowS
Show, MSDOSDateTime -> MSDOSDateTime -> Bool
(MSDOSDateTime -> MSDOSDateTime -> Bool)
-> (MSDOSDateTime -> MSDOSDateTime -> Bool) -> Eq MSDOSDateTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MSDOSDateTime -> MSDOSDateTime -> Bool
$c/= :: MSDOSDateTime -> MSDOSDateTime -> Bool
== :: MSDOSDateTime -> MSDOSDateTime -> Bool
$c== :: MSDOSDateTime -> MSDOSDateTime -> Bool
Eq)
minMSDOSDateTime :: Integer
minMSDOSDateTime :: Integer
minMSDOSDateTime = Integer
315532800
epochTimeToMSDOSDateTime :: Integer -> MSDOSDateTime
epochTimeToMSDOSDateTime :: Integer -> MSDOSDateTime
epochTimeToMSDOSDateTime Integer
epochtime | Integer
epochtime Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
minMSDOSDateTime =
Integer -> MSDOSDateTime
epochTimeToMSDOSDateTime Integer
minMSDOSDateTime
epochTimeToMSDOSDateTime Integer
epochtime =
let
UTCTime
(Day -> (Integer, Int, Int)
toGregorian -> (Integer -> Int
forall a. Num a => Integer -> a
fromInteger -> Int
year, Int
month, Int
day))
(DiffTime -> TimeOfDay
timeToTimeOfDay -> (TimeOfDay Int
hour Int
minutes (Pico -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor -> Int
sec)))
= POSIXTime -> UTCTime
posixSecondsToUTCTime (Integer -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
epochtime)
dosTime :: Word16
dosTime = Int -> Word16
forall a. Enum a => Int -> a
toEnum (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ (Int
sec Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
minutes Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
hour Int
11
dosDate :: Word16
dosDate = Int -> Word16
forall a. Enum a => Int -> a
toEnum (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Int
day Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
month Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL (Int
year Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1980) Int
9
in MSDOSDateTime :: Word16 -> Word16 -> MSDOSDateTime
MSDOSDateTime { msDOSDate :: Word16
msDOSDate = Word16
dosDate, msDOSTime :: Word16
msDOSTime = Word16
dosTime }
msDOSDateTimeToEpochTime :: MSDOSDateTime -> Integer
msDOSDateTimeToEpochTime :: MSDOSDateTime -> Integer
msDOSDateTimeToEpochTime MSDOSDateTime {msDOSDate :: MSDOSDateTime -> Word16
msDOSDate = Word16
dosDate, msDOSTime :: MSDOSDateTime -> Word16
msDOSTime = Word16
dosTime} =
let seconds :: DiffTime
seconds = Word16 -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> DiffTime) -> Word16 -> DiffTime
forall a b. (a -> b) -> a -> b
$ Word16
2 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* (Word16
dosTime Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0O37)
minutes :: DiffTime
minutes = Word16 -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> DiffTime) -> Word16 -> DiffTime
forall a b. (a -> b) -> a -> b
$ Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
dosTime Int
5 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0O77
hour :: DiffTime
hour = Word16 -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> DiffTime) -> Word16 -> DiffTime
forall a b. (a -> b) -> a -> b
$ Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
dosTime Int
11
day :: Int
day = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Word16
dosDate Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0O37
month :: Int
month = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
dosDate Int
5) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0O17)
year :: Integer
year = Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Integer) -> Word16 -> Integer
forall a b. (a -> b) -> a -> b
$ Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
dosDate Int
9
utc :: UTCTime
utc = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian (Integer
1980 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
year) Int
month Int
day) (DiffTime
3600 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
hour DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
minutes DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
seconds)
in POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utc)
#ifndef _WINDOWS
getDirectoryContentsRecursive' :: [ZipOption] -> FilePath -> IO [FilePath]
getDirectoryContentsRecursive' :: [ZipOption] -> String -> IO [String]
getDirectoryContentsRecursive' [ZipOption]
opts String
path =
if ZipOption
OptPreserveSymbolicLinks ZipOption -> [ZipOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ZipOption]
opts
then do
Bool
isDir <- String -> IO Bool
doesDirectoryExist String
path
if Bool
isDir
then do
Bool
isSymLink <- (FileStatus -> Bool) -> IO FileStatus -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileStatus -> Bool
isSymbolicLink (IO FileStatus -> IO Bool) -> IO FileStatus -> IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO FileStatus
getSymbolicLinkStatus String
path
if Bool
isSymLink
then [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
path]
else (String -> IO [String]) -> String -> IO [String]
getDirectoryContentsRecursivelyBy ([ZipOption] -> String -> IO [String]
getDirectoryContentsRecursive' [ZipOption]
opts) String
path
else [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
path]
else String -> IO [String]
getDirectoryContentsRecursive String
path
#endif
getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
getDirectoryContentsRecursive :: String -> IO [String]
getDirectoryContentsRecursive String
path = do
Bool
isDir <- String -> IO Bool
doesDirectoryExist String
path
if Bool
isDir
then (String -> IO [String]) -> String -> IO [String]
getDirectoryContentsRecursivelyBy String -> IO [String]
getDirectoryContentsRecursive String
path
else [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
path]
getDirectoryContentsRecursivelyBy :: (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
getDirectoryContentsRecursivelyBy :: (String -> IO [String]) -> String -> IO [String]
getDirectoryContentsRecursivelyBy String -> IO [String]
exploreMethod String
path = do
[String]
contents <- String -> IO [String]
getDirectoryContents String
path
let contents' :: [String]
contents' = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
path String -> ShowS
</>) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
"..",String
"."]) [String]
contents
[[String]]
children <- (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO [String]
exploreMethod [String]
contents'
if String
path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"."
then [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
children)
else [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (String
path String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
children)
setFileTimeStamp :: FilePath -> Integer -> IO ()
#ifdef _WINDOWS
setFileTimeStamp _ _ = return ()
#else
setFileTimeStamp :: String -> Integer -> IO ()
setFileTimeStamp String
file Integer
epochtime = do
let epochtime' :: EpochTime
epochtime' = Integer -> EpochTime
forall a. Num a => Integer -> a
fromInteger Integer
epochtime
String -> EpochTime -> EpochTime -> IO ()
setFileTimes String
file EpochTime
epochtime' EpochTime
epochtime'
#endif
getArchive :: Get Archive
getArchive :: Get Archive
getArchive = do
[(Word32, ByteString)]
locals <- Word32 -> Get (Word32, ByteString) -> Get [(Word32, ByteString)]
forall a. Word32 -> Get a -> Get [a]
manySig Word32
0x04034b50 Get (Word32, ByteString)
getLocalFile
[Entry]
files <- Word32 -> Get Entry -> Get [Entry]
forall a. Word32 -> Get a -> Get [a]
manySig Word32
0x02014b50 (Map Word32 ByteString -> Get Entry
getFileHeader ([(Word32, ByteString)] -> Map Word32 ByteString
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Word32, ByteString)]
locals))
Maybe ByteString
digSig <- ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Get ByteString -> Get (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get ByteString
getDigitalSignature Get (Maybe ByteString)
-> Get (Maybe ByteString) -> Get (Maybe ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe ByteString -> Get (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
Word32
endSig <- Get Word32
getWord32le
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
endSig Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x06054b50)
(Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Did not find end of central directory signature"
Int -> Get ()
skip Int
2
Int -> Get ()
skip Int
2
Int -> Get ()
skip Int
2
Int -> Get ()
skip Int
2
Int -> Get ()
skip Int
4
Int -> Get ()
skip Int
4
Word16
commentLength <- Get Word16
getWord16le
ByteString
zipComment <- ByteOffset -> Get ByteString
getLazyByteString (Int -> ByteOffset
forall a. Enum a => Int -> a
toEnum (Int -> ByteOffset) -> Int -> ByteOffset
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
commentLength)
Archive -> Get Archive
forall (m :: * -> *) a. Monad m => a -> m a
return Archive :: [Entry] -> Maybe ByteString -> ByteString -> Archive
Archive
{ zEntries :: [Entry]
zEntries = [Entry]
files
, zSignature :: Maybe ByteString
zSignature = Maybe ByteString
digSig
, zComment :: ByteString
zComment = ByteString
zipComment
}
putArchive :: Archive -> Put
putArchive :: Archive -> Put
putArchive Archive
archive = do
(Entry -> Put) -> [Entry] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Entry -> Put
putLocalFile ([Entry] -> Put) -> [Entry] -> Put
forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
zEntries Archive
archive
let localFileSizes :: [Word32]
localFileSizes = (Entry -> Word32) -> [Entry] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> Word32
localFileSize ([Entry] -> [Word32]) -> [Entry] -> [Word32]
forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
zEntries Archive
archive
let offsets :: [Word32]
offsets = (Word32 -> Word32 -> Word32) -> Word32 -> [Word32] -> [Word32]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
(+) Word32
0 [Word32]
localFileSizes
let cdOffset :: Word32
cdOffset = [Word32] -> Word32
forall a. [a] -> a
last [Word32]
offsets
()
_ <- (Word32 -> Entry -> Put) -> [Word32] -> [Entry] -> Put
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Word32 -> Entry -> Put
putFileHeader [Word32]
offsets (Archive -> [Entry]
zEntries Archive
archive)
Maybe ByteString -> Put
putDigitalSignature (Maybe ByteString -> Put) -> Maybe ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Archive -> Maybe ByteString
zSignature Archive
archive
Word32 -> Put
putWord32le Word32
0x06054b50
Word16 -> Put
putWord16le Word16
0
Word16 -> Put
putWord16le Word16
0
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ [Entry] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Entry] -> Int) -> [Entry] -> Int
forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
zEntries Archive
archive
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ [Entry] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Entry] -> Int) -> [Entry] -> Int
forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
zEntries Archive
archive
Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ [Word32] -> Word32
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word32] -> Word32) -> [Word32] -> Word32
forall a b. (a -> b) -> a -> b
$ (Entry -> Word32) -> [Entry] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map Entry -> Word32
fileHeaderSize ([Entry] -> [Word32]) -> [Entry] -> [Word32]
forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
zEntries Archive
archive
Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
cdOffset
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ ByteOffset -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word16) -> ByteOffset -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
B.length (ByteString -> ByteOffset) -> ByteString -> ByteOffset
forall a b. (a -> b) -> a -> b
$ Archive -> ByteString
zComment Archive
archive
ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Archive -> ByteString
zComment Archive
archive
fileHeaderSize :: Entry -> Word32
Entry
f =
ByteOffset -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word32) -> ByteOffset -> Word32
forall a b. (a -> b) -> a -> b
$ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+
ByteOffset -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> ByteOffset
B.length (ByteString -> ByteOffset) -> ByteString -> ByteOffset
forall a b. (a -> b) -> a -> b
$ String -> ByteString
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
f) ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+
ByteString -> ByteOffset
B.length (Entry -> ByteString
eExtraField Entry
f) ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteString -> ByteOffset
B.length (Entry -> ByteString
eFileComment Entry
f)
localFileSize :: Entry -> Word32
localFileSize :: Entry -> Word32
localFileSize Entry
f =
ByteOffset -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word32) -> ByteOffset -> Word32
forall a b. (a -> b) -> a -> b
$ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
4 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteOffset
2 ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+
ByteOffset -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> ByteOffset
B.length (ByteString -> ByteOffset) -> ByteString -> ByteOffset
forall a b. (a -> b) -> a -> b
$ String -> ByteString
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
f) ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+
ByteString -> ByteOffset
B.length (Entry -> ByteString
eExtraField Entry
f) ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
+ ByteString -> ByteOffset
B.length (Entry -> ByteString
eCompressedData Entry
f)
getLocalFile :: Get (Word32, B.ByteString)
getLocalFile :: Get (Word32, ByteString)
getLocalFile = do
ByteOffset
offset <- Get ByteOffset
bytesRead
Get Word32
getWord32le Get Word32 -> (Word32 -> Get ()) -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word32 -> Bool) -> Word32 -> Get ()
forall a. (a -> Bool) -> a -> Get ()
ensure (Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x04034b50)
Int -> Get ()
skip Int
2
Word16
bitflag <- Get Word16
getWord16le
Int -> Get ()
skip Int
2
Int -> Get ()
skip Int
2
Int -> Get ()
skip Int
2
Int -> Get ()
skip Int
4
Word32
compressedSize <- Get Word32
getWord32le
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
compressedSize Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0xFFFFFFFF) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Can't read ZIP64 archive."
Int -> Get ()
skip Int
4
Word16
fileNameLength <- Get Word16
getWord16le
Word16
extraFieldLength <- Get Word16
getWord16le
Int -> Get ()
skip (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
fileNameLength)
Int -> Get ()
skip (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
extraFieldLength)
ByteString
compressedData <- if Word16
bitflag Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0O10 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0
then ByteOffset -> Get ByteString
getLazyByteString (Word32 -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
compressedSize)
else
do ByteString
raw <- Word32 -> Get ByteString
getWordsTilSig Word32
0x08074b50
Int -> Get ()
skip Int
4
Word32
cs <- Get Word32
getWord32le
Int -> Get ()
skip Int
4
if Word32 -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
cs ByteOffset -> ByteOffset -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> ByteOffset
B.length ByteString
raw
then ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
raw
else String -> Get ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Content size mismatch in data descriptor record"
(Word32, ByteString) -> Get (Word32, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteOffset -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteOffset
offset, ByteString
compressedData)
getWordsTilSig :: Word32 -> Get B.ByteString
getWordsTilSig :: Word32 -> Get ByteString
getWordsTilSig Word32
sig = ([ByteString] -> ByteString
B.fromChunks ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse) ([ByteString] -> ByteString) -> Get [ByteString] -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe (Word8, Word8, Word8) -> [ByteString] -> Get [ByteString]
go Maybe (Word8, Word8, Word8)
forall a. Maybe a
Nothing []
where
sig' :: ByteString
sig' = [Word8] -> ByteString
S.pack [Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
sig Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF,
Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
sig Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF,
Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
sig Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF,
Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
sig Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF]
chunkSize :: Int
chunkSize = Int
16384
checkChunk :: ByteString -> m (Either Int ByteString)
checkChunk ByteString
chunk = do
let (ByteString
prefix, ByteString
start) = ByteString -> ByteString -> (ByteString, ByteString)
S.breakSubstring ByteString
sig' ByteString
chunk
if ByteString -> Bool
S.null ByteString
start
then Either Int ByteString -> m (Either Int ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int ByteString -> m (Either Int ByteString))
-> Either Int ByteString -> m (Either Int ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either Int ByteString
forall a b. b -> Either a b
Right ByteString
chunk
else Either Int ByteString -> m (Either Int ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int ByteString -> m (Either Int ByteString))
-> Either Int ByteString -> m (Either Int ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> Either Int ByteString
forall a b. a -> Either a b
Left (Int -> Either Int ByteString) -> Int -> Either Int ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
prefix
go :: Maybe (Word8, Word8, Word8) -> [S.ByteString] -> Get [S.ByteString]
go :: Maybe (Word8, Word8, Word8) -> [ByteString] -> Get [ByteString]
go Maybe (Word8, Word8, Word8)
prefixes [ByteString]
acc = do
Either Int ByteString
eitherChunkOrIndex <- Get (Either Int ByteString) -> Get (Either Int ByteString)
forall a b. Get (Either a b) -> Get (Either a b)
lookAheadE (Get (Either Int ByteString) -> Get (Either Int ByteString))
-> Get (Either Int ByteString) -> Get (Either Int ByteString)
forall a b. (a -> b) -> a -> b
$ do
ByteString
chunk <- Int -> Get ByteString
getByteString Int
chunkSize Get ByteString -> Get ByteString -> Get ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> ByteString
B.toStrict (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get ByteString
getRemainingLazyByteString
case Maybe (Word8, Word8, Word8)
prefixes of
Just (Word8
byte3,Word8
byte2,Word8
byte1) ->
let len :: Int
len = ByteString -> Int
S.length ByteString
chunk in
if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&&
[Word8] -> ByteString
S.pack [Word8
byte3,Word8
byte2,Word8
byte1,ByteString -> Int -> Word8
S.index ByteString
chunk Int
0] ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
sig'
then Either Int ByteString -> Get (Either Int ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int ByteString -> Get (Either Int ByteString))
-> Either Int ByteString -> Get (Either Int ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> Either Int ByteString
forall a b. a -> Either a b
Left (Int -> Either Int ByteString) -> Int -> Either Int ByteString
forall a b. (a -> b) -> a -> b
$ -Int
3
else if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&&
[Word8] -> ByteString
S.pack [Word8
byte2,Word8
byte1,ByteString -> Int -> Word8
S.index ByteString
chunk Int
0,ByteString -> Int -> Word8
S.index ByteString
chunk Int
1] ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
sig'
then Either Int ByteString -> Get (Either Int ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int ByteString -> Get (Either Int ByteString))
-> Either Int ByteString -> Get (Either Int ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> Either Int ByteString
forall a b. a -> Either a b
Left (Int -> Either Int ByteString) -> Int -> Either Int ByteString
forall a b. (a -> b) -> a -> b
$ -Int
2
else if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3 Bool -> Bool -> Bool
&&
[Word8] -> ByteString
S.pack [Word8
byte1,ByteString -> Int -> Word8
S.index ByteString
chunk Int
0,ByteString -> Int -> Word8
S.index ByteString
chunk Int
1,ByteString -> Int -> Word8
S.index ByteString
chunk Int
2] ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
sig'
then Either Int ByteString -> Get (Either Int ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int ByteString -> Get (Either Int ByteString))
-> Either Int ByteString -> Get (Either Int ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> Either Int ByteString
forall a b. a -> Either a b
Left (Int -> Either Int ByteString) -> Int -> Either Int ByteString
forall a b. (a -> b) -> a -> b
$ -Int
1
else ByteString -> Get (Either Int ByteString)
forall (m :: * -> *).
Monad m =>
ByteString -> m (Either Int ByteString)
checkChunk ByteString
chunk
Maybe (Word8, Word8, Word8)
Nothing -> ByteString -> Get (Either Int ByteString)
forall (m :: * -> *).
Monad m =>
ByteString -> m (Either Int ByteString)
checkChunk ByteString
chunk
case Either Int ByteString
eitherChunkOrIndex of
Left Int
index -> if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
then do
Int -> Get ()
skip (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
index)
[ByteString] -> Get [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> Get [ByteString])
-> [ByteString] -> Get [ByteString]
forall a b. (a -> b) -> a -> b
$ (Int -> ByteString -> ByteString
S.take (ByteString -> Int
S.length ([ByteString] -> ByteString
forall a. [a] -> a
head [ByteString]
acc) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
index) ([ByteString] -> ByteString
forall a. [a] -> a
head [ByteString]
acc)) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ([ByteString] -> [ByteString]
forall a. [a] -> [a]
tail [ByteString]
acc)
else do
ByteString
lastchunk <- Int -> Get ByteString
getByteString Int
index
Int -> Get ()
skip Int
4
[ByteString] -> Get [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
lastchunkByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc)
Right ByteString
chunk -> if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
chunkSize
then Maybe (Word8, Word8, Word8) -> [ByteString] -> Get [ByteString]
go Maybe (Word8, Word8, Word8)
prefixes' (ByteString
chunkByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc)
else String -> Get [ByteString]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get [ByteString]) -> String -> Get [ByteString]
forall a b. (a -> b) -> a -> b
$ String
"getWordsTilSig: signature not found before EOF"
where
len :: Int
len = ByteString -> Int
S.length ByteString
chunk
prefixes' :: Maybe (Word8, Word8, Word8)
prefixes' = (Word8, Word8, Word8) -> Maybe (Word8, Word8, Word8)
forall a. a -> Maybe a
Just ((Word8, Word8, Word8) -> Maybe (Word8, Word8, Word8))
-> (Word8, Word8, Word8) -> Maybe (Word8, Word8, Word8)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Int -> Word8
S.index ByteString
chunk (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3), ByteString -> Int -> Word8
S.index ByteString
chunk (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2), ByteString -> Int -> Word8
S.index ByteString
chunk (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
putLocalFile :: Entry -> Put
putLocalFile :: Entry -> Put
putLocalFile Entry
f = do
Word32 -> Put
putWord32le Word32
0x04034b50
Word16 -> Put
putWord16le Word16
20
Word16 -> Put
putWord16le Word16
0x802
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ case Entry -> CompressionMethod
eCompressionMethod Entry
f of
CompressionMethod
NoCompression -> Word16
0
CompressionMethod
Deflate -> Word16
8
let modTime :: MSDOSDateTime
modTime = Integer -> MSDOSDateTime
epochTimeToMSDOSDateTime (Integer -> MSDOSDateTime) -> Integer -> MSDOSDateTime
forall a b. (a -> b) -> a -> b
$ Entry -> Integer
eLastModified Entry
f
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ MSDOSDateTime -> Word16
msDOSTime MSDOSDateTime
modTime
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ MSDOSDateTime -> Word16
msDOSDate MSDOSDateTime
modTime
Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eCRC32 Entry
f
Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eCompressedSize Entry
f
Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eUncompressedSize Entry
f
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ ByteOffset -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word16) -> ByteOffset -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
B.length (ByteString -> ByteOffset) -> ByteString -> ByteOffset
forall a b. (a -> b) -> a -> b
$ String -> ByteString
fromString
(String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
f
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ ByteOffset -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word16) -> ByteOffset -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
B.length (ByteString -> ByteOffset) -> ByteString -> ByteOffset
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eExtraField Entry
f
ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ String -> ByteString
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
f
ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eExtraField Entry
f
ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eCompressedData Entry
f
getFileHeader :: M.Map Word32 B.ByteString
-> Get Entry
Map Word32 ByteString
locals = do
Get Word32
getWord32le Get Word32 -> (Word32 -> Get ()) -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word32 -> Bool) -> Word32 -> Get ()
forall a. (a -> Bool) -> a -> Get ()
ensure (Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x02014b50)
Word16
vmb <- Get Word16
getWord16le
Word8
versionNeededToExtract <- Get Word8
getWord8
Int -> Get ()
skip Int
1
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
versionNeededToExtract Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
20) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"This archive requires zip >= 2.0 to extract."
Word16
bitflag <- Get Word16
getWord16le
Word16
rawCompressionMethod <- Get Word16
getWord16le
CompressionMethod
compressionMethod <- case Word16
rawCompressionMethod of
Word16
0 -> CompressionMethod -> Get CompressionMethod
forall (m :: * -> *) a. Monad m => a -> m a
return CompressionMethod
NoCompression
Word16
8 -> CompressionMethod -> Get CompressionMethod
forall (m :: * -> *) a. Monad m => a -> m a
return CompressionMethod
Deflate
Word16
_ -> String -> Get CompressionMethod
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get CompressionMethod)
-> String -> Get CompressionMethod
forall a b. (a -> b) -> a -> b
$ String
"Unknown compression method " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall a. Show a => a -> String
show Word16
rawCompressionMethod
Word16
lastModFileTime <- Get Word16
getWord16le
Word16
lastModFileDate <- Get Word16
getWord16le
Word32
crc32 <- Get Word32
getWord32le
EncryptionMethod
encryptionMethod <- case (Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word16
bitflag Int
0, Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word16
bitflag Int
3, Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word16
bitflag Int
6) of
(Bool
False, Bool
_, Bool
_) -> EncryptionMethod -> Get EncryptionMethod
forall (m :: * -> *) a. Monad m => a -> m a
return EncryptionMethod
NoEncryption
(Bool
True, Bool
False, Bool
False) -> EncryptionMethod -> Get EncryptionMethod
forall (m :: * -> *) a. Monad m => a -> m a
return (EncryptionMethod -> Get EncryptionMethod)
-> EncryptionMethod -> Get EncryptionMethod
forall a b. (a -> b) -> a -> b
$ Word8 -> EncryptionMethod
PKWAREEncryption (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
crc32 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24))
(Bool
True, Bool
True, Bool
False) -> EncryptionMethod -> Get EncryptionMethod
forall (m :: * -> *) a. Monad m => a -> m a
return (EncryptionMethod -> Get EncryptionMethod)
-> EncryptionMethod -> Get EncryptionMethod
forall a b. (a -> b) -> a -> b
$ Word8 -> EncryptionMethod
PKWAREEncryption (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
lastModFileTime Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
8))
(Bool
True, Bool
_, Bool
True) -> String -> Get EncryptionMethod
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Strong encryption is not supported"
Word32
compressedSize <- Get Word32
getWord32le
Word32
uncompressedSize <- Get Word32
getWord32le
Word16
fileNameLength <- Get Word16
getWord16le
Word16
extraFieldLength <- Get Word16
getWord16le
Word16
fileCommentLength <- Get Word16
getWord16le
Int -> Get ()
skip Int
2
Word16
internalFileAttributes <- Get Word16
getWord16le
Word32
externalFileAttributes <- Get Word32
getWord32le
Word32
relativeOffset <- Get Word32
getWord32le
ByteString
fileName <- ByteOffset -> Get ByteString
getLazyByteString (Int -> ByteOffset
forall a. Enum a => Int -> a
toEnum (Int -> ByteOffset) -> Int -> ByteOffset
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
fileNameLength)
ByteString
extraField <- ByteOffset -> Get ByteString
getLazyByteString (Int -> ByteOffset
forall a. Enum a => Int -> a
toEnum (Int -> ByteOffset) -> Int -> ByteOffset
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
extraFieldLength)
ByteString
fileComment <- ByteOffset -> Get ByteString
getLazyByteString (Int -> ByteOffset
forall a. Enum a => Int -> a
toEnum (Int -> ByteOffset) -> Int -> ByteOffset
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
fileCommentLength)
ByteString
compressedData <- case Word32 -> Map Word32 ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Word32
relativeOffset Map Word32 ByteString
locals of
Just ByteString
x -> ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
x
Maybe ByteString
Nothing -> String -> Get ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ByteString) -> String -> Get ByteString
forall a b. (a -> b) -> a -> b
$ String
"Unable to find data at offset " String -> ShowS
forall a. [a] -> [a] -> [a]
++
Word32 -> String
forall a. Show a => a -> String
show Word32
relativeOffset
Entry -> Get Entry
forall (m :: * -> *) a. Monad m => a -> m a
return Entry :: String
-> CompressionMethod
-> EncryptionMethod
-> Integer
-> Word32
-> Word32
-> Word32
-> ByteString
-> ByteString
-> Word16
-> Word16
-> Word32
-> ByteString
-> Entry
Entry
{ eRelativePath :: String
eRelativePath = ByteString -> String
toString ByteString
fileName
, eCompressionMethod :: CompressionMethod
eCompressionMethod = CompressionMethod
compressionMethod
, eEncryptionMethod :: EncryptionMethod
eEncryptionMethod = EncryptionMethod
encryptionMethod
, eLastModified :: Integer
eLastModified = MSDOSDateTime -> Integer
msDOSDateTimeToEpochTime (MSDOSDateTime -> Integer) -> MSDOSDateTime -> Integer
forall a b. (a -> b) -> a -> b
$
MSDOSDateTime :: Word16 -> Word16 -> MSDOSDateTime
MSDOSDateTime { msDOSDate :: Word16
msDOSDate = Word16
lastModFileDate,
msDOSTime :: Word16
msDOSTime = Word16
lastModFileTime }
, eCRC32 :: Word32
eCRC32 = Word32
crc32
, eCompressedSize :: Word32
eCompressedSize = Word32
compressedSize
, eUncompressedSize :: Word32
eUncompressedSize = Word32
uncompressedSize
, eExtraField :: ByteString
eExtraField = ByteString
extraField
, eFileComment :: ByteString
eFileComment = ByteString
fileComment
, eVersionMadeBy :: Word16
eVersionMadeBy = Word16
vmb
, eInternalFileAttributes :: Word16
eInternalFileAttributes = Word16
internalFileAttributes
, eExternalFileAttributes :: Word32
eExternalFileAttributes = Word32
externalFileAttributes
, eCompressedData :: ByteString
eCompressedData = ByteString
compressedData
}
putFileHeader :: Word32
-> Entry
-> Put
Word32
offset Entry
local = do
Word32 -> Put
putWord32le Word32
0x02014b50
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word16
eVersionMadeBy Entry
local
Word16 -> Put
putWord16le Word16
20
Word16 -> Put
putWord16le Word16
0x802
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ case Entry -> CompressionMethod
eCompressionMethod Entry
local of
CompressionMethod
NoCompression -> Word16
0
CompressionMethod
Deflate -> Word16
8
let modTime :: MSDOSDateTime
modTime = Integer -> MSDOSDateTime
epochTimeToMSDOSDateTime (Integer -> MSDOSDateTime) -> Integer -> MSDOSDateTime
forall a b. (a -> b) -> a -> b
$ Entry -> Integer
eLastModified Entry
local
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ MSDOSDateTime -> Word16
msDOSTime MSDOSDateTime
modTime
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ MSDOSDateTime -> Word16
msDOSDate MSDOSDateTime
modTime
Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eCRC32 Entry
local
Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eCompressedSize Entry
local
Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eUncompressedSize Entry
local
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ ByteOffset -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word16) -> ByteOffset -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
B.length (ByteString -> ByteOffset) -> ByteString -> ByteOffset
forall a b. (a -> b) -> a -> b
$ String -> ByteString
fromString
(String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
local
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ ByteOffset -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word16) -> ByteOffset -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
B.length (ByteString -> ByteOffset) -> ByteString -> ByteOffset
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eExtraField Entry
local
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ ByteOffset -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word16) -> ByteOffset -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
B.length (ByteString -> ByteOffset) -> ByteString -> ByteOffset
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eFileComment Entry
local
Word16 -> Put
putWord16le Word16
0
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word16
eInternalFileAttributes Entry
local
Word32 -> Put
putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> Word32
eExternalFileAttributes Entry
local
Word32 -> Put
putWord32le Word32
offset
ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ String -> ByteString
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
normalizePath ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Entry -> String
eRelativePath Entry
local
ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eExtraField Entry
local
ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
eFileComment Entry
local
getDigitalSignature :: Get B.ByteString
getDigitalSignature :: Get ByteString
getDigitalSignature = do
Get Word32
getWord32le Get Word32 -> (Word32 -> Get ()) -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word32 -> Bool) -> Word32 -> Get ()
forall a. (a -> Bool) -> a -> Get ()
ensure (Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x05054b50)
Word16
sigSize <- Get Word16
getWord16le
ByteOffset -> Get ByteString
getLazyByteString (Int -> ByteOffset
forall a. Enum a => Int -> a
toEnum (Int -> ByteOffset) -> Int -> ByteOffset
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
sigSize)
putDigitalSignature :: Maybe B.ByteString -> Put
putDigitalSignature :: Maybe ByteString -> Put
putDigitalSignature Maybe ByteString
Nothing = () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()
putDigitalSignature (Just ByteString
sig) = do
Word32 -> Put
putWord32le Word32
0x05054b50
Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ ByteOffset -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOffset -> Word16) -> ByteOffset -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
B.length ByteString
sig
ByteString -> Put
putLazyByteString ByteString
sig
ensure :: (a -> Bool) -> a -> Get ()
ensure :: (a -> Bool) -> a -> Get ()
ensure a -> Bool
p a
val =
if a -> Bool
p a
val
then () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ensure not satisfied"
toString :: B.ByteString -> String
toString :: ByteString -> String
toString = Text -> String
TL.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TL.decodeUtf8
fromString :: String -> B.ByteString
fromString :: String -> ByteString
fromString = Text -> ByteString
TL.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack