{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Codec.Archive.Zip.Internal
( PendingAction (..),
targetEntry,
scanArchive,
sourceEntry,
crc32Sink,
commit,
)
where
import Codec.Archive.Zip.CP437 (decodeCP437)
import Codec.Archive.Zip.Type
import Conduit (PrimMonad)
import Control.Applicative (many, (<|>))
import Control.Exception (bracketOnError, catchJust)
import Control.Monad
import Control.Monad.Catch (MonadThrow (..))
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Resource (MonadResource, ResourceT)
import Data.Bits
import Data.Bool (bool)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Char (ord)
import Data.Conduit (ConduitT, ZipSink (..), (.|))
import qualified Data.Conduit as C
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL
import qualified Data.Conduit.Zlib as Z
import Data.Digest.CRC32 (crc32Update)
import Data.Fixed (Fixed (..))
import Data.Foldable (foldl')
import Data.Map.Strict (Map, (!))
import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes, fromJust, isNothing)
import Data.Sequence (Seq, (><), (|>))
import qualified Data.Sequence as S
import Data.Serialize
import qualified Data.Set as E
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time
import Data.Version
import Data.Void
import Data.Word (Word16, Word32)
import Numeric.Natural (Natural)
import System.Directory
import System.FilePath
import System.IO
import System.IO.Error (isDoesNotExistError)
#ifndef mingw32_HOST_OS
import qualified Codec.Archive.Zip.Unix as Unix
#endif
#ifdef ENABLE_BZIP2
import qualified Data.Conduit.BZlib as BZ
#endif
#ifdef ENABLE_ZSTD
import qualified Data.Conduit.Zstd as Zstandard
#endif
data PendingAction
=
SinkEntry
CompressionMethod
(ConduitT () ByteString (ResourceT IO) ())
EntrySelector
|
CopyEntry FilePath EntrySelector EntrySelector
|
RenameEntry EntrySelector EntrySelector
|
DeleteEntry EntrySelector
|
Recompress CompressionMethod EntrySelector
|
Text EntrySelector
|
EntrySelector
|
SetModTime UTCTime EntrySelector
|
Word16 ByteString EntrySelector
|
Word16 EntrySelector
|
Text
|
|
SetExternalFileAttributes Word32 EntrySelector
data ProducingActions = ProducingActions
{ ProducingActions -> Map FilePath (Map EntrySelector EntrySelector)
paCopyEntry :: Map FilePath (Map EntrySelector EntrySelector),
ProducingActions
-> Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
paSinkEntry :: Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
}
data EditingActions = EditingActions
{ EditingActions -> Map EntrySelector CompressionMethod
eaCompression :: Map EntrySelector CompressionMethod,
:: Map EntrySelector Text,
:: Map EntrySelector (),
EditingActions -> Map EntrySelector UTCTime
eaModTime :: Map EntrySelector UTCTime,
:: Map EntrySelector (Map Word16 ByteString),
EditingActions -> Map EntrySelector (Map Word16 ())
eaDeleteField :: Map EntrySelector (Map Word16 ()),
EditingActions -> Map EntrySelector Word32
eaExtFileAttr :: Map EntrySelector Word32
}
data EntryOrigin
= GenericOrigin
| Borrowed EntryDescription
data
=
|
deriving (HeaderType -> HeaderType -> Bool
(HeaderType -> HeaderType -> Bool)
-> (HeaderType -> HeaderType -> Bool) -> Eq HeaderType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderType -> HeaderType -> Bool
$c/= :: HeaderType -> HeaderType -> Bool
== :: HeaderType -> HeaderType -> Bool
$c== :: HeaderType -> HeaderType -> Bool
Eq)
data DataDescriptor = DataDescriptor
{ DataDescriptor -> Word32
ddCRC32 :: Word32,
DataDescriptor -> Natural
ddCompressedSize :: Natural,
DataDescriptor -> Natural
ddUncompressedSize :: Natural
}
data =
{ Zip64ExtraField -> Natural
z64efUncompressedSize :: Natural,
Zip64ExtraField -> Natural
z64efCompressedSize :: Natural,
Zip64ExtraField -> Natural
z64efOffset :: Natural
}
data MsDosTime = MsDosTime
{ MsDosTime -> Word16
msDosDate :: Word16,
MsDosTime -> Word16
msDosTime :: Word16
}
zipVersion :: Version
zipVersion :: Version
zipVersion = [Int] -> [FilePath] -> Version
Version [6, 3] []
scanArchive ::
FilePath ->
IO (ArchiveDescription, Map EntrySelector EntryDescription)
scanArchive :: FilePath
-> IO (ArchiveDescription, Map EntrySelector EntryDescription)
scanArchive path :: FilePath
path = FilePath
-> IOMode
-> (Handle
-> IO (ArchiveDescription, Map EntrySelector EntryDescription))
-> IO (ArchiveDescription, Map EntrySelector EntryDescription)
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
path IOMode
ReadMode ((Handle
-> IO (ArchiveDescription, Map EntrySelector EntryDescription))
-> IO (ArchiveDescription, Map EntrySelector EntryDescription))
-> (Handle
-> IO (ArchiveDescription, Map EntrySelector EntryDescription))
-> IO (ArchiveDescription, Map EntrySelector EntryDescription)
forall a b. (a -> b) -> a -> b
$ \h :: Handle
h -> do
Maybe Integer
mecdOffset <- FilePath -> Handle -> IO (Maybe Integer)
locateECD FilePath
path Handle
h
case Maybe Integer
mecdOffset of
Just ecdOffset :: Integer
ecdOffset -> do
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
ecdOffset
Integer
ecdSize <- Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
subtract Integer
ecdOffset (Integer -> Integer) -> IO Integer -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Integer
hFileSize Handle
h
ByteString
ecdRaw <- Handle -> Int -> IO ByteString
B.hGet Handle
h (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
ecdSize)
case Get ArchiveDescription
-> ByteString -> Either FilePath ArchiveDescription
forall a. Get a -> ByteString -> Either FilePath a
runGet Get ArchiveDescription
getECD ByteString
ecdRaw of
Left msg :: FilePath
msg -> ZipException
-> IO (ArchiveDescription, Map EntrySelector EntryDescription)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FilePath -> FilePath -> ZipException
ParsingFailed FilePath
path FilePath
msg)
Right ecd :: ArchiveDescription
ecd -> do
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek (Integer -> IO ()) -> Integer -> IO ()
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ArchiveDescription -> Natural
adCDOffset ArchiveDescription
ecd)
ByteString
cdRaw <- Handle -> Int -> IO ByteString
B.hGet Handle
h (Int -> IO ByteString) -> Int -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ArchiveDescription -> Natural
adCDSize ArchiveDescription
ecd)
case Get (Map EntrySelector EntryDescription)
-> ByteString
-> Either FilePath (Map EntrySelector EntryDescription)
forall a. Get a -> ByteString -> Either FilePath a
runGet Get (Map EntrySelector EntryDescription)
getCD ByteString
cdRaw of
Left msg :: FilePath
msg -> ZipException
-> IO (ArchiveDescription, Map EntrySelector EntryDescription)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FilePath -> FilePath -> ZipException
ParsingFailed FilePath
path FilePath
msg)
Right cd :: Map EntrySelector EntryDescription
cd -> (ArchiveDescription, Map EntrySelector EntryDescription)
-> IO (ArchiveDescription, Map EntrySelector EntryDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return (ArchiveDescription
ecd, Map EntrySelector EntryDescription
cd)
Nothing ->
ZipException
-> IO (ArchiveDescription, Map EntrySelector EntryDescription)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FilePath -> FilePath -> ZipException
ParsingFailed FilePath
path "Cannot locate end of central directory")
sourceEntry ::
(PrimMonad m, MonadThrow m, MonadResource m) =>
FilePath ->
EntryDescription ->
Bool ->
ConduitT () ByteString m ()
sourceEntry :: FilePath -> EntryDescription -> Bool -> ConduitT () ByteString m ()
sourceEntry path :: FilePath
path EntryDescription {..} d :: Bool
d =
ConduitT () ByteString m ()
forall i. ConduitT i ByteString m ()
source ConduitT () ByteString m ()
-> ConduitM ByteString ByteString m ()
-> ConduitT () ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Int -> ConduitM ByteString ByteString m ()
forall (m :: * -> *).
Monad m =>
Int -> ConduitT ByteString ByteString m ()
CB.isolate (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
edCompressedSize) ConduitM ByteString ByteString m ()
-> ConduitM ByteString ByteString m ()
-> ConduitM ByteString ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString ByteString m ()
decompress
where
source :: ConduitT i ByteString m ()
source = IO Handle -> ConduitT i ByteString m ()
forall (m :: * -> *) i.
MonadResource m =>
IO Handle -> ConduitT i ByteString m ()
CB.sourceIOHandle (IO Handle -> ConduitT i ByteString m ())
-> IO Handle -> ConduitT i ByteString m ()
forall a b. (a -> b) -> a -> b
$ do
Handle
h <- FilePath -> IOMode -> IO Handle
openFile FilePath
path IOMode
ReadMode
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
edOffset)
ByteString
localHeader <- Handle -> Int -> IO ByteString
B.hGet Handle
h 30
case Get Integer -> ByteString -> Either FilePath Integer
forall a. Get a -> ByteString -> Either FilePath a
runGet Get Integer
getLocalHeaderGap ByteString
localHeader of
Left msg :: FilePath
msg -> ZipException -> IO Handle
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FilePath -> FilePath -> ZipException
ParsingFailed FilePath
path FilePath
msg)
Right gap :: Integer
gap -> do
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
RelativeSeek Integer
gap
Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
h
decompress :: ConduitM ByteString ByteString m ()
decompress =
if Bool
d
then CompressionMethod -> ConduitM ByteString ByteString m ()
forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
CompressionMethod -> ConduitT ByteString ByteString m ()
decompressingPipe CompressionMethod
edCompression
else (ByteString -> ConduitM ByteString ByteString m ())
-> ConduitM ByteString ByteString m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
C.awaitForever ByteString -> ConduitM ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
C.yield
commit ::
FilePath ->
ArchiveDescription ->
Map EntrySelector EntryDescription ->
Seq PendingAction ->
IO ()
commit :: FilePath
-> ArchiveDescription
-> Map EntrySelector EntryDescription
-> Seq PendingAction
-> IO ()
commit path :: FilePath
path ArchiveDescription {..} entries :: Map EntrySelector EntryDescription
entries xs :: Seq PendingAction
xs =
FilePath -> (Handle -> IO ()) -> IO ()
withNewFile FilePath
path ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \h :: Handle
h -> do
let (ProducingActions coping :: Map FilePath (Map EntrySelector EntrySelector)
coping sinking :: Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
sinking, editing :: EditingActions
editing) =
Seq PendingAction -> (ProducingActions, EditingActions)
optimize (FilePath -> Map EntrySelector EntryDescription -> Seq PendingAction
toRecreatingActions FilePath
path Map EntrySelector EntryDescription
entries Seq PendingAction -> Seq PendingAction -> Seq PendingAction
forall a. Seq a -> Seq a -> Seq a
>< Seq PendingAction
xs)
comment :: Maybe Text
comment = Maybe Text -> Seq PendingAction -> Maybe Text
predictComment Maybe Text
adComment Seq PendingAction
xs
Map EntrySelector EntryDescription
copiedCD <-
[Map EntrySelector EntryDescription]
-> Map EntrySelector EntryDescription
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions
([Map EntrySelector EntryDescription]
-> Map EntrySelector EntryDescription)
-> IO [Map EntrySelector EntryDescription]
-> IO (Map EntrySelector EntryDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
-> (FilePath -> IO (Map EntrySelector EntryDescription))
-> IO [Map EntrySelector EntryDescription]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM
(Map FilePath (Map EntrySelector EntrySelector) -> [FilePath]
forall k a. Map k a -> [k]
M.keys Map FilePath (Map EntrySelector EntrySelector)
coping)
( \srcPath :: FilePath
srcPath ->
Handle
-> FilePath
-> Map EntrySelector EntrySelector
-> EditingActions
-> IO (Map EntrySelector EntryDescription)
copyEntries Handle
h FilePath
srcPath (Map FilePath (Map EntrySelector EntrySelector)
coping Map FilePath (Map EntrySelector EntrySelector)
-> FilePath -> Map EntrySelector EntrySelector
forall k a. Ord k => Map k a -> k -> a
! FilePath
srcPath) EditingActions
editing
)
let sinkingKeys :: [EntrySelector]
sinkingKeys = Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
-> [EntrySelector]
forall k a. Map k a -> [k]
M.keys (Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
-> [EntrySelector])
-> Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
-> [EntrySelector]
forall a b. (a -> b) -> a -> b
$ Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
sinking Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
-> Map EntrySelector EntryDescription
-> Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map EntrySelector EntryDescription
copiedCD
Map EntrySelector EntryDescription
sunkCD <-
[(EntrySelector, EntryDescription)]
-> Map EntrySelector EntryDescription
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
([(EntrySelector, EntryDescription)]
-> Map EntrySelector EntryDescription)
-> IO [(EntrySelector, EntryDescription)]
-> IO (Map EntrySelector EntryDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [EntrySelector]
-> (EntrySelector -> IO (EntrySelector, EntryDescription))
-> IO [(EntrySelector, EntryDescription)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM
[EntrySelector]
sinkingKeys
( \selector :: EntrySelector
selector ->
Handle
-> EntrySelector
-> EntryOrigin
-> ConduitT () ByteString (ResourceT IO) ()
-> EditingActions
-> IO (EntrySelector, EntryDescription)
sinkEntry Handle
h EntrySelector
selector EntryOrigin
GenericOrigin (Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
sinking Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
-> EntrySelector -> ConduitT () ByteString (ResourceT IO) ()
forall k a. Ord k => Map k a -> k -> a
! EntrySelector
selector) EditingActions
editing
)
Handle -> Maybe Text -> Map EntrySelector EntryDescription -> IO ()
writeCD Handle
h Maybe Text
comment (Map EntrySelector EntryDescription
copiedCD Map EntrySelector EntryDescription
-> Map EntrySelector EntryDescription
-> Map EntrySelector EntryDescription
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map EntrySelector EntryDescription
sunkCD)
withNewFile ::
FilePath ->
(Handle -> IO ()) ->
IO ()
withNewFile :: FilePath -> (Handle -> IO ()) -> IO ()
withNewFile fpath :: FilePath
fpath action :: Handle -> IO ()
action =
IO (FilePath, Handle)
-> ((FilePath, Handle) -> IO ())
-> ((FilePath, Handle) -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError IO (FilePath, Handle)
allocate (FilePath, Handle) -> IO ()
release (((FilePath, Handle) -> IO ()) -> IO ())
-> ((FilePath, Handle) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(path :: FilePath
path, h :: Handle
h) -> do
Handle -> IO ()
action Handle
h
Handle -> IO ()
hClose Handle
h
FilePath -> FilePath -> IO ()
renameFile FilePath
path FilePath
fpath
where
allocate :: IO (FilePath, Handle)
allocate = FilePath -> FilePath -> IO (FilePath, Handle)
openBinaryTempFile (FilePath -> FilePath
takeDirectory FilePath
fpath) ".zip"
release :: (FilePath, Handle) -> IO ()
release (path :: FilePath
path, h :: Handle
h) = do
Handle -> IO ()
hClose Handle
h
(IOError -> Maybe ()) -> IO () -> (() -> IO ()) -> IO ()
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError) (FilePath -> IO ()
removeFile FilePath
path) (IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
predictComment :: Maybe Text -> Seq PendingAction -> Maybe Text
original :: Maybe Text
original xs :: Seq PendingAction
xs =
case Seq PendingAction -> Int -> PendingAction
forall a. Seq a -> Int -> a
S.index Seq PendingAction
xs (Int -> PendingAction) -> Maybe Int -> Maybe PendingAction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PendingAction -> Bool) -> Seq PendingAction -> Maybe Int
forall a. (a -> Bool) -> Seq a -> Maybe Int
S.findIndexR (Maybe EntrySelector -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe EntrySelector -> Bool)
-> (PendingAction -> Maybe EntrySelector) -> PendingAction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PendingAction -> Maybe EntrySelector
targetEntry) Seq PendingAction
xs of
Nothing -> Maybe Text
original
Just DeleteArchiveComment -> Maybe Text
forall a. Maybe a
Nothing
Just (SetArchiveComment txt :: Text
txt) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
txt
Just _ -> Maybe Text
forall a. Maybe a
Nothing
toRecreatingActions ::
FilePath ->
Map EntrySelector EntryDescription ->
Seq PendingAction
toRecreatingActions :: FilePath -> Map EntrySelector EntryDescription -> Seq PendingAction
toRecreatingActions path :: FilePath
path entries :: Map EntrySelector EntryDescription
entries = (Seq PendingAction -> EntrySelector -> Seq PendingAction)
-> Seq PendingAction -> Set EntrySelector -> Seq PendingAction
forall a b. (a -> b -> a) -> a -> Set b -> a
E.foldl' Seq PendingAction -> EntrySelector -> Seq PendingAction
f Seq PendingAction
forall a. Seq a
S.empty (Map EntrySelector EntryDescription -> Set EntrySelector
forall k a. Map k a -> Set k
M.keysSet Map EntrySelector EntryDescription
entries)
where
f :: Seq PendingAction -> EntrySelector -> Seq PendingAction
f s :: Seq PendingAction
s e :: EntrySelector
e = Seq PendingAction
s Seq PendingAction -> PendingAction -> Seq PendingAction
forall a. Seq a -> a -> Seq a
|> FilePath -> EntrySelector -> EntrySelector -> PendingAction
CopyEntry FilePath
path EntrySelector
e EntrySelector
e
optimize ::
Seq PendingAction ->
(ProducingActions, EditingActions)
optimize :: Seq PendingAction -> (ProducingActions, EditingActions)
optimize =
((ProducingActions, EditingActions)
-> PendingAction -> (ProducingActions, EditingActions))
-> (ProducingActions, EditingActions)
-> Seq PendingAction
-> (ProducingActions, EditingActions)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
(ProducingActions, EditingActions)
-> PendingAction -> (ProducingActions, EditingActions)
f
( Map FilePath (Map EntrySelector EntrySelector)
-> Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
-> ProducingActions
ProducingActions Map FilePath (Map EntrySelector EntrySelector)
forall k a. Map k a
M.empty Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
forall k a. Map k a
M.empty,
Map EntrySelector CompressionMethod
-> Map EntrySelector Text
-> Map EntrySelector ()
-> Map EntrySelector UTCTime
-> Map EntrySelector (Map Word16 ByteString)
-> Map EntrySelector (Map Word16 ())
-> Map EntrySelector Word32
-> EditingActions
EditingActions Map EntrySelector CompressionMethod
forall k a. Map k a
M.empty Map EntrySelector Text
forall k a. Map k a
M.empty Map EntrySelector ()
forall k a. Map k a
M.empty Map EntrySelector UTCTime
forall k a. Map k a
M.empty Map EntrySelector (Map Word16 ByteString)
forall k a. Map k a
M.empty Map EntrySelector (Map Word16 ())
forall k a. Map k a
M.empty Map EntrySelector Word32
forall k a. Map k a
M.empty
)
where
f :: (ProducingActions, EditingActions)
-> PendingAction -> (ProducingActions, EditingActions)
f (pa :: ProducingActions
pa, ea :: EditingActions
ea) a :: PendingAction
a = case PendingAction
a of
SinkEntry m :: CompressionMethod
m src :: ConduitT () ByteString (ResourceT IO) ()
src s :: EntrySelector
s ->
( ProducingActions
pa
{ paSinkEntry :: Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
paSinkEntry = EntrySelector
-> ConduitT () ByteString (ResourceT IO) ()
-> Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
-> Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert EntrySelector
s ConduitT () ByteString (ResourceT IO) ()
src (ProducingActions
-> Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
paSinkEntry ProducingActions
pa),
paCopyEntry :: Map FilePath (Map EntrySelector EntrySelector)
paCopyEntry = (Map EntrySelector EntrySelector
-> Map EntrySelector EntrySelector)
-> Map FilePath (Map EntrySelector EntrySelector)
-> Map FilePath (Map EntrySelector EntrySelector)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((EntrySelector -> Bool)
-> Map EntrySelector EntrySelector
-> Map EntrySelector EntrySelector
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (EntrySelector -> EntrySelector -> Bool
forall a. Eq a => a -> a -> Bool
/= EntrySelector
s)) (ProducingActions -> Map FilePath (Map EntrySelector EntrySelector)
paCopyEntry ProducingActions
pa)
},
(EntrySelector -> EditingActions -> EditingActions
clearEditingFor EntrySelector
s EditingActions
ea)
{ eaCompression :: Map EntrySelector CompressionMethod
eaCompression = EntrySelector
-> CompressionMethod
-> Map EntrySelector CompressionMethod
-> Map EntrySelector CompressionMethod
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert EntrySelector
s CompressionMethod
m (EditingActions -> Map EntrySelector CompressionMethod
eaCompression EditingActions
ea)
}
)
CopyEntry path :: FilePath
path os :: EntrySelector
os ns :: EntrySelector
ns ->
( ProducingActions
pa
{ paSinkEntry :: Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
paSinkEntry = EntrySelector
-> Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
-> Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
forall k a. Ord k => k -> Map k a -> Map k a
M.delete EntrySelector
ns (ProducingActions
-> Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
paSinkEntry ProducingActions
pa),
paCopyEntry :: Map FilePath (Map EntrySelector EntrySelector)
paCopyEntry = (Maybe (Map EntrySelector EntrySelector)
-> Maybe (Map EntrySelector EntrySelector))
-> FilePath
-> Map FilePath (Map EntrySelector EntrySelector)
-> Map FilePath (Map EntrySelector EntrySelector)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (EntrySelector
-> EntrySelector
-> Maybe (Map EntrySelector EntrySelector)
-> Maybe (Map EntrySelector EntrySelector)
forall k a. Ord k => k -> a -> Maybe (Map k a) -> Maybe (Map k a)
ef EntrySelector
os EntrySelector
ns) FilePath
path (ProducingActions -> Map FilePath (Map EntrySelector EntrySelector)
paCopyEntry ProducingActions
pa)
},
EntrySelector -> EditingActions -> EditingActions
clearEditingFor EntrySelector
ns EditingActions
ea
)
RenameEntry os :: EntrySelector
os ns :: EntrySelector
ns ->
( ProducingActions
pa
{ paCopyEntry :: Map FilePath (Map EntrySelector EntrySelector)
paCopyEntry = (Map EntrySelector EntrySelector
-> Map EntrySelector EntrySelector)
-> Map FilePath (Map EntrySelector EntrySelector)
-> Map FilePath (Map EntrySelector EntrySelector)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((EntrySelector -> EntrySelector)
-> Map EntrySelector EntrySelector
-> Map EntrySelector EntrySelector
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((EntrySelector -> EntrySelector)
-> Map EntrySelector EntrySelector
-> Map EntrySelector EntrySelector)
-> (EntrySelector -> EntrySelector)
-> Map EntrySelector EntrySelector
-> Map EntrySelector EntrySelector
forall a b. (a -> b) -> a -> b
$ EntrySelector -> EntrySelector -> EntrySelector -> EntrySelector
forall p. Eq p => p -> p -> p -> p
re EntrySelector
os EntrySelector
ns) (ProducingActions -> Map FilePath (Map EntrySelector EntrySelector)
paCopyEntry ProducingActions
pa),
paSinkEntry :: Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
paSinkEntry = EntrySelector
-> EntrySelector
-> Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
-> Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
forall k a. Ord k => k -> k -> Map k a -> Map k a
renameKey EntrySelector
os EntrySelector
ns (ProducingActions
-> Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
paSinkEntry ProducingActions
pa)
},
EditingActions
ea
{ eaCompression :: Map EntrySelector CompressionMethod
eaCompression = EntrySelector
-> EntrySelector
-> Map EntrySelector CompressionMethod
-> Map EntrySelector CompressionMethod
forall k a. Ord k => k -> k -> Map k a -> Map k a
renameKey EntrySelector
os EntrySelector
ns (EditingActions -> Map EntrySelector CompressionMethod
eaCompression EditingActions
ea),
eaEntryComment :: Map EntrySelector Text
eaEntryComment = EntrySelector
-> EntrySelector
-> Map EntrySelector Text
-> Map EntrySelector Text
forall k a. Ord k => k -> k -> Map k a -> Map k a
renameKey EntrySelector
os EntrySelector
ns (EditingActions -> Map EntrySelector Text
eaEntryComment EditingActions
ea),
eaDeleteComment :: Map EntrySelector ()
eaDeleteComment = EntrySelector
-> EntrySelector -> Map EntrySelector () -> Map EntrySelector ()
forall k a. Ord k => k -> k -> Map k a -> Map k a
renameKey EntrySelector
os EntrySelector
ns (EditingActions -> Map EntrySelector ()
eaDeleteComment EditingActions
ea),
eaModTime :: Map EntrySelector UTCTime
eaModTime = EntrySelector
-> EntrySelector
-> Map EntrySelector UTCTime
-> Map EntrySelector UTCTime
forall k a. Ord k => k -> k -> Map k a -> Map k a
renameKey EntrySelector
os EntrySelector
ns (EditingActions -> Map EntrySelector UTCTime
eaModTime EditingActions
ea),
eaExtraField :: Map EntrySelector (Map Word16 ByteString)
eaExtraField = EntrySelector
-> EntrySelector
-> Map EntrySelector (Map Word16 ByteString)
-> Map EntrySelector (Map Word16 ByteString)
forall k a. Ord k => k -> k -> Map k a -> Map k a
renameKey EntrySelector
os EntrySelector
ns (EditingActions -> Map EntrySelector (Map Word16 ByteString)
eaExtraField EditingActions
ea),
eaDeleteField :: Map EntrySelector (Map Word16 ())
eaDeleteField = EntrySelector
-> EntrySelector
-> Map EntrySelector (Map Word16 ())
-> Map EntrySelector (Map Word16 ())
forall k a. Ord k => k -> k -> Map k a -> Map k a
renameKey EntrySelector
os EntrySelector
ns (EditingActions -> Map EntrySelector (Map Word16 ())
eaDeleteField EditingActions
ea)
}
)
DeleteEntry s :: EntrySelector
s ->
( ProducingActions
pa
{ paSinkEntry :: Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
paSinkEntry = EntrySelector
-> Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
-> Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
forall k a. Ord k => k -> Map k a -> Map k a
M.delete EntrySelector
s (ProducingActions
-> Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())
paSinkEntry ProducingActions
pa),
paCopyEntry :: Map FilePath (Map EntrySelector EntrySelector)
paCopyEntry = (Map EntrySelector EntrySelector
-> Map EntrySelector EntrySelector)
-> Map FilePath (Map EntrySelector EntrySelector)
-> Map FilePath (Map EntrySelector EntrySelector)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (EntrySelector
-> Map EntrySelector EntrySelector
-> Map EntrySelector EntrySelector
forall k a. Ord k => k -> Map k a -> Map k a
M.delete EntrySelector
s) (ProducingActions -> Map FilePath (Map EntrySelector EntrySelector)
paCopyEntry ProducingActions
pa)
},
EntrySelector -> EditingActions -> EditingActions
clearEditingFor EntrySelector
s EditingActions
ea
)
Recompress m :: CompressionMethod
m s :: EntrySelector
s ->
(ProducingActions
pa, EditingActions
ea {eaCompression :: Map EntrySelector CompressionMethod
eaCompression = EntrySelector
-> CompressionMethod
-> Map EntrySelector CompressionMethod
-> Map EntrySelector CompressionMethod
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert EntrySelector
s CompressionMethod
m (EditingActions -> Map EntrySelector CompressionMethod
eaCompression EditingActions
ea)})
SetEntryComment txt :: Text
txt s :: EntrySelector
s ->
( ProducingActions
pa,
EditingActions
ea
{ eaEntryComment :: Map EntrySelector Text
eaEntryComment = EntrySelector
-> Text -> Map EntrySelector Text -> Map EntrySelector Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert EntrySelector
s Text
txt (EditingActions -> Map EntrySelector Text
eaEntryComment EditingActions
ea),
eaDeleteComment :: Map EntrySelector ()
eaDeleteComment = EntrySelector -> Map EntrySelector () -> Map EntrySelector ()
forall k a. Ord k => k -> Map k a -> Map k a
M.delete EntrySelector
s (EditingActions -> Map EntrySelector ()
eaDeleteComment EditingActions
ea)
}
)
DeleteEntryComment s :: EntrySelector
s ->
( ProducingActions
pa,
EditingActions
ea
{ eaEntryComment :: Map EntrySelector Text
eaEntryComment = EntrySelector -> Map EntrySelector Text -> Map EntrySelector Text
forall k a. Ord k => k -> Map k a -> Map k a
M.delete EntrySelector
s (EditingActions -> Map EntrySelector Text
eaEntryComment EditingActions
ea),
eaDeleteComment :: Map EntrySelector ()
eaDeleteComment = EntrySelector -> () -> Map EntrySelector () -> Map EntrySelector ()
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert EntrySelector
s () (EditingActions -> Map EntrySelector ()
eaDeleteComment EditingActions
ea)
}
)
SetModTime time :: UTCTime
time s :: EntrySelector
s ->
(ProducingActions
pa, EditingActions
ea {eaModTime :: Map EntrySelector UTCTime
eaModTime = EntrySelector
-> UTCTime
-> Map EntrySelector UTCTime
-> Map EntrySelector UTCTime
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert EntrySelector
s UTCTime
time (EditingActions -> Map EntrySelector UTCTime
eaModTime EditingActions
ea)})
AddExtraField n :: Word16
n b :: ByteString
b s :: EntrySelector
s ->
( ProducingActions
pa,
EditingActions
ea
{ eaExtraField :: Map EntrySelector (Map Word16 ByteString)
eaExtraField = (Maybe (Map Word16 ByteString) -> Maybe (Map Word16 ByteString))
-> EntrySelector
-> Map EntrySelector (Map Word16 ByteString)
-> Map EntrySelector (Map Word16 ByteString)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (Word16
-> ByteString
-> Maybe (Map Word16 ByteString)
-> Maybe (Map Word16 ByteString)
forall k a. Ord k => k -> a -> Maybe (Map k a) -> Maybe (Map k a)
ef Word16
n ByteString
b) EntrySelector
s (EditingActions -> Map EntrySelector (Map Word16 ByteString)
eaExtraField EditingActions
ea),
eaDeleteField :: Map EntrySelector (Map Word16 ())
eaDeleteField = EntrySelector
-> Map EntrySelector (Map Word16 ())
-> Map EntrySelector (Map Word16 ())
forall k a. Ord k => k -> Map k a -> Map k a
M.delete EntrySelector
s (EditingActions -> Map EntrySelector (Map Word16 ())
eaDeleteField EditingActions
ea)
}
)
DeleteExtraField n :: Word16
n s :: EntrySelector
s ->
( ProducingActions
pa,
EditingActions
ea
{ eaExtraField :: Map EntrySelector (Map Word16 ByteString)
eaExtraField = (Maybe (Map Word16 ByteString) -> Maybe (Map Word16 ByteString))
-> EntrySelector
-> Map EntrySelector (Map Word16 ByteString)
-> Map EntrySelector (Map Word16 ByteString)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (Word16
-> Maybe (Map Word16 ByteString) -> Maybe (Map Word16 ByteString)
forall k a. Ord k => k -> Maybe (Map k a) -> Maybe (Map k a)
er Word16
n) EntrySelector
s (EditingActions -> Map EntrySelector (Map Word16 ByteString)
eaExtraField EditingActions
ea),
eaDeleteField :: Map EntrySelector (Map Word16 ())
eaDeleteField = (Maybe (Map Word16 ()) -> Maybe (Map Word16 ()))
-> EntrySelector
-> Map EntrySelector (Map Word16 ())
-> Map EntrySelector (Map Word16 ())
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (Word16 -> () -> Maybe (Map Word16 ()) -> Maybe (Map Word16 ())
forall k a. Ord k => k -> a -> Maybe (Map k a) -> Maybe (Map k a)
ef Word16
n ()) EntrySelector
s (EditingActions -> Map EntrySelector (Map Word16 ())
eaDeleteField EditingActions
ea)
}
)
SetExternalFileAttributes b :: Word32
b s :: EntrySelector
s ->
( ProducingActions
pa,
EditingActions
ea {eaExtFileAttr :: Map EntrySelector Word32
eaExtFileAttr = EntrySelector
-> Word32 -> Map EntrySelector Word32 -> Map EntrySelector Word32
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert EntrySelector
s Word32
b (EditingActions -> Map EntrySelector Word32
eaExtFileAttr EditingActions
ea)}
)
_ -> (ProducingActions
pa, EditingActions
ea)
clearEditingFor :: EntrySelector -> EditingActions -> EditingActions
clearEditingFor s :: EntrySelector
s ea :: EditingActions
ea =
EditingActions
ea
{ eaCompression :: Map EntrySelector CompressionMethod
eaCompression = EntrySelector
-> Map EntrySelector CompressionMethod
-> Map EntrySelector CompressionMethod
forall k a. Ord k => k -> Map k a -> Map k a
M.delete EntrySelector
s (EditingActions -> Map EntrySelector CompressionMethod
eaCompression EditingActions
ea),
eaEntryComment :: Map EntrySelector Text
eaEntryComment = EntrySelector -> Map EntrySelector Text -> Map EntrySelector Text
forall k a. Ord k => k -> Map k a -> Map k a
M.delete EntrySelector
s (EditingActions -> Map EntrySelector Text
eaEntryComment EditingActions
ea),
eaDeleteComment :: Map EntrySelector ()
eaDeleteComment = EntrySelector -> Map EntrySelector () -> Map EntrySelector ()
forall k a. Ord k => k -> Map k a -> Map k a
M.delete EntrySelector
s (EditingActions -> Map EntrySelector ()
eaDeleteComment EditingActions
ea),
eaModTime :: Map EntrySelector UTCTime
eaModTime = EntrySelector
-> Map EntrySelector UTCTime -> Map EntrySelector UTCTime
forall k a. Ord k => k -> Map k a -> Map k a
M.delete EntrySelector
s (EditingActions -> Map EntrySelector UTCTime
eaModTime EditingActions
ea),
eaExtraField :: Map EntrySelector (Map Word16 ByteString)
eaExtraField = EntrySelector
-> Map EntrySelector (Map Word16 ByteString)
-> Map EntrySelector (Map Word16 ByteString)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete EntrySelector
s (EditingActions -> Map EntrySelector (Map Word16 ByteString)
eaExtraField EditingActions
ea),
eaDeleteField :: Map EntrySelector (Map Word16 ())
eaDeleteField = EntrySelector
-> Map EntrySelector (Map Word16 ())
-> Map EntrySelector (Map Word16 ())
forall k a. Ord k => k -> Map k a -> Map k a
M.delete EntrySelector
s (EditingActions -> Map EntrySelector (Map Word16 ())
eaDeleteField EditingActions
ea),
eaExtFileAttr :: Map EntrySelector Word32
eaExtFileAttr = EntrySelector
-> Map EntrySelector Word32 -> Map EntrySelector Word32
forall k a. Ord k => k -> Map k a -> Map k a
M.delete EntrySelector
s (EditingActions -> Map EntrySelector Word32
eaExtFileAttr EditingActions
ea)
}
re :: p -> p -> p -> p
re o :: p
o n :: p
n x :: p
x = if p
x p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
o then p
n else p
x
ef :: k -> a -> Maybe (Map k a) -> Maybe (Map k a)
ef k :: k
k v :: a
v (Just m :: Map k a
m) = Map k a -> Maybe (Map k a)
forall a. a -> Maybe a
Just (k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
k a
v Map k a
m)
ef k :: k
k v :: a
v Nothing = Map k a -> Maybe (Map k a)
forall a. a -> Maybe a
Just (k -> a -> Map k a
forall k a. k -> a -> Map k a
M.singleton k
k a
v)
er :: k -> Maybe (Map k a) -> Maybe (Map k a)
er k :: k
k (Just m :: Map k a
m) =
let n :: Map k a
n = k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
M.delete k
k Map k a
m
in if Map k a -> Bool
forall k a. Map k a -> Bool
M.null Map k a
n then Maybe (Map k a)
forall a. Maybe a
Nothing else Map k a -> Maybe (Map k a)
forall a. a -> Maybe a
Just Map k a
n
er _ Nothing = Maybe (Map k a)
forall a. Maybe a
Nothing
copyEntries ::
Handle ->
FilePath ->
Map EntrySelector EntrySelector ->
EditingActions ->
IO (Map EntrySelector EntryDescription)
copyEntries :: Handle
-> FilePath
-> Map EntrySelector EntrySelector
-> EditingActions
-> IO (Map EntrySelector EntryDescription)
copyEntries h :: Handle
h path :: FilePath
path m :: Map EntrySelector EntrySelector
m e :: EditingActions
e = do
Map EntrySelector EntryDescription
entries <- (ArchiveDescription, Map EntrySelector EntryDescription)
-> Map EntrySelector EntryDescription
forall a b. (a, b) -> b
snd ((ArchiveDescription, Map EntrySelector EntryDescription)
-> Map EntrySelector EntryDescription)
-> IO (ArchiveDescription, Map EntrySelector EntryDescription)
-> IO (Map EntrySelector EntryDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
-> IO (ArchiveDescription, Map EntrySelector EntryDescription)
scanArchive FilePath
path
[(EntrySelector, EntryDescription)]
done <- [EntrySelector]
-> (EntrySelector -> IO (EntrySelector, EntryDescription))
-> IO [(EntrySelector, EntryDescription)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map EntrySelector EntrySelector -> [EntrySelector]
forall k a. Map k a -> [k]
M.keys Map EntrySelector EntrySelector
m) ((EntrySelector -> IO (EntrySelector, EntryDescription))
-> IO [(EntrySelector, EntryDescription)])
-> (EntrySelector -> IO (EntrySelector, EntryDescription))
-> IO [(EntrySelector, EntryDescription)]
forall a b. (a -> b) -> a -> b
$ \s :: EntrySelector
s ->
case EntrySelector
s EntrySelector
-> Map EntrySelector EntryDescription -> Maybe EntryDescription
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map EntrySelector EntryDescription
entries of
Nothing -> ZipException -> IO (EntrySelector, EntryDescription)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FilePath -> EntrySelector -> ZipException
EntryDoesNotExist FilePath
path EntrySelector
s)
Just desc :: EntryDescription
desc ->
Handle
-> EntrySelector
-> EntryOrigin
-> ConduitT () ByteString (ResourceT IO) ()
-> EditingActions
-> IO (EntrySelector, EntryDescription)
sinkEntry
Handle
h
(Map EntrySelector EntrySelector
m Map EntrySelector EntrySelector -> EntrySelector -> EntrySelector
forall k a. Ord k => Map k a -> k -> a
! EntrySelector
s)
(EntryDescription -> EntryOrigin
Borrowed EntryDescription
desc)
(FilePath
-> EntryDescription
-> Bool
-> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
FilePath -> EntryDescription -> Bool -> ConduitT () ByteString m ()
sourceEntry FilePath
path EntryDescription
desc Bool
False)
EditingActions
e
Map EntrySelector EntryDescription
-> IO (Map EntrySelector EntryDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(EntrySelector, EntryDescription)]
-> Map EntrySelector EntryDescription
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(EntrySelector, EntryDescription)]
done)
sinkEntry ::
Handle ->
EntrySelector ->
EntryOrigin ->
ConduitT () ByteString (ResourceT IO) () ->
EditingActions ->
IO (EntrySelector, EntryDescription)
sinkEntry :: Handle
-> EntrySelector
-> EntryOrigin
-> ConduitT () ByteString (ResourceT IO) ()
-> EditingActions
-> IO (EntrySelector, EntryDescription)
sinkEntry h :: Handle
h s :: EntrySelector
s o :: EntryOrigin
o src :: ConduitT () ByteString (ResourceT IO) ()
src EditingActions {..} = do
UTCTime
currentTime <- IO UTCTime
getCurrentTime
Integer
offset <- Handle -> IO Integer
hTell Handle
h
let compressed :: CompressionMethod
compressed = case EntryOrigin
o of
GenericOrigin -> CompressionMethod
Store
Borrowed ed :: EntryDescription
ed -> EntryDescription -> CompressionMethod
edCompression EntryDescription
ed
compression :: CompressionMethod
compression = CompressionMethod
-> EntrySelector
-> Map EntrySelector CompressionMethod
-> CompressionMethod
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault CompressionMethod
compressed EntrySelector
s Map EntrySelector CompressionMethod
eaCompression
recompression :: Bool
recompression = CompressionMethod
compression CompressionMethod -> CompressionMethod -> Bool
forall a. Eq a => a -> a -> Bool
/= CompressionMethod
compressed
modTime :: UTCTime
modTime = case EntryOrigin
o of
GenericOrigin -> UTCTime
currentTime
Borrowed ed :: EntryDescription
ed -> EntryDescription -> UTCTime
edModTime EntryDescription
ed
extFileAttr :: Word32
extFileAttr = case EntryOrigin
o of
GenericOrigin -> Word32 -> EntrySelector -> Map EntrySelector Word32 -> Word32
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Word32
defaultFileMode EntrySelector
s Map EntrySelector Word32
eaExtFileAttr
Borrowed _ -> Word32 -> EntrySelector -> Map EntrySelector Word32 -> Word32
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Word32
defaultFileMode EntrySelector
s Map EntrySelector Word32
eaExtFileAttr
oldExtraFields :: Map Word16 ByteString
oldExtraFields = case EntryOrigin
o of
GenericOrigin -> Map Word16 ByteString
forall k a. Map k a
M.empty
Borrowed ed :: EntryDescription
ed -> EntryDescription -> Map Word16 ByteString
edExtraField EntryDescription
ed
extraField :: Map Word16 ByteString
extraField =
(Map Word16 ByteString
-> EntrySelector
-> Map EntrySelector (Map Word16 ByteString)
-> Map Word16 ByteString
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Map Word16 ByteString
forall k a. Map k a
M.empty EntrySelector
s Map EntrySelector (Map Word16 ByteString)
eaExtraField Map Word16 ByteString
-> Map Word16 ByteString -> Map Word16 ByteString
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map Word16 ByteString
oldExtraFields)
Map Word16 ByteString -> Map Word16 () -> Map Word16 ByteString
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map Word16 ()
-> EntrySelector
-> Map EntrySelector (Map Word16 ())
-> Map Word16 ()
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Map Word16 ()
forall k a. Map k a
M.empty EntrySelector
s Map EntrySelector (Map Word16 ())
eaDeleteField
oldComment :: Maybe Text
oldComment = case (EntryOrigin
o, EntrySelector -> Map EntrySelector () -> Maybe ()
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup EntrySelector
s Map EntrySelector ()
eaDeleteComment) of
(GenericOrigin, _) -> Maybe Text
forall a. Maybe a
Nothing
(Borrowed ed :: EntryDescription
ed, Nothing) -> EntryDescription -> Maybe Text
edComment EntryDescription
ed
(Borrowed _, Just ()) -> Maybe Text
forall a. Maybe a
Nothing
desc0 :: EntryDescription
desc0 =
EntryDescription :: Version
-> Version
-> CompressionMethod
-> UTCTime
-> Word32
-> Natural
-> Natural
-> Natural
-> Maybe Text
-> Map Word16 ByteString
-> Word32
-> EntryDescription
EntryDescription
{ edVersionMadeBy :: Version
edVersionMadeBy = Version
zipVersion,
edVersionNeeded :: Version
edVersionNeeded = Version
zipVersion,
edCompression :: CompressionMethod
edCompression = CompressionMethod
compression,
edModTime :: UTCTime
edModTime = UTCTime -> EntrySelector -> Map EntrySelector UTCTime -> UTCTime
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault UTCTime
modTime EntrySelector
s Map EntrySelector UTCTime
eaModTime,
edCRC32 :: Word32
edCRC32 = 0,
edCompressedSize :: Natural
edCompressedSize = 0,
edUncompressedSize :: Natural
edUncompressedSize = 0,
edOffset :: Natural
edOffset = Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
offset,
edComment :: Maybe Text
edComment = EntrySelector -> Map EntrySelector Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup EntrySelector
s Map EntrySelector Text
eaEntryComment Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
oldComment,
edExtraField :: Map Word16 ByteString
edExtraField = Map Word16 ByteString
extraField,
edExternalFileAttrs :: Word32
edExternalFileAttrs = Word32
extFileAttr
}
Handle -> ByteString -> IO ()
B.hPut Handle
h (Put -> ByteString
runPut (HeaderType -> EntrySelector -> EntryDescription -> Put
putHeader HeaderType
LocalHeader EntrySelector
s EntryDescription
desc0))
DataDescriptor {..} <-
ConduitT () Void (ResourceT IO) DataDescriptor -> IO DataDescriptor
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
C.runConduitRes (ConduitT () Void (ResourceT IO) DataDescriptor
-> IO DataDescriptor)
-> ConduitT () Void (ResourceT IO) DataDescriptor
-> IO DataDescriptor
forall a b. (a -> b) -> a -> b
$
if Bool
recompression
then
if CompressionMethod
compressed CompressionMethod -> CompressionMethod -> Bool
forall a. Eq a => a -> a -> Bool
== CompressionMethod
Store
then ConduitT () ByteString (ResourceT IO) ()
src ConduitT () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) DataDescriptor
-> ConduitT () Void (ResourceT IO) DataDescriptor
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Handle
-> CompressionMethod
-> ConduitM ByteString Void (ResourceT IO) DataDescriptor
sinkData Handle
h CompressionMethod
compression
else ConduitT () ByteString (ResourceT IO) ()
src ConduitT () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) DataDescriptor
-> ConduitT () Void (ResourceT IO) DataDescriptor
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| CompressionMethod
-> ConduitT ByteString ByteString (ResourceT IO) ()
forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
CompressionMethod -> ConduitT ByteString ByteString m ()
decompressingPipe CompressionMethod
compressed ConduitT ByteString ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) DataDescriptor
-> ConduitM ByteString Void (ResourceT IO) DataDescriptor
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Handle
-> CompressionMethod
-> ConduitM ByteString Void (ResourceT IO) DataDescriptor
sinkData Handle
h CompressionMethod
compression
else ConduitT () ByteString (ResourceT IO) ()
src ConduitT () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) DataDescriptor
-> ConduitT () Void (ResourceT IO) DataDescriptor
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Handle
-> CompressionMethod
-> ConduitM ByteString Void (ResourceT IO) DataDescriptor
sinkData Handle
h CompressionMethod
Store
Integer
afterStreaming <- Handle -> IO Integer
hTell Handle
h
let desc1 :: EntryDescription
desc1 = case EntryOrigin
o of
GenericOrigin ->
EntryDescription
desc0
{ edCRC32 :: Word32
edCRC32 = Word32
ddCRC32,
edCompressedSize :: Natural
edCompressedSize = Natural
ddCompressedSize,
edUncompressedSize :: Natural
edUncompressedSize = Natural
ddUncompressedSize
}
Borrowed ed :: EntryDescription
ed ->
EntryDescription
desc0
{ edCRC32 :: Word32
edCRC32 =
Word32 -> Word32 -> Bool -> Word32
forall a. a -> a -> Bool -> a
bool (EntryDescription -> Word32
edCRC32 EntryDescription
ed) Word32
ddCRC32 Bool
recompression,
edCompressedSize :: Natural
edCompressedSize =
Natural -> Natural -> Bool -> Natural
forall a. a -> a -> Bool -> a
bool (EntryDescription -> Natural
edCompressedSize EntryDescription
ed) Natural
ddCompressedSize Bool
recompression,
edUncompressedSize :: Natural
edUncompressedSize =
Natural -> Natural -> Bool -> Natural
forall a. a -> a -> Bool -> a
bool (EntryDescription -> Natural
edUncompressedSize EntryDescription
ed) Natural
ddUncompressedSize Bool
recompression
}
desc2 :: EntryDescription
desc2 =
EntryDescription
desc1
{ edVersionNeeded :: Version
edVersionNeeded =
Bool -> Maybe CompressionMethod -> Version
getZipVersion (EntryDescription -> Bool
needsZip64 EntryDescription
desc1) (CompressionMethod -> Maybe CompressionMethod
forall a. a -> Maybe a
Just CompressionMethod
compression)
}
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
offset
Handle -> ByteString -> IO ()
B.hPut Handle
h (Put -> ByteString
runPut (HeaderType -> EntrySelector -> EntryDescription -> Put
putHeader HeaderType
LocalHeader EntrySelector
s EntryDescription
desc2))
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
afterStreaming
(EntrySelector, EntryDescription)
-> IO (EntrySelector, EntryDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return (EntrySelector
s, EntryDescription
desc2)
sinkData ::
Handle ->
CompressionMethod ->
ConduitT ByteString Void (ResourceT IO) DataDescriptor
sinkData :: Handle
-> CompressionMethod
-> ConduitM ByteString Void (ResourceT IO) DataDescriptor
sinkData h :: Handle
h compression :: CompressionMethod
compression = do
let sizeSink :: ConduitT ByteString o (ResourceT IO) Natural
sizeSink = (Natural -> ByteString -> Natural)
-> Natural -> ConduitT ByteString o (ResourceT IO) Natural
forall (m :: * -> *) b a o.
Monad m =>
(b -> a -> b) -> b -> ConduitT a o m b
CL.fold (\acc :: Natural
acc input :: ByteString
input -> Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
input) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
acc) 0
dataSink :: Sink ByteString (ResourceT IO) Natural
dataSink =
ZipSink ByteString (ResourceT IO) Natural
-> Sink ByteString (ResourceT IO) Natural
forall i (m :: * -> *) r. ZipSink i m r -> Sink i m r
getZipSink (ZipSink ByteString (ResourceT IO) Natural
-> Sink ByteString (ResourceT IO) Natural)
-> ZipSink ByteString (ResourceT IO) Natural
-> Sink ByteString (ResourceT IO) Natural
forall a b. (a -> b) -> a -> b
$
Sink ByteString (ResourceT IO) Natural
-> ZipSink ByteString (ResourceT IO) Natural
forall i (m :: * -> *) r. Sink i m r -> ZipSink i m r
ZipSink Sink ByteString (ResourceT IO) Natural
forall o. ConduitT ByteString o (ResourceT IO) Natural
sizeSink ZipSink ByteString (ResourceT IO) Natural
-> ZipSink ByteString (ResourceT IO) ()
-> ZipSink ByteString (ResourceT IO) Natural
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Sink ByteString (ResourceT IO) ()
-> ZipSink ByteString (ResourceT IO) ()
forall i (m :: * -> *) r. Sink i m r -> ZipSink i m r
ZipSink (Handle -> Sink ByteString (ResourceT IO) ()
forall (m :: * -> *) o.
MonadIO m =>
Handle -> ConduitT ByteString o m ()
CB.sinkHandle Handle
h)
withCompression :: Sink ByteString (ResourceT IO) a
-> Sink ByteString (ResourceT IO) (Natural, Word32, a)
withCompression sink :: Sink ByteString (ResourceT IO) a
sink =
ZipSink ByteString (ResourceT IO) (Natural, Word32, a)
-> Sink ByteString (ResourceT IO) (Natural, Word32, a)
forall i (m :: * -> *) r. ZipSink i m r -> Sink i m r
getZipSink (ZipSink ByteString (ResourceT IO) (Natural, Word32, a)
-> Sink ByteString (ResourceT IO) (Natural, Word32, a))
-> ZipSink ByteString (ResourceT IO) (Natural, Word32, a)
-> Sink ByteString (ResourceT IO) (Natural, Word32, a)
forall a b. (a -> b) -> a -> b
$
(,,) (Natural -> Word32 -> a -> (Natural, Word32, a))
-> ZipSink ByteString (ResourceT IO) Natural
-> ZipSink
ByteString (ResourceT IO) (Word32 -> a -> (Natural, Word32, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sink ByteString (ResourceT IO) Natural
-> ZipSink ByteString (ResourceT IO) Natural
forall i (m :: * -> *) r. Sink i m r -> ZipSink i m r
ZipSink Sink ByteString (ResourceT IO) Natural
forall o. ConduitT ByteString o (ResourceT IO) Natural
sizeSink
ZipSink
ByteString (ResourceT IO) (Word32 -> a -> (Natural, Word32, a))
-> ZipSink ByteString (ResourceT IO) Word32
-> ZipSink ByteString (ResourceT IO) (a -> (Natural, Word32, a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sink ByteString (ResourceT IO) Word32
-> ZipSink ByteString (ResourceT IO) Word32
forall i (m :: * -> *) r. Sink i m r -> ZipSink i m r
ZipSink Sink ByteString (ResourceT IO) Word32
crc32Sink
ZipSink ByteString (ResourceT IO) (a -> (Natural, Word32, a))
-> ZipSink ByteString (ResourceT IO) a
-> ZipSink ByteString (ResourceT IO) (Natural, Word32, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sink ByteString (ResourceT IO) a
-> ZipSink ByteString (ResourceT IO) a
forall i (m :: * -> *) r. Sink i m r -> ZipSink i m r
ZipSink Sink ByteString (ResourceT IO) a
sink
(uncompressedSize :: Natural
uncompressedSize, crc32 :: Word32
crc32, compressedSize :: Natural
compressedSize) <-
case CompressionMethod
compression of
Store ->
Sink ByteString (ResourceT IO) Natural
-> Sink ByteString (ResourceT IO) (Natural, Word32, Natural)
forall a.
Sink ByteString (ResourceT IO) a
-> Sink ByteString (ResourceT IO) (Natural, Word32, a)
withCompression
Sink ByteString (ResourceT IO) Natural
dataSink
Deflate ->
Sink ByteString (ResourceT IO) Natural
-> Sink ByteString (ResourceT IO) (Natural, Word32, Natural)
forall a.
Sink ByteString (ResourceT IO) a
-> Sink ByteString (ResourceT IO) (Natural, Word32, a)
withCompression (Sink ByteString (ResourceT IO) Natural
-> Sink ByteString (ResourceT IO) (Natural, Word32, Natural))
-> Sink ByteString (ResourceT IO) Natural
-> Sink ByteString (ResourceT IO) (Natural, Word32, Natural)
forall a b. (a -> b) -> a -> b
$
Int
-> WindowBits -> ConduitT ByteString ByteString (ResourceT IO) ()
forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
Int -> WindowBits -> ConduitT ByteString ByteString m ()
Z.compress 9 (Int -> WindowBits
Z.WindowBits (-15)) ConduitT ByteString ByteString (ResourceT IO) ()
-> Sink ByteString (ResourceT IO) Natural
-> Sink ByteString (ResourceT IO) Natural
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Sink ByteString (ResourceT IO) Natural
dataSink
#ifdef ENABLE_BZIP2
BZip2 ->
Sink ByteString (ResourceT IO) Natural
-> Sink ByteString (ResourceT IO) (Natural, Word32, Natural)
forall a.
Sink ByteString (ResourceT IO) a
-> Sink ByteString (ResourceT IO) (Natural, Word32, a)
withCompression (Sink ByteString (ResourceT IO) Natural
-> Sink ByteString (ResourceT IO) (Natural, Word32, Natural))
-> Sink ByteString (ResourceT IO) Natural
-> Sink ByteString (ResourceT IO) (Natural, Word32, Natural)
forall a b. (a -> b) -> a -> b
$
ConduitT ByteString ByteString (ResourceT IO) ()
forall (m :: * -> *).
MonadResource m =>
ConduitT ByteString ByteString m ()
BZ.bzip2 ConduitT ByteString ByteString (ResourceT IO) ()
-> Sink ByteString (ResourceT IO) Natural
-> Sink ByteString (ResourceT IO) Natural
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Sink ByteString (ResourceT IO) Natural
dataSink
#else
BZip2 -> throwM BZip2Unsupported
#endif
#ifdef ENABLE_ZSTD
Zstd ->
Sink ByteString (ResourceT IO) Natural
-> Sink ByteString (ResourceT IO) (Natural, Word32, Natural)
forall a.
Sink ByteString (ResourceT IO) a
-> Sink ByteString (ResourceT IO) (Natural, Word32, a)
withCompression (Sink ByteString (ResourceT IO) Natural
-> Sink ByteString (ResourceT IO) (Natural, Word32, Natural))
-> Sink ByteString (ResourceT IO) Natural
-> Sink ByteString (ResourceT IO) (Natural, Word32, Natural)
forall a b. (a -> b) -> a -> b
$
Int -> ConduitT ByteString ByteString (ResourceT IO) ()
forall (m :: * -> *).
MonadIO m =>
Int -> ConduitT ByteString ByteString m ()
Zstandard.compress 1 ConduitT ByteString ByteString (ResourceT IO) ()
-> Sink ByteString (ResourceT IO) Natural
-> Sink ByteString (ResourceT IO) Natural
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Sink ByteString (ResourceT IO) Natural
dataSink
#else
Zstd -> throwM ZstdUnsupported
#endif
DataDescriptor
-> ConduitM ByteString Void (ResourceT IO) DataDescriptor
forall (m :: * -> *) a. Monad m => a -> m a
return
DataDescriptor :: Word32 -> Natural -> Natural -> DataDescriptor
DataDescriptor
{ ddCRC32 :: Word32
ddCRC32 = Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
crc32,
ddCompressedSize :: Natural
ddCompressedSize = Natural
compressedSize,
ddUncompressedSize :: Natural
ddUncompressedSize = Natural
uncompressedSize
}
writeCD ::
Handle ->
Maybe Text ->
Map EntrySelector EntryDescription ->
IO ()
writeCD :: Handle -> Maybe Text -> Map EntrySelector EntryDescription -> IO ()
writeCD h :: Handle
h comment :: Maybe Text
comment m :: Map EntrySelector EntryDescription
m = do
let cd :: ByteString
cd = Put -> ByteString
runPut (Map EntrySelector EntryDescription -> Put
putCD Map EntrySelector EntryDescription
m)
Natural
cdOffset <- Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Natural) -> IO Integer -> IO Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Integer
hTell Handle
h
Handle -> ByteString -> IO ()
B.hPut Handle
h ByteString
cd
let totalCount :: Natural
totalCount = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Map EntrySelector EntryDescription -> Int
forall k a. Map k a -> Int
M.size Map EntrySelector EntryDescription
m)
cdSize :: Natural
cdSize = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
cd)
needZip64 :: Bool
needZip64 =
Natural
totalCount Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural
ffff
Bool -> Bool -> Bool
|| Natural
cdSize Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural
ffffffff
Bool -> Bool -> Bool
|| Natural
cdOffset Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural
ffffffff
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needZip64 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Natural
zip64ecdOffset <- Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Natural) -> IO Integer -> IO Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Integer
hTell Handle
h
(Handle -> ByteString -> IO ()
B.hPut Handle
h (ByteString -> IO ()) -> (Put -> ByteString) -> Put -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut) (Natural -> Natural -> Natural -> Put
putZip64ECD Natural
totalCount Natural
cdSize Natural
cdOffset)
(Handle -> ByteString -> IO ()
B.hPut Handle
h (ByteString -> IO ()) -> (Put -> ByteString) -> Put -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut) (Natural -> Put
putZip64ECDLocator Natural
zip64ecdOffset)
(Handle -> ByteString -> IO ()
B.hPut Handle
h (ByteString -> IO ()) -> (Put -> ByteString) -> Put -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut) (Natural -> Natural -> Natural -> Maybe Text -> Put
putECD Natural
totalCount Natural
cdSize Natural
cdOffset Maybe Text
comment)
getLocalHeaderGap :: Get Integer
= do
Word32 -> Get ()
getSignature 0x04034b50
Int -> Get ()
skip 2
Int -> Get ()
skip 2
Int -> Get ()
skip 2
Int -> Get ()
skip 2
Int -> Get ()
skip 2
Int -> Get ()
skip 4
Int -> Get ()
skip 4
Int -> Get ()
skip 4
Integer
fileNameSize <- Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Integer) -> Get Word16 -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
Integer
extraFieldSize <- Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Integer) -> Get Word16 -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
Integer -> Get Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
fileNameSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
extraFieldSize)
getCD :: Get (Map EntrySelector EntryDescription)
getCD :: Get (Map EntrySelector EntryDescription)
getCD = [(EntrySelector, EntryDescription)]
-> Map EntrySelector EntryDescription
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(EntrySelector, EntryDescription)]
-> Map EntrySelector EntryDescription)
-> ([Maybe (EntrySelector, EntryDescription)]
-> [(EntrySelector, EntryDescription)])
-> [Maybe (EntrySelector, EntryDescription)]
-> Map EntrySelector EntryDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (EntrySelector, EntryDescription)]
-> [(EntrySelector, EntryDescription)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (EntrySelector, EntryDescription)]
-> Map EntrySelector EntryDescription)
-> Get [Maybe (EntrySelector, EntryDescription)]
-> Get (Map EntrySelector EntryDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Maybe (EntrySelector, EntryDescription))
-> Get [Maybe (EntrySelector, EntryDescription)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get (Maybe (EntrySelector, EntryDescription))
getCDHeader
getCDHeader :: Get (Maybe (EntrySelector, EntryDescription))
= do
Word32 -> Get ()
getSignature 0x02014b50
Version
versionMadeBy <- Word16 -> Version
toVersion (Word16 -> Version) -> Get Word16 -> Get Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
Version
versionNeeded <- Word16 -> Version
toVersion (Word16 -> Version) -> Get Word16 -> Get Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Version
versionNeeded Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
> Version
zipVersion) (Get () -> Get ()) -> (FilePath -> Get ()) -> FilePath -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Get ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Get ()) -> FilePath -> Get ()
forall a b. (a -> b) -> a -> b
$
"Version required to extract the archive is "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
versionNeeded
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " (can do "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
zipVersion
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ")"
Word16
bitFlag <- Get Word16
getWord16le
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word16
bitFlag) [0, 6, 13]) (Get () -> Get ()) -> (FilePath -> Get ()) -> FilePath -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Get ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Get ()) -> FilePath -> Get ()
forall a b. (a -> b) -> a -> b
$
"Encrypted archives are not supported"
let needUnicode :: Bool
needUnicode = Word16 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word16
bitFlag 11
Maybe CompressionMethod
mcompression <- Word16 -> Maybe CompressionMethod
toCompressionMethod (Word16 -> Maybe CompressionMethod)
-> Get Word16 -> Get (Maybe CompressionMethod)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
Word16
modTime <- Get Word16
getWord16le
Word16
modDate <- Get Word16
getWord16le
Word32
crc32 <- Get Word32
getWord32le
Natural
compressed <- Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Natural) -> Get Word32 -> Get Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
Natural
uncompressed <- Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Natural) -> Get Word32 -> Get Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
Word16
fileNameSize <- Get Word16
getWord16le
Word16
extraFieldSize <- Get Word16
getWord16le
Word16
commentSize <- Get Word16
getWord16le
Int -> Get ()
skip 4
Word32
externalFileAttrs <- Get Word32
getWord32le
Natural
offset <- Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Natural) -> Get Word32 -> Get Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
Maybe Text
fileName <-
Bool -> ByteString -> Maybe Text
decodeText Bool
needUnicode
(ByteString -> Maybe Text) -> Get ByteString -> Get (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
fileNameSize)
Map Word16 ByteString
extraField <-
[(Word16, ByteString)] -> Map Word16 ByteString
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
([(Word16, ByteString)] -> Map Word16 ByteString)
-> Get [(Word16, ByteString)] -> Get (Map Word16 ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get [(Word16, ByteString)] -> Get [(Word16, ByteString)]
forall a. Int -> Get a -> Get a
isolate (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
extraFieldSize) (Get (Word16, ByteString) -> Get [(Word16, ByteString)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get (Word16, ByteString)
getExtraField)
Maybe Text
comment <- Bool -> ByteString -> Maybe Text
decodeText Bool
needUnicode (ByteString -> Maybe Text) -> Get ByteString -> Get (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
commentSize)
let dfltZip64 :: Zip64ExtraField
dfltZip64 =
Zip64ExtraField :: Natural -> Natural -> Natural -> Zip64ExtraField
Zip64ExtraField
{ z64efUncompressedSize :: Natural
z64efUncompressedSize = Natural
uncompressed,
z64efCompressedSize :: Natural
z64efCompressedSize = Natural
compressed,
z64efOffset :: Natural
z64efOffset = Natural
offset
}
z64ef :: Zip64ExtraField
z64ef = case Word16 -> Map Word16 ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup 1 Map Word16 ByteString
extraField of
Nothing -> Zip64ExtraField
dfltZip64
Just b :: ByteString
b -> Zip64ExtraField -> ByteString -> Zip64ExtraField
parseZip64ExtraField Zip64ExtraField
dfltZip64 ByteString
b
case Maybe CompressionMethod
mcompression of
Nothing -> Maybe (EntrySelector, EntryDescription)
-> Get (Maybe (EntrySelector, EntryDescription))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (EntrySelector, EntryDescription)
forall a. Maybe a
Nothing
Just compression :: CompressionMethod
compression ->
let desc :: EntryDescription
desc =
EntryDescription :: Version
-> Version
-> CompressionMethod
-> UTCTime
-> Word32
-> Natural
-> Natural
-> Natural
-> Maybe Text
-> Map Word16 ByteString
-> Word32
-> EntryDescription
EntryDescription
{ edVersionMadeBy :: Version
edVersionMadeBy = Version
versionMadeBy,
edVersionNeeded :: Version
edVersionNeeded = Version
versionNeeded,
edCompression :: CompressionMethod
edCompression = CompressionMethod
compression,
edModTime :: UTCTime
edModTime = MsDosTime -> UTCTime
fromMsDosTime (Word16 -> Word16 -> MsDosTime
MsDosTime Word16
modDate Word16
modTime),
edCRC32 :: Word32
edCRC32 = Word32
crc32,
edCompressedSize :: Natural
edCompressedSize = Zip64ExtraField -> Natural
z64efCompressedSize Zip64ExtraField
z64ef,
edUncompressedSize :: Natural
edUncompressedSize = Zip64ExtraField -> Natural
z64efUncompressedSize Zip64ExtraField
z64ef,
edOffset :: Natural
edOffset = Zip64ExtraField -> Natural
z64efOffset Zip64ExtraField
z64ef,
edComment :: Maybe Text
edComment = if Word16
commentSize Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then Maybe Text
forall a. Maybe a
Nothing else Maybe Text
comment,
edExtraField :: Map Word16 ByteString
edExtraField = Map Word16 ByteString
extraField,
edExternalFileAttrs :: Word32
edExternalFileAttrs = Word32
externalFileAttrs
}
in Maybe (EntrySelector, EntryDescription)
-> Get (Maybe (EntrySelector, EntryDescription))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (EntrySelector, EntryDescription)
-> Get (Maybe (EntrySelector, EntryDescription)))
-> Maybe (EntrySelector, EntryDescription)
-> Get (Maybe (EntrySelector, EntryDescription))
forall a b. (a -> b) -> a -> b
$ (,EntryDescription
desc) (EntrySelector -> (EntrySelector, EntryDescription))
-> Maybe EntrySelector -> Maybe (EntrySelector, EntryDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Text
fileName Maybe Text -> (Text -> Maybe EntrySelector) -> Maybe EntrySelector
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe EntrySelector
forall (m :: * -> *). MonadThrow m => FilePath -> m EntrySelector
mkEntrySelector (FilePath -> Maybe EntrySelector)
-> (Text -> FilePath) -> Text -> Maybe EntrySelector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack)
getExtraField :: Get (Word16, ByteString)
= do
Word16
header <- Get Word16
getWord16le
Word16
size <- Get Word16
getWord16le
ByteString
body <- Int -> Get ByteString
getBytes (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
size)
(Word16, ByteString) -> Get (Word16, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16
header, ByteString
body)
getSignature :: Word32 -> Get ()
getSignature :: Word32 -> Get ()
getSignature sig :: Word32
sig = do
Word32
x <- Get Word32
getWord32le
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
x Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
sig) (Get () -> Get ()) -> (FilePath -> Get ()) -> FilePath -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Get ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Get ()) -> FilePath -> Get ()
forall a b. (a -> b) -> a -> b
$
"Expected signature " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Word32 -> FilePath
forall a. Show a => a -> FilePath
show Word32
sig FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ", but got: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Word32 -> FilePath
forall a. Show a => a -> FilePath
show Word32
x
parseZip64ExtraField ::
Zip64ExtraField ->
ByteString ->
Zip64ExtraField
dflt :: Zip64ExtraField
dflt@Zip64ExtraField {..} b :: ByteString
b =
(FilePath -> Zip64ExtraField)
-> (Zip64ExtraField -> Zip64ExtraField)
-> Either FilePath Zip64ExtraField
-> Zip64ExtraField
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Zip64ExtraField -> FilePath -> Zip64ExtraField
forall a b. a -> b -> a
const Zip64ExtraField
dflt) Zip64ExtraField -> Zip64ExtraField
forall a. a -> a
id (Either FilePath Zip64ExtraField -> Zip64ExtraField)
-> (Get Zip64ExtraField -> Either FilePath Zip64ExtraField)
-> Get Zip64ExtraField
-> Zip64ExtraField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Get Zip64ExtraField
-> ByteString -> Either FilePath Zip64ExtraField)
-> ByteString
-> Get Zip64ExtraField
-> Either FilePath Zip64ExtraField
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get Zip64ExtraField
-> ByteString -> Either FilePath Zip64ExtraField
forall a. Get a -> ByteString -> Either FilePath a
runGet ByteString
b (Get Zip64ExtraField -> Zip64ExtraField)
-> Get Zip64ExtraField -> Zip64ExtraField
forall a b. (a -> b) -> a -> b
$ do
let ifsat :: Natural -> Get Natural
ifsat v :: Natural
v =
if Natural
v Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural
ffffffff
then Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Natural) -> Get Word64 -> Get Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64le
else Natural -> Get Natural
forall (m :: * -> *) a. Monad m => a -> m a
return Natural
v
Natural
uncompressed <- Natural -> Get Natural
ifsat Natural
z64efUncompressedSize
Natural
compressed <- Natural -> Get Natural
ifsat Natural
z64efCompressedSize
Natural
offset <- Natural -> Get Natural
ifsat Natural
z64efOffset
Zip64ExtraField -> Get Zip64ExtraField
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> Natural -> Natural -> Zip64ExtraField
Zip64ExtraField Natural
uncompressed Natural
compressed Natural
offset)
makeZip64ExtraField ::
HeaderType ->
Zip64ExtraField ->
ByteString
c :: HeaderType
c Zip64ExtraField {..} = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HeaderType
c HeaderType -> HeaderType -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderType
LocalHeader Bool -> Bool -> Bool
|| Natural
z64efUncompressedSize Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural
ffffffff) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
Putter Word64
putWord64le (Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
z64efUncompressedSize)
Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HeaderType
c HeaderType -> HeaderType -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderType
LocalHeader Bool -> Bool -> Bool
|| Natural
z64efCompressedSize Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural
ffffffff) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
Putter Word64
putWord64le (Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
z64efCompressedSize)
Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (HeaderType
c HeaderType -> HeaderType -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderType
CentralDirHeader Bool -> Bool -> Bool
&& Natural
z64efOffset Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural
ffffffff) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
Putter Word64
putWord64le (Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
z64efOffset)
putExtraField :: Map Word16 ByteString -> Put
m :: Map Word16 ByteString
m = [Word16] -> (Word16 -> Put) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Word16 ByteString -> [Word16]
forall k a. Map k a -> [k]
M.keys Map Word16 ByteString
m) ((Word16 -> Put) -> Put) -> (Word16 -> Put) -> Put
forall a b. (a -> b) -> a -> b
$ \headerId :: Word16
headerId -> do
let b :: ByteString
b = Int -> ByteString -> ByteString
B.take 0xffff (Map Word16 ByteString
m Map Word16 ByteString -> Word16 -> ByteString
forall k a. Ord k => Map k a -> k -> a
! Word16
headerId)
Word16 -> Put
putWord16le Word16
headerId
Word16 -> Put
putWord16le (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
b)
Putter ByteString
putByteString ByteString
b
putCD :: Map EntrySelector EntryDescription -> Put
putCD :: Map EntrySelector EntryDescription -> Put
putCD m :: Map EntrySelector EntryDescription
m = [EntrySelector] -> (EntrySelector -> Put) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map EntrySelector EntryDescription -> [EntrySelector]
forall k a. Map k a -> [k]
M.keys Map EntrySelector EntryDescription
m) ((EntrySelector -> Put) -> Put) -> (EntrySelector -> Put) -> Put
forall a b. (a -> b) -> a -> b
$ \s :: EntrySelector
s ->
HeaderType -> EntrySelector -> EntryDescription -> Put
putHeader HeaderType
CentralDirHeader EntrySelector
s (Map EntrySelector EntryDescription
m Map EntrySelector EntryDescription
-> EntrySelector -> EntryDescription
forall k a. Ord k => Map k a -> k -> a
! EntrySelector
s)
putHeader ::
HeaderType ->
EntrySelector ->
EntryDescription ->
Put
c' :: HeaderType
c' s :: EntrySelector
s EntryDescription {..} = do
let c :: Bool
c = HeaderType
c' HeaderType -> HeaderType -> Bool
forall a. Eq a => a -> a -> Bool
== HeaderType
CentralDirHeader
Putter Word32
putWord32le (Word32 -> Word32 -> Bool -> Word32
forall a. a -> a -> Bool -> a
bool 0x04034b50 0x02014b50 Bool
c)
Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
c (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$
Word16 -> Put
putWord16le (Version -> Word16
fromVersion Version
edVersionMadeBy)
Word16 -> Put
putWord16le (Version -> Word16
fromVersion Version
edVersionNeeded)
let entryName :: Text
entryName = EntrySelector -> Text
getEntryName EntrySelector
s
rawName :: ByteString
rawName = Text -> ByteString
T.encodeUtf8 Text
entryName
comment :: ByteString
comment = Int -> ByteString -> ByteString
B.take 0xffff (ByteString -> (Text -> ByteString) -> Maybe Text -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
B.empty Text -> ByteString
T.encodeUtf8 Maybe Text
edComment)
unicode :: Bool
unicode =
Text -> Bool
needsUnicode Text
entryName
Bool -> Bool -> Bool
|| Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Text -> Bool
needsUnicode Maybe Text
edComment
modTime :: MsDosTime
modTime = UTCTime -> MsDosTime
toMsDosTime UTCTime
edModTime
Word16 -> Put
putWord16le (if Bool
unicode then Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
setBit 0 11 else 0)
Word16 -> Put
putWord16le (CompressionMethod -> Word16
fromCompressionMethod CompressionMethod
edCompression)
Word16 -> Put
putWord16le (MsDosTime -> Word16
msDosTime MsDosTime
modTime)
Word16 -> Put
putWord16le (MsDosTime -> Word16
msDosDate MsDosTime
modTime)
Putter Word32
putWord32le Word32
edCRC32
Putter Word32
putWord32le (Natural -> Word32
forall a b. (Integral a, Integral b, Bounded b) => a -> b
withSaturation Natural
edCompressedSize)
Putter Word32
putWord32le (Natural -> Word32
forall a b. (Integral a, Integral b, Bounded b) => a -> b
withSaturation Natural
edUncompressedSize)
Word16 -> Put
putWord16le (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
rawName)
let zip64ef :: ByteString
zip64ef =
HeaderType -> Zip64ExtraField -> ByteString
makeZip64ExtraField
HeaderType
c'
Zip64ExtraField :: Natural -> Natural -> Natural -> Zip64ExtraField
Zip64ExtraField
{ z64efUncompressedSize :: Natural
z64efUncompressedSize = Natural
edUncompressedSize,
z64efCompressedSize :: Natural
z64efCompressedSize = Natural
edCompressedSize,
z64efOffset :: Natural
z64efOffset = Natural
edOffset
}
extraField :: ByteString
extraField =
Int -> ByteString -> ByteString
B.take 0xffff (ByteString -> ByteString)
-> (Map Word16 ByteString -> ByteString)
-> Map Word16 ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString)
-> (Map Word16 ByteString -> Put)
-> Map Word16 ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Word16 ByteString -> Put
putExtraField (Map Word16 ByteString -> ByteString)
-> Map Word16 ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
Word16
-> ByteString -> Map Word16 ByteString -> Map Word16 ByteString
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert 1 ByteString
zip64ef Map Word16 ByteString
edExtraField
Word16 -> Put
putWord16le (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
extraField)
Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
c (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do
Word16 -> Put
putWord16le (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
comment)
Word16 -> Put
putWord16le 0
Word16 -> Put
putWord16le 0
Putter Word32
putWord32le Word32
edExternalFileAttrs
Putter Word32
putWord32le (Natural -> Word32
forall a b. (Integral a, Integral b, Bounded b) => a -> b
withSaturation Natural
edOffset)
Putter ByteString
putByteString ByteString
rawName
Putter ByteString
putByteString ByteString
extraField
Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
c (Putter ByteString
putByteString ByteString
comment)
putZip64ECD ::
Natural ->
Natural ->
Natural ->
Put
putZip64ECD :: Natural -> Natural -> Natural -> Put
putZip64ECD totalCount :: Natural
totalCount cdSize :: Natural
cdSize cdOffset :: Natural
cdOffset = do
Putter Word32
putWord32le 0x06064b50
Putter Word64
putWord64le 44
Word16 -> Put
putWord16le (Version -> Word16
fromVersion Version
zipVersion)
Word16 -> Put
putWord16le (Version -> Word16
fromVersion (Version -> Word16) -> Version -> Word16
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe CompressionMethod -> Version
getZipVersion Bool
True Maybe CompressionMethod
forall a. Maybe a
Nothing)
Putter Word32
putWord32le 0
Putter Word32
putWord32le 0
Putter Word64
putWord64le (Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
totalCount)
Putter Word64
putWord64le (Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
totalCount)
Putter Word64
putWord64le (Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
cdSize)
Putter Word64
putWord64le (Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
cdOffset)
putZip64ECDLocator ::
Natural ->
Put
putZip64ECDLocator :: Natural -> Put
putZip64ECDLocator ecdOffset :: Natural
ecdOffset = do
Putter Word32
putWord32le 0x07064b50
Putter Word32
putWord32le 0
Putter Word64
putWord64le (Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
ecdOffset)
Putter Word32
putWord32le 1
getECD :: Get ArchiveDescription
getECD :: Get ArchiveDescription
getECD = do
Word32
sig <- Get Word32
getWord32le
let zip64 :: Bool
zip64 = Word32
sig Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x06064b50
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
sig Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x06054b50 Bool -> Bool -> Bool
|| Word32
sig Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x06064b50) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
FilePath -> Get ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail "Cannot locate end of central directory"
Maybe Word64
zip64size <-
if Bool
zip64
then do
Word64
x <- Get Word64
getWord64le
Int -> Get ()
skip 2
Int -> Get ()
skip 2
Maybe Word64 -> Get (Maybe Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
x)
else Maybe Word64 -> Get (Maybe Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Word64
forall a. Maybe a
Nothing
Word32
thisDisk <- Get Word32 -> Get Word32 -> Bool -> Get Word32
forall a. a -> a -> Bool -> a
bool (Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word32) -> Get Word16 -> Get Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le) Get Word32
getWord32le Bool
zip64
Word32
cdDisk <- Get Word32 -> Get Word32 -> Bool -> Get Word32
forall a. a -> a -> Bool -> a
bool (Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word32) -> Get Word16 -> Get Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le) Get Word32
getWord32le Bool
zip64
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
thisDisk Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
&& Word32
cdDisk Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
FilePath -> Get ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail "No support for multi-disk archives"
Int -> Get ()
skip (Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool 2 8 Bool
zip64)
Int -> Get ()
skip (Int -> Int -> Bool -> Int
forall a. a -> a -> Bool -> a
bool 2 8 Bool
zip64)
Word64
cdSize <- Get Word64 -> Get Word64 -> Bool -> Get Word64
forall a. a -> a -> Bool -> a
bool (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le) Get Word64
getWord64le Bool
zip64
Word64
cdOffset <- Get Word64 -> Get Word64 -> Bool -> Get Word64
forall a. a -> a -> Bool -> a
bool (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le) Get Word64
getWord64le Bool
zip64
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
zip64 (Get () -> Get ()) -> (Word64 -> Get ()) -> Word64 -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Get ()
skip (Int -> Get ()) -> (Word64 -> Int) -> Word64 -> Get ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Get ()) -> Word64 -> Get ()
forall a b. (a -> b) -> a -> b
$ Maybe Word64 -> Word64
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Word64
zip64size Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- 4
Word16
commentSize <- Get Word16
getWord16le
Maybe Text
comment <- Bool -> ByteString -> Maybe Text
decodeText Bool
True (ByteString -> Maybe Text) -> Get ByteString -> Get (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
commentSize)
ArchiveDescription -> Get ArchiveDescription
forall (m :: * -> *) a. Monad m => a -> m a
return
ArchiveDescription :: Maybe Text -> Natural -> Natural -> ArchiveDescription
ArchiveDescription
{ adComment :: Maybe Text
adComment = if Word16
commentSize Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then Maybe Text
forall a. Maybe a
Nothing else Maybe Text
comment,
adCDOffset :: Natural
adCDOffset = Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
cdOffset,
adCDSize :: Natural
adCDSize = Word64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
cdSize
}
putECD ::
Natural ->
Natural ->
Natural ->
Maybe Text ->
Put
putECD :: Natural -> Natural -> Natural -> Maybe Text -> Put
putECD totalCount :: Natural
totalCount cdSize :: Natural
cdSize cdOffset :: Natural
cdOffset mcomment :: Maybe Text
mcomment = do
Putter Word32
putWord32le 0x06054b50
Word16 -> Put
putWord16le 0
Word16 -> Put
putWord16le 0
Word16 -> Put
putWord16le (Natural -> Word16
forall a b. (Integral a, Integral b, Bounded b) => a -> b
withSaturation Natural
totalCount)
Word16 -> Put
putWord16le (Natural -> Word16
forall a b. (Integral a, Integral b, Bounded b) => a -> b
withSaturation Natural
totalCount)
Putter Word32
putWord32le (Natural -> Word32
forall a b. (Integral a, Integral b, Bounded b) => a -> b
withSaturation Natural
cdSize)
Putter Word32
putWord32le (Natural -> Word32
forall a b. (Integral a, Integral b, Bounded b) => a -> b
withSaturation Natural
cdOffset)
let comment :: ByteString
comment = ByteString -> (Text -> ByteString) -> Maybe Text -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
B.empty Text -> ByteString
T.encodeUtf8 Maybe Text
mcomment
Word16 -> Put
putWord16le (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
comment)
Putter ByteString
putByteString ByteString
comment
locateECD :: FilePath -> Handle -> IO (Maybe Integer)
locateECD :: FilePath -> Handle -> IO (Maybe Integer)
locateECD path :: FilePath
path h :: Handle
h = IO (Maybe Integer)
sizeCheck
where
sizeCheck :: IO (Maybe Integer)
sizeCheck = do
Integer
fsize <- Handle -> IO Integer
hFileSize Handle
h
let limit :: Integer
limit = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max 0 (Integer
fsize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 0xffff Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 22)
if Integer
fsize Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 22
then Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing
else Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
SeekFromEnd (-22) IO () -> IO (Maybe Integer) -> IO (Maybe Integer)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> IO (Maybe Integer)
loop Integer
limit
loop :: Integer -> IO (Maybe Integer)
loop limit :: Integer
limit = do
Word32
sig <- Get Word32 -> Int -> IO Word32
forall b. Get b -> Int -> IO b
getNum Get Word32
getWord32le 4
Integer
pos <- Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
subtract 4 (Integer -> Integer) -> IO Integer -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Integer
hTell Handle
h
let again :: IO (Maybe Integer)
again = Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek (Integer
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 1) IO () -> IO (Maybe Integer) -> IO (Maybe Integer)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> IO (Maybe Integer)
loop Integer
limit
done :: Bool
done = Integer
pos Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
limit
if Word32
sig Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x06054b50
then do
Maybe Integer
result <-
MaybeT IO Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO Integer -> IO (Maybe Integer))
-> MaybeT IO Integer -> IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$
IO (Maybe Integer) -> MaybeT IO Integer
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Integer -> IO (Maybe Integer)
checkComment Integer
pos)
MaybeT IO Integer
-> (Integer -> MaybeT IO Integer) -> MaybeT IO Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe Integer) -> MaybeT IO Integer
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Integer) -> MaybeT IO Integer)
-> (Integer -> IO (Maybe Integer)) -> Integer -> MaybeT IO Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> IO (Maybe Integer)
checkCDSig
MaybeT IO Integer
-> (Integer -> MaybeT IO Integer) -> MaybeT IO Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe Integer) -> MaybeT IO Integer
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Integer) -> MaybeT IO Integer)
-> (Integer -> IO (Maybe Integer)) -> Integer -> MaybeT IO Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> IO (Maybe Integer)
checkZip64
case Maybe Integer
result of
Nothing -> IO (Maybe Integer)
-> IO (Maybe Integer) -> Bool -> IO (Maybe Integer)
forall a. a -> a -> Bool -> a
bool IO (Maybe Integer)
again (Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing) Bool
done
Just ecd :: Integer
ecd -> Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
ecd)
else IO (Maybe Integer)
-> IO (Maybe Integer) -> Bool -> IO (Maybe Integer)
forall a. a -> a -> Bool -> a
bool IO (Maybe Integer)
again (Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing) Bool
done
checkComment :: Integer -> IO (Maybe Integer)
checkComment pos :: Integer
pos = do
Integer
size <- Handle -> IO Integer
hFileSize Handle
h
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek (Integer
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 20)
Integer
l <- Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Integer) -> IO Word16 -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16 -> Int -> IO Word16
forall b. Get b -> Int -> IO b
getNum Get Word16
getWord16le 2
Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Integer -> IO (Maybe Integer))
-> Maybe Integer -> IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$
if Integer
l Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 22 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
pos
then Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
pos
else Maybe Integer
forall a. Maybe a
Nothing
checkCDSig :: Integer -> IO (Maybe Integer)
checkCDSig pos :: Integer
pos = do
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek (Integer
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 16)
Integer
sigPos <- Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer) -> IO Word32 -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32 -> Int -> IO Word32
forall b. Get b -> Int -> IO b
getNum Get Word32
getWord32le 4
if Integer
sigPos Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0xffffffff
then Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
pos)
else do
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
sigPos
Word32
cdSig <- Get Word32 -> Int -> IO Word32
forall b. Get b -> Int -> IO b
getNum Get Word32
getWord32le 4
Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Integer -> IO (Maybe Integer))
-> Maybe Integer -> IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$
if Word32
cdSig Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x02014b50
Bool -> Bool -> Bool
||
Word32
cdSig Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x06064b50
Bool -> Bool -> Bool
||
Word32
cdSig Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x06054b50
then
Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
pos
else Maybe Integer
forall a. Maybe a
Nothing
checkZip64 :: Integer -> IO (Maybe Integer)
checkZip64 pos :: Integer
pos =
if Integer
pos Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 20
then Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
pos)
else do
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek (Integer
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 20)
Word32
zip64locatorSig <- Get Word32 -> Int -> IO Word32
forall b. Get b -> Int -> IO b
getNum Get Word32
getWord32le 4
if Word32
zip64locatorSig Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x07064b50
then do
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek (Integer
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- 12)
Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> (Word64 -> Integer) -> Word64 -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Maybe Integer) -> IO Word64 -> IO (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64 -> Int -> IO Word64
forall b. Get b -> Int -> IO b
getNum Get Word64
getWord64le 8
else Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
pos)
getNum :: Get b -> Int -> IO b
getNum f :: Get b
f n :: Int
n = do
Either FilePath b
result <- Get b -> ByteString -> Either FilePath b
forall a. Get a -> ByteString -> Either FilePath a
runGet Get b
f (ByteString -> Either FilePath b)
-> IO ByteString -> IO (Either FilePath b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Int -> IO ByteString
B.hGet Handle
h Int
n
case Either FilePath b
result of
Left msg :: FilePath
msg -> ZipException -> IO b
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FilePath -> FilePath -> ZipException
ParsingFailed FilePath
path FilePath
msg)
Right val :: b
val -> b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
val
renameKey :: Ord k => k -> k -> Map k a -> Map k a
renameKey :: k -> k -> Map k a -> Map k a
renameKey ok :: k
ok nk :: k
nk m :: Map k a
m = case k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
ok Map k a
m of
Nothing -> Map k a
m
Just e :: a
e -> k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
nk a
e (k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
M.delete k
ok Map k a
m)
withSaturation :: forall a b. (Integral a, Integral b, Bounded b) => a -> b
withSaturation :: a -> b
withSaturation x :: a
x =
if (a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x :: Integer) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> (b -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
bound :: Integer)
then b
bound
else a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x
where
bound :: b
bound = b
forall a. Bounded a => a
maxBound :: b
targetEntry :: PendingAction -> Maybe EntrySelector
targetEntry :: PendingAction -> Maybe EntrySelector
targetEntry (SinkEntry _ _ s :: EntrySelector
s) = EntrySelector -> Maybe EntrySelector
forall a. a -> Maybe a
Just EntrySelector
s
targetEntry (CopyEntry _ _ s :: EntrySelector
s) = EntrySelector -> Maybe EntrySelector
forall a. a -> Maybe a
Just EntrySelector
s
targetEntry (RenameEntry s :: EntrySelector
s _) = EntrySelector -> Maybe EntrySelector
forall a. a -> Maybe a
Just EntrySelector
s
targetEntry (DeleteEntry s :: EntrySelector
s) = EntrySelector -> Maybe EntrySelector
forall a. a -> Maybe a
Just EntrySelector
s
targetEntry (Recompress _ s :: EntrySelector
s) = EntrySelector -> Maybe EntrySelector
forall a. a -> Maybe a
Just EntrySelector
s
targetEntry (SetEntryComment _ s :: EntrySelector
s) = EntrySelector -> Maybe EntrySelector
forall a. a -> Maybe a
Just EntrySelector
s
targetEntry (DeleteEntryComment s :: EntrySelector
s) = EntrySelector -> Maybe EntrySelector
forall a. a -> Maybe a
Just EntrySelector
s
targetEntry (SetModTime _ s :: EntrySelector
s) = EntrySelector -> Maybe EntrySelector
forall a. a -> Maybe a
Just EntrySelector
s
targetEntry (AddExtraField _ _ s :: EntrySelector
s) = EntrySelector -> Maybe EntrySelector
forall a. a -> Maybe a
Just EntrySelector
s
targetEntry (DeleteExtraField _ s :: EntrySelector
s) = EntrySelector -> Maybe EntrySelector
forall a. a -> Maybe a
Just EntrySelector
s
targetEntry (SetExternalFileAttributes _ s :: EntrySelector
s) = EntrySelector -> Maybe EntrySelector
forall a. a -> Maybe a
Just EntrySelector
s
targetEntry (SetArchiveComment _) = Maybe EntrySelector
forall a. Maybe a
Nothing
targetEntry DeleteArchiveComment = Maybe EntrySelector
forall a. Maybe a
Nothing
decodeText ::
Bool ->
ByteString ->
Maybe Text
decodeText :: Bool -> ByteString -> Maybe Text
decodeText False = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> (ByteString -> Text) -> ByteString -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeCP437
decodeText True = (UnicodeException -> Maybe Text)
-> (Text -> Maybe Text)
-> Either UnicodeException Text
-> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Text -> UnicodeException -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing) Text -> Maybe Text
forall a. a -> Maybe a
Just (Either UnicodeException Text -> Maybe Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
T.decodeUtf8'
needsUnicode :: Text -> Bool
needsUnicode :: Text -> Bool
needsUnicode = Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
validCP437
where
validCP437 :: Char -> Bool
validCP437 x :: Char
x = Char -> Int
ord Char
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 127
toVersion :: Word16 -> Version
toVersion :: Word16 -> Version
toVersion x :: Word16
x = [Int] -> Version
makeVersion [Int
major, Int
minor]
where
(major :: Int
major, minor :: Int
minor) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Word16
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. 0x00ff) 10
fromVersion :: Version -> Word16
fromVersion :: Version -> Word16
fromVersion v :: Version
v = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((ZIP_OS `shiftL` 8) .|. (major Int -> Int -> Int
forall a. Num a => a -> a -> a
* 10 + minor))
where
(major :: Int
major, minor :: Int
minor) =
case Version -> [Int]
versionBranch Version
v of
v0 :: Int
v0 : v1 :: Int
v1 : _ -> (Int
v0, Int
v1)
v0 :: Int
v0 : _ -> (Int
v0, 0)
[] -> (0, 0)
toCompressionMethod :: Word16 -> Maybe CompressionMethod
toCompressionMethod :: Word16 -> Maybe CompressionMethod
toCompressionMethod 0 = CompressionMethod -> Maybe CompressionMethod
forall a. a -> Maybe a
Just CompressionMethod
Store
toCompressionMethod 8 = CompressionMethod -> Maybe CompressionMethod
forall a. a -> Maybe a
Just CompressionMethod
Deflate
toCompressionMethod 12 = CompressionMethod -> Maybe CompressionMethod
forall a. a -> Maybe a
Just CompressionMethod
BZip2
toCompressionMethod 93 = CompressionMethod -> Maybe CompressionMethod
forall a. a -> Maybe a
Just CompressionMethod
Zstd
toCompressionMethod _ = Maybe CompressionMethod
forall a. Maybe a
Nothing
fromCompressionMethod :: CompressionMethod -> Word16
fromCompressionMethod :: CompressionMethod -> Word16
fromCompressionMethod Store = 0
fromCompressionMethod Deflate = 8
fromCompressionMethod BZip2 = 12
fromCompressionMethod Zstd = 93
needsZip64 :: EntryDescription -> Bool
needsZip64 :: EntryDescription -> Bool
needsZip64 EntryDescription {..} =
(Natural -> Bool) -> [Natural] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
(Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Natural
ffffffff)
[Natural
edOffset, Natural
edCompressedSize, Natural
edUncompressedSize]
getZipVersion :: Bool -> Maybe CompressionMethod -> Version
getZipVersion :: Bool -> Maybe CompressionMethod -> Version
getZipVersion zip64 :: Bool
zip64 m :: Maybe CompressionMethod
m = Version -> Version -> Version
forall a. Ord a => a -> a -> a
max Version
zip64ver Version
mver
where
zip64ver :: Version
zip64ver = [Int] -> Version
makeVersion (if Bool
zip64 then [4, 5] else [2, 0])
mver :: Version
mver = [Int] -> Version
makeVersion ([Int] -> Version) -> [Int] -> Version
forall a b. (a -> b) -> a -> b
$ case Maybe CompressionMethod
m of
Nothing -> [2, 0]
Just Store -> [2, 0]
Just Deflate -> [2, 0]
Just BZip2 -> [4, 6]
Just Zstd -> [6, 3]
decompressingPipe ::
(PrimMonad m, MonadThrow m, MonadResource m) =>
CompressionMethod ->
ConduitT ByteString ByteString m ()
decompressingPipe :: CompressionMethod -> ConduitT ByteString ByteString m ()
decompressingPipe Store = (ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
C.awaitForever ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
C.yield
decompressingPipe Deflate = WindowBits -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
(PrimMonad m, MonadThrow m) =>
WindowBits -> ConduitT ByteString ByteString m ()
Z.decompress (WindowBits -> ConduitT ByteString ByteString m ())
-> WindowBits -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ Int -> WindowBits
Z.WindowBits (-15)
#ifdef ENABLE_BZIP2
decompressingPipe BZip2 = ConduitT ByteString ByteString m ()
forall (m :: * -> *).
MonadResource m =>
ConduitT ByteString ByteString m ()
BZ.bunzip2
#else
decompressingPipe BZip2 = throwM BZip2Unsupported
#endif
#ifdef ENABLE_ZSTD
decompressingPipe Zstd = ConduitT ByteString ByteString m ()
forall (m :: * -> *).
MonadIO m =>
ConduitT ByteString ByteString m ()
Zstandard.decompress
#else
decompressingPipe Zstd = throwM ZstdUnsupported
#endif
crc32Sink :: ConduitT ByteString Void (ResourceT IO) Word32
crc32Sink :: Sink ByteString (ResourceT IO) Word32
crc32Sink = (Word32 -> ByteString -> Word32)
-> Word32 -> Sink ByteString (ResourceT IO) Word32
forall (m :: * -> *) b a o.
Monad m =>
(b -> a -> b) -> b -> ConduitT a o m b
CL.fold Word32 -> ByteString -> Word32
forall a. CRC32 a => Word32 -> a -> Word32
crc32Update 0
toMsDosTime :: UTCTime -> MsDosTime
toMsDosTime :: UTCTime -> MsDosTime
toMsDosTime UTCTime {..} = Word16 -> Word16 -> MsDosTime
MsDosTime Word16
dosDate Word16
dosTime
where
dosTime :: Word16
dosTime = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
seconds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
minutes 5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
hours 11)
dosDate :: Word16
dosDate = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (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 5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
year 9)
seconds :: Int
seconds =
let (MkFixed x :: Integer
x) = TimeOfDay -> Fixed E12
todSec TimeOfDay
tod
in Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` 2000000000000)
minutes :: Int
minutes = TimeOfDay -> Int
todMin TimeOfDay
tod
hours :: Int
hours = TimeOfDay -> Int
todHour TimeOfDay
tod
tod :: TimeOfDay
tod = DiffTime -> TimeOfDay
timeToTimeOfDay DiffTime
utctDayTime
year :: Int
year = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
year' Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1980
(year' :: Integer
year', month :: Int
month, day :: Int
day) = Day -> (Integer, Int, Int)
toGregorian Day
utctDay
fromMsDosTime :: MsDosTime -> UTCTime
fromMsDosTime :: MsDosTime -> UTCTime
fromMsDosTime MsDosTime {..} =
Day -> DiffTime -> UTCTime
UTCTime
(Integer -> Int -> Int -> Day
fromGregorian Integer
year Int
month Int
day)
(Integer -> DiffTime
secondsToDiffTime (Integer -> DiffTime) -> Integer -> DiffTime
forall a b. (a -> b) -> a -> b
$ Integer
hours Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 3600 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
minutes Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
seconds)
where
seconds :: Integer
seconds = Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Integer) -> Word16 -> Integer
forall a b. (a -> b) -> a -> b
$ 2 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* (Word16
msDosTime Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. 0x1f)
minutes :: Integer
minutes = Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
msDosTime 5 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. 0x3f)
hours :: Integer
hours = Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
msDosTime 11 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. 0x1f)
day :: Int
day = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
msDosDate Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. 0x1f)
month :: Int
month = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
msDosDate 5 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. 0x0f
year :: Integer
year = 1980 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftR Word16
msDosDate 9)
ffff, ffffffff :: Natural
#ifdef HASKELL_ZIP_DEV_MODE
ffff = 200
ffffffff = 5000
#else
ffff :: Natural
ffff = 0xffff
ffffffff :: Natural
ffffffff = 0xffffffff
#endif
defaultFileMode :: Word32
#ifdef mingw32_HOST_OS
defaultFileMode = 0
#else
defaultFileMode :: Word32
defaultFileMode = CMode -> Word32
Unix.fromFileMode 0o600
#endif