zip 2.0.1 → 2.1.0
raw patch · 7 files changed
+289/−277 lines, 7 filesdep ~containersdep ~filepathdep ~time
Dependency ranges changed: containers, filepath, time
Files
- CHANGELOG.md +8/−0
- Codec/Archive/Zip.hs +1/−1
- Codec/Archive/Zip/Internal.hs +4/−12
- Codec/Archive/Zip/Internal/Type.hs +231/−0
- Codec/Archive/Zip/Type.hs +0/−231
- tests/Main.hs +42/−29
- zip.cabal +3/−4
CHANGELOG.md view
@@ -1,3 +1,11 @@+## Zip 2.1.0++* Exposed `Codec.Archive.Zip.Internal` and `Codec.Archive.Zip.Internal.Type`+ modules. [PR 115](https://github.com/mrkkrp/zip/pull/115).++* Derived `Show` for `EntryDescription`. [PR+ 115](https://github.com/mrkkrp/zip/pull/115).+ ## Zip 2.0.1 * Fixed corruption of large entries when zip64 is used. [Issue
Codec/Archive/Zip.hs view
@@ -147,7 +147,7 @@ where import Codec.Archive.Zip.Internal qualified as I-import Codec.Archive.Zip.Type+import Codec.Archive.Zip.Internal.Type import Conduit (PrimMonad) import Control.Monad import Control.Monad.Base (MonadBase (..))
Codec/Archive/Zip/Internal.hs view
@@ -13,18 +13,10 @@ -- Portability : portable -- -- Low-level, non-public types and operations.-module Codec.Archive.Zip.Internal- ( PendingAction (..),- targetEntry,- scanArchive,- sourceEntry,- crc32Sink,- commit,- )-where+module Codec.Archive.Zip.Internal where import Codec.Archive.Zip.CP437 (decodeCP437)-import Codec.Archive.Zip.Type+import Codec.Archive.Zip.Internal.Type import Conduit (PrimMonad) import Control.Applicative (many, (<|>)) import Control.Exception (bracketOnError, catchJust)@@ -1210,8 +1202,8 @@ ffff, ffffffff :: Natural #ifdef HASKELL_ZIP_DEV_MODE-ffff = 200-ffffffff = 5000+ffff = 25+ffffffff = 250 #else ffff = 0xffff ffffffff = 0xffffffff
+ Codec/Archive/Zip/Internal/Type.hs view
@@ -0,0 +1,231 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}++-- |+-- Module : Codec.Archive.Zip.Internal.Type+-- Copyright : © 2016–present Mark Karpov+-- License : BSD 3 clause+--+-- Maintainer : Mark Karpov <markkarpov92@gmail.com>+-- Stability : experimental+-- Portability : portable+--+-- Types used by the package.+module Codec.Archive.Zip.Internal.Type+ ( -- * Entry selector+ EntrySelector,+ mkEntrySelector,+ unEntrySelector,+ getEntryName,+ EntrySelectorException (..),++ -- * Entry description+ EntryDescription (..),+ CompressionMethod (..),++ -- * Archive description+ ArchiveDescription (..),++ -- * Exceptions+ ZipException (..),+ )+where++import Control.Exception (Exception)+import Control.Monad.Catch (MonadThrow (..))+import Data.ByteString (ByteString)+import Data.ByteString qualified as B+import Data.CaseInsensitive (CI)+import Data.CaseInsensitive qualified as CI+import Data.Data (Data)+import Data.List.NonEmpty (NonEmpty)+import Data.List.NonEmpty qualified as NE+import Data.Map (Map)+import Data.Maybe (mapMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Data.Time.Clock (UTCTime)+import Data.Typeable (Typeable)+import Data.Version (Version)+import Data.Word (Word16, Word32)+import Numeric.Natural+import System.FilePath qualified as FP+import System.FilePath.Posix qualified as Posix+import System.FilePath.Windows qualified as Windows++----------------------------------------------------------------------------+-- Entry selector++-- | This data type serves for naming and selection of archive entries. It+-- can be created only with the help of the smart constructor+-- 'mkEntrySelector', and it's the only “key” that can be used to refer to+-- files in the archive or to name new archive entries.+--+-- The abstraction is crucial for ensuring that created archives are+-- portable across operating systems, file systems, and platforms. Since on+-- some operating systems, file paths are case-insensitive, this selector is+-- also case-insensitive. It makes sure that only relative paths are used to+-- name files inside archive, as it's recommended in the specification. It+-- also guarantees that forward slashes are used when the path is stored+-- inside the archive for compatibility with Unix-like operating systems (as+-- recommended in the specification). On the other hand, in can be rendered+-- as an ordinary relative file path in OS-specific format when needed.+newtype EntrySelector = EntrySelector+ { -- | Path pieces of relative path inside archive+ unES :: NonEmpty (CI String)+ }+ deriving (Eq, Ord, Typeable)++instance Show EntrySelector where+ show = show . unEntrySelector++-- | Create an 'EntrySelector' from a 'FilePath'. To avoid problems with+-- distribution of the archive, characters that some operating systems do+-- not expect in paths are not allowed.+--+-- Argument to 'mkEntrySelector' should pass these checks:+--+-- * 'System.FilePath.Posix.isValid'+-- * 'System.FilePath.Windows.isValid'+-- * it is a relative path without slash at the end+-- * binary representations of normalized path should be not longer than+-- 65535 bytes+--+-- This function can throw an 'EntrySelectorException'.+mkEntrySelector :: (MonadThrow m) => FilePath -> m EntrySelector+mkEntrySelector path =+ let f x =+ case filter (not . FP.isPathSeparator) x of+ [] -> Nothing+ xs -> Just (CI.mk xs)+ giveup = throwM (InvalidEntrySelector path)+ in case NE.nonEmpty (mapMaybe f (FP.splitPath path)) of+ Nothing -> giveup+ Just pieces ->+ let selector = EntrySelector pieces+ binLength = B.length . T.encodeUtf8 . getEntryName+ in if Posix.isValid path+ && Windows.isValid path+ && not (FP.isAbsolute path || FP.hasTrailingPathSeparator path)+ && (CI.mk "." `notElem` pieces)+ && (CI.mk ".." `notElem` pieces)+ && binLength selector <= 0xffff+ then return selector+ else giveup++-- | Restore a relative path from 'EntrySelector'. Every 'EntrySelector'+-- corresponds to a 'FilePath'.+unEntrySelector :: EntrySelector -> FilePath+unEntrySelector =+ FP.joinPath . fmap CI.original . NE.toList . unES++-- | Get an entry name in the from that is suitable for writing to file+-- header, given an 'EntrySelector'.+getEntryName :: EntrySelector -> Text+getEntryName =+ T.pack . concat . NE.toList . NE.intersperse "/" . fmap CI.original . unES++-- | The problems you can have with an 'EntrySelector'.+newtype EntrySelectorException+ = -- | 'EntrySelector' cannot be created from this path+ InvalidEntrySelector FilePath+ deriving (Eq, Ord, Typeable)++instance Show EntrySelectorException where+ show (InvalidEntrySelector path) = "Cannot build selector from " ++ show path++instance Exception EntrySelectorException++----------------------------------------------------------------------------+-- Entry description++-- | The information about archive entry that can be stored in a zip+-- archive. It does not mirror local file header or central directory file+-- header, but their binary representations can be built given this data+-- structure and the archive contents.+data EntryDescription = EntryDescription+ { -- | Version made by+ edVersionMadeBy :: Version,+ -- | Version needed to extract+ edVersionNeeded :: Version,+ -- | Compression method+ edCompression :: CompressionMethod,+ -- | Last modification date and time+ edModTime :: UTCTime,+ -- | CRC32 check sum+ edCRC32 :: Word32,+ -- | Size of compressed entry+ edCompressedSize :: Natural,+ -- | Size of uncompressed entry+ edUncompressedSize :: Natural,+ -- | Absolute offset of local file header+ edOffset :: Natural,+ -- | Entry comment+ edComment :: Maybe Text,+ -- | All extra fields found+ edExtraField :: Map Word16 ByteString,+ -- | External file attributes+ --+ -- @since 1.2.0+ edExternalFileAttrs :: Word32+ }+ deriving (Eq, Typeable, Show)++-- | The supported compression methods.+data CompressionMethod+ = -- | Store file uncompressed+ Store+ | -- | Deflate+ Deflate+ | -- | Compressed using BZip2 algorithm+ BZip2+ | -- | Compressed using Zstandard algorithm+ --+ -- @since 1.6.0+ Zstd+ deriving (Show, Read, Eq, Ord, Enum, Bounded, Data, Typeable)++----------------------------------------------------------------------------+-- Archive description++-- | The information about the archive as a whole.+data ArchiveDescription = ArchiveDescription+ { -- | The comment of the entire archive+ adComment :: Maybe Text,+ -- | Absolute offset of the start of central directory+ adCDOffset :: Natural,+ -- | The size of central directory record+ adCDSize :: Natural+ }+ deriving (Show, Read, Eq, Ord, Typeable, Data)++----------------------------------------------------------------------------+-- Exceptions++-- | The bad things that can happen when you use the library.+data ZipException+ = -- | Thrown when you try to get contents of non-existing entry+ EntryDoesNotExist FilePath EntrySelector+ | -- | Thrown when attempting to decompress an entry compressed with an+ -- unsupported compression method or the library is compiled without+ -- support for it.+ --+ -- @since 2.0.0+ UnsupportedCompressionMethod CompressionMethod+ | -- | Thrown when archive structure cannot be parsed.+ ParsingFailed FilePath String+ deriving (Eq, Ord, Typeable)++instance Show ZipException where+ show (EntryDoesNotExist file s) =+ "No such entry found: " ++ show s ++ " in " ++ show file+ show (ParsingFailed file msg) =+ "Parsing of archive structure failed: \n" ++ msg ++ "\nin " ++ show file+ show (UnsupportedCompressionMethod method) =+ "Encountered a zipfile entry with "+ ++ show method+ ++ " compression, but "+ ++ "zip library does not support it or has been built without support for it."++instance Exception ZipException
− Codec/Archive/Zip/Type.hs
@@ -1,231 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}---- |--- Module : Codec.Archive.Zip.Type--- Copyright : © 2016–present Mark Karpov--- License : BSD 3 clause------ Maintainer : Mark Karpov <markkarpov92@gmail.com>--- Stability : experimental--- Portability : portable------ Types used by the package.-module Codec.Archive.Zip.Type- ( -- * Entry selector- EntrySelector,- mkEntrySelector,- unEntrySelector,- getEntryName,- EntrySelectorException (..),-- -- * Entry description- EntryDescription (..),- CompressionMethod (..),-- -- * Archive description- ArchiveDescription (..),-- -- * Exceptions- ZipException (..),- )-where--import Control.Exception (Exception)-import Control.Monad.Catch (MonadThrow (..))-import Data.ByteString (ByteString)-import Data.ByteString qualified as B-import Data.CaseInsensitive (CI)-import Data.CaseInsensitive qualified as CI-import Data.Data (Data)-import Data.List.NonEmpty (NonEmpty)-import Data.List.NonEmpty qualified as NE-import Data.Map (Map)-import Data.Maybe (mapMaybe)-import Data.Text (Text)-import Data.Text qualified as T-import Data.Text.Encoding qualified as T-import Data.Time.Clock (UTCTime)-import Data.Typeable (Typeable)-import Data.Version (Version)-import Data.Word (Word16, Word32)-import Numeric.Natural-import System.FilePath qualified as FP-import System.FilePath.Posix qualified as Posix-import System.FilePath.Windows qualified as Windows--------------------------------------------------------------------------------- Entry selector---- | This data type serves for naming and selection of archive entries. It--- can be created only with the help of the smart constructor--- 'mkEntrySelector', and it's the only “key” that can be used to refer to--- files in the archive or to name new archive entries.------ The abstraction is crucial for ensuring that created archives are--- portable across operating systems, file systems, and platforms. Since on--- some operating systems, file paths are case-insensitive, this selector is--- also case-insensitive. It makes sure that only relative paths are used to--- name files inside archive, as it's recommended in the specification. It--- also guarantees that forward slashes are used when the path is stored--- inside the archive for compatibility with Unix-like operating systems (as--- recommended in the specification). On the other hand, in can be rendered--- as an ordinary relative file path in OS-specific format when needed.-newtype EntrySelector = EntrySelector- { -- | Path pieces of relative path inside archive- unES :: NonEmpty (CI String)- }- deriving (Eq, Ord, Typeable)--instance Show EntrySelector where- show = show . unEntrySelector---- | Create an 'EntrySelector' from a 'FilePath'. To avoid problems with--- distribution of the archive, characters that some operating systems do--- not expect in paths are not allowed.------ Argument to 'mkEntrySelector' should pass these checks:------ * 'System.FilePath.Posix.isValid'--- * 'System.FilePath.Windows.isValid'--- * it is a relative path without slash at the end--- * binary representations of normalized path should be not longer than--- 65535 bytes------ This function can throw an 'EntrySelectorException'.-mkEntrySelector :: (MonadThrow m) => FilePath -> m EntrySelector-mkEntrySelector path =- let f x =- case filter (not . FP.isPathSeparator) x of- [] -> Nothing- xs -> Just (CI.mk xs)- giveup = throwM (InvalidEntrySelector path)- in case NE.nonEmpty (mapMaybe f (FP.splitPath path)) of- Nothing -> giveup- Just pieces ->- let selector = EntrySelector pieces- binLength = B.length . T.encodeUtf8 . getEntryName- in if Posix.isValid path- && Windows.isValid path- && not (FP.isAbsolute path || FP.hasTrailingPathSeparator path)- && (CI.mk "." `notElem` pieces)- && (CI.mk ".." `notElem` pieces)- && binLength selector <= 0xffff- then return selector- else giveup---- | Restore a relative path from 'EntrySelector'. Every 'EntrySelector'--- corresponds to a 'FilePath'.-unEntrySelector :: EntrySelector -> FilePath-unEntrySelector =- FP.joinPath . fmap CI.original . NE.toList . unES---- | Get an entry name in the from that is suitable for writing to file--- header, given an 'EntrySelector'.-getEntryName :: EntrySelector -> Text-getEntryName =- T.pack . concat . NE.toList . NE.intersperse "/" . fmap CI.original . unES---- | The problems you can have with an 'EntrySelector'.-newtype EntrySelectorException- = -- | 'EntrySelector' cannot be created from this path- InvalidEntrySelector FilePath- deriving (Eq, Ord, Typeable)--instance Show EntrySelectorException where- show (InvalidEntrySelector path) = "Cannot build selector from " ++ show path--instance Exception EntrySelectorException--------------------------------------------------------------------------------- Entry description---- | The information about archive entry that can be stored in a zip--- archive. It does not mirror local file header or central directory file--- header, but their binary representations can be built given this data--- structure and the archive contents.-data EntryDescription = EntryDescription- { -- | Version made by- edVersionMadeBy :: Version,- -- | Version needed to extract- edVersionNeeded :: Version,- -- | Compression method- edCompression :: CompressionMethod,- -- | Last modification date and time- edModTime :: UTCTime,- -- | CRC32 check sum- edCRC32 :: Word32,- -- | Size of compressed entry- edCompressedSize :: Natural,- -- | Size of uncompressed entry- edUncompressedSize :: Natural,- -- | Absolute offset of local file header- edOffset :: Natural,- -- | Entry comment- edComment :: Maybe Text,- -- | All extra fields found- edExtraField :: Map Word16 ByteString,- -- | External file attributes- --- -- @since 1.2.0- edExternalFileAttrs :: Word32- }- deriving (Eq, Typeable)---- | The supported compression methods.-data CompressionMethod- = -- | Store file uncompressed- Store- | -- | Deflate- Deflate- | -- | Compressed using BZip2 algorithm- BZip2- | -- | Compressed using Zstandard algorithm- --- -- @since 1.6.0- Zstd- deriving (Show, Read, Eq, Ord, Enum, Bounded, Data, Typeable)--------------------------------------------------------------------------------- Archive description---- | The information about the archive as a whole.-data ArchiveDescription = ArchiveDescription- { -- | The comment of the entire archive- adComment :: Maybe Text,- -- | Absolute offset of the start of central directory- adCDOffset :: Natural,- -- | The size of central directory record- adCDSize :: Natural- }- deriving (Show, Read, Eq, Ord, Typeable, Data)--------------------------------------------------------------------------------- Exceptions---- | The bad things that can happen when you use the library.-data ZipException- = -- | Thrown when you try to get contents of non-existing entry- EntryDoesNotExist FilePath EntrySelector- | -- | Thrown when attempting to decompress an entry compressed with an- -- unsupported compression method or the library is compiled without- -- support for it.- --- -- @since 2.0.0- UnsupportedCompressionMethod CompressionMethod- | -- | Thrown when archive structure cannot be parsed.- ParsingFailed FilePath String- deriving (Eq, Ord, Typeable)--instance Show ZipException where- show (EntryDoesNotExist file s) =- "No such entry found: " ++ show s ++ " in " ++ show file- show (ParsingFailed file msg) =- "Parsing of archive structure failed: \n" ++ msg ++ "\nin " ++ show file- show (UnsupportedCompressionMethod method) =- "Encountered a zipfile entry with "- ++ show method- ++ " compression, but "- ++ "zip library does not support it or has been built without support for it."--instance Exception ZipException
tests/Main.hs view
@@ -30,6 +30,7 @@ import Data.Time import Data.Version import Data.Word+import Numeric.Natural import System.Directory import System.FilePath ((</>)) import System.FilePath qualified as FP@@ -39,6 +40,14 @@ import Test.Hspec import Test.QuickCheck hiding ((.&.)) +ffffffff :: Natural++#ifdef HASKELL_ZIP_DEV_MODE+ffffffff = 250+#else+ffffffff = 0xffffffff+#endif+ -- | Zip tests. Please note that the Zip64 feature is not currently tested -- automatically because we'd need > 4GB of data. Handling such quantities -- of data locally is problematic and even more problematic on CI.@@ -82,7 +91,7 @@ arbitrary = T.pack <$> listOf1 arbitrary instance Arbitrary ByteString where- arbitrary = B.pack <$> listOf arbitrary+ arbitrary = B.pack <$> scale (* 10) (listOf arbitrary) {- ORMOLU_DISABLE -} @@ -195,22 +204,6 @@ (1, return mempty) ] -instance Show EntryDescription where- show ed =- "{ edCompression = "- ++ show (edCompression ed)- ++ "\n, edModTime = "- ++ show (edModTime ed)- ++ "\n, edUncompressedSize = "- ++ show (edUncompressedSize ed)- ++ "\n, edComment = "- ++ show (edComment ed)- ++ "\n, edExtraField = "- ++ show (edExtraField ed)- ++ "\n, edExtFileAttr = "- ++ show (edExternalFileAttrs ed)- ++ " }"- instance Show (ZipArchive a) where show = const "<zip archive>" @@ -385,14 +378,19 @@ -- it should be mentioned that the version also depends on Zip64 feature property $ \(EM s desc z) -> do desc' <- fromJust <$> createArchive path (z >> commit >> getEntryDesc s)- edVersionNeeded desc'- `shouldBe` makeVersion- ( case edCompression desc of- Store -> [2, 0]- Deflate -> [2, 0]- BZip2 -> [4, 6]- Zstd -> [6, 3]- )+ let minVersionZip64 =+ makeVersion $+ if edUncompressedSize desc' >= ffffffff+ || edCompressedSize desc' >= ffffffff+ then [4, 5]+ else [2, 0]+ minVersionCompression = makeVersion $ case edCompression desc of+ Store -> [2, 0]+ Deflate -> [2, 0]+ BZip2 -> [4, 6]+ Zstd -> [6, 3]+ versionNeeded = max minVersionZip64 minVersionCompression+ edVersionNeeded desc' `shouldBe` versionNeeded addEntrySpec :: SpecWith FilePath addEntrySpec =@@ -402,6 +400,7 @@ info <- createArchive path $ do addEntry m b s commit+ checkEntry' s (,) <$> getEntry s <*> (edCompression . (! s) <$> getEntries) info `shouldBe` (b, m) @@ -413,6 +412,7 @@ info <- createArchive path $ do sinkEntry m (C.yield b) s commit+ checkEntry' s (,) <$> sourceEntry s (CL.foldMap id) <*> (edCompression . (! s) <$> getEntries)@@ -429,6 +429,7 @@ createArchive path $ do loadEntry m s vpath commit+ checkEntry' s liftIO (removeFile vpath) saveEntry s vpath B.readFile vpath `shouldReturn` b@@ -445,6 +446,7 @@ info <- createArchive path $ do copyEntry vpath s s commit+ checkEntry' s (,) <$> getEntry s <*> (edCompression . (! s) <$> getEntries) info `shouldBe` (b, m) @@ -452,12 +454,11 @@ checkEntrySpec = do context "when entry is intact" $ it "passes the check" $ \path ->- property $ \m b s -> do- check <- createArchive path $ do+ property $ \m b s ->+ asIO . createArchive path $ do addEntry m b s commit- checkEntry s- check `shouldBe` True+ checkEntry' s context "when entry is corrupted" $ it "does not pass the check" $ \path -> property $ \b s ->@@ -485,8 +486,10 @@ info <- createArchive path $ do addEntry m b s commit+ checkEntry' s recompress m' s commit+ checkEntry' s (,) <$> getEntry s <*> (edCompression . (! s) <$> getEntries) info `shouldBe` (b, m') @@ -796,6 +799,12 @@ withSandbox action = withSystemTempDirectory "zip-sandbox" $ \dir -> action (dir </> "foo.zip") +-- | Like 'checkEntry' but automatically aborts the test if the check fails.+checkEntry' :: EntrySelector -> ZipArchive ()+checkEntry' s = do+ r <- checkEntry s+ liftIO (if r then return () else fail "Entry integrity check failed!")+ -- | Given a primary name (name of archive), generate a name that does not -- collide with it. deriveVacant :: FilePath -> FilePath@@ -875,3 +884,7 @@ if isDir then go adir' else return mempty++-- | Constrain the type of the argument monad to 'IO'.+asIO :: IO a -> IO a+asIO = id
zip.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: zip-version: 2.0.1+version: 2.1.0 license: BSD-3-Clause license-file: LICENSE.md maintainer: Mark Karpov <markkarpov92@gmail.com>@@ -44,10 +44,8 @@ Codec.Archive.Zip Codec.Archive.Zip.CP437 Codec.Archive.Zip.Unix-- other-modules: Codec.Archive.Zip.Internal- Codec.Archive.Zip.Type+ Codec.Archive.Zip.Internal.Type default-language: GHC2021 build-depends:@@ -137,6 +135,7 @@ zip if flag(dev)+ cpp-options: -DHASKELL_ZIP_DEV_MODE ghc-options: -Wall -Werror -Wredundant-constraints -Wpartial-fields -Wunused-packages