LibZip 0.10.2 → 0.11
raw patch · 7 files changed
+376/−86 lines, 7 filesdep +HUnitdep +LibZipdep +directorydep ~bindings-libzipsetup-changed
Dependencies added: HUnit, LibZip, directory, utf8-string
Dependency ranges changed: bindings-libzip
Files
- Codec/Archive/LibZip.hs +170/−40
- Codec/Archive/LibZip/Types.hs +37/−5
- LICENSE +1/−1
- LibZip.cabal +20/−4
- Setup.lhs +4/−17
- Tests/Common.hs +2/−1
- Tests/MonadicTests.hs +142/−18
Codec/Archive/LibZip.hs view
@@ -62,14 +62,16 @@ , Entry , ZipStat(..) -- * Archive operations- , withArchive, getZip+ , withArchive, withEncryptedArchive, getZip , numFiles, fileName, nameLocate, fileNames , fileSize, fileSizeIx , fileStat, fileStatIx , deleteFile, deleteFileIx , renameFile, renameFileIx- , addFile, addDirectory+ , addFile, addFileWithFlags+ , addDirectory, addDirectoryWithFlags , replaceFile, replaceFileIx+ , setFileCompression, setFileCompressionIx , sourceBuffer, sourceFile, sourceZip , PureSource(..), sourcePure , getComment, setComment, removeComment@@ -105,7 +107,7 @@ import Control.Monad.State.Strict (StateT(..), MonadState(..), MonadTrans(..), lift, liftM) import Foreign.C.Error (Errno(..), eINVAL)-import Foreign.C.String (withCString, withCStringLen, peekCString)+import Foreign.C.String (withCString, peekCString) import Foreign.C.Types (CInt, CULLong) import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Array (allocaArray, peekArray, withArrayLen, pokeArray)@@ -113,6 +115,8 @@ import Foreign.Ptr (Ptr, nullPtr, castPtr) import Foreign.Storable (Storable, peek, poke, pokeElemOff, sizeOf) import qualified Control.Exception as E+import qualified Data.ByteString as BS+import qualified Data.ByteString.UTF8 as UTF8 -- -- Types@@ -145,21 +149,51 @@ c'zip_open path' (combine flags) errp >>= \z -> if z == nullPtr then peek errp >>= E.throwIO. errFromCInt- else do+ else withOpenArchive z action+++-- | Top-level wrapper for operations with an open encrypted archive.+-- 'withEncryptedArchive' opens and closes the file automatically.+-- On error it throws 'ZipError'.+withEncryptedArchive :: [OpenFlag] -- ^ Checks for consistency or existence.+ -> String -- ^ Encryption password.+ -> FilePath -- ^ Filename of the zip archive.+ -> Archive a -- ^ Action to don with the archive.+ -> IO a+withEncryptedArchive flags password path action =+ withCString password $ \password' ->+ withCString path $ \path' ->+ alloca $ \errp ->+ c'zip_open path' (combine flags) errp >>= \z ->+ if z == nullPtr+ then peek errp >>= E.throwIO. errFromCInt+ else do+ r <- c'zip_set_default_password z password'+ if r /= 0+ then get_error z >>= E.throwIO+ else withOpenArchive z action+++withOpenArchive :: Zip -> Archive a -> IO a+withOpenArchive z action = do r <- fst `liftM` runStateT action z e <- c'zip_close z if e /= 0 then get_error z >>= E.throwIO else return r + -- | Get the number of entries in the archive.-numFiles :: [FileFlag] -> Archive Integer+numFiles :: [FileFlag] -- ^ 'FileUNCHANGED' can be used to return+ -- the original unchanged number of entries.+ -> Archive Integer numFiles flags = do z <- getZip lift $ fromIntegral `liftM` c'zip_get_num_entries z (combine flags) -- | Get name of an entry in the archive by its index.-fileName :: [FileFlag] -- ^ 'FileUNCHANGED' flag can be used.+fileName :: [FileFlag] -- ^ 'FileUNCHANGED' flag can be used to+ -- return the original unchanged filename. -> Integer -- ^ Position index of a file in the archive. -> Archive FilePath -- ^ Name of the file in the archive. fileName flags i = do@@ -169,7 +203,19 @@ doIf' (n /= nullPtr) z $ peekCString n -- | Locate an entry (get its index) in the archive by its name.-nameLocate :: [FileFlag] -- ^ Filename lookup mode.+nameLocate :: [FileFlag]+ -- ^ Filename lookup mode.+ -- 'FileNOCASE': ignore case distinctions (only for ASCII).+ -- 'FileNODIR': ignore directory part of the file name.+ -- 'FileENC_RAW': compare against unmodified names as it is+ -- in the ZIP archive.+ -- 'FileENC_GUESS': (default) guess encoding of the name in+ -- the ZIP archive and convert it to UTF-8,+ -- if necessary.+ -- 'FileENC_STRICT': follow the ZIP specification and expect+ -- CP-437 encoded names in the ZIP archive+ -- (except if they are explicitly marked as+ -- UTF-8). Convert it to UTF-8 before comparing. -> FilePath -- ^ Name of the file in the archive. -> Archive (Maybe Integer) -- ^ 'Just' position index if found. nameLocate flags name = do@@ -225,7 +271,7 @@ doIf' (r == 0) z $ toZipStat =<< peek stat -- | Delete file from the archive.-deleteFile :: [FileFlag] -- ^ Filename lookup mode.+deleteFile :: [FileFlag] -- ^ Filename lookup mode (see 'nameLocate'). -> FilePath -- ^ Filename. -> Archive () deleteFile flags name = do@@ -243,21 +289,28 @@ else lift $ get_error z >>= E.throwIO -- | Rename file in the archive.-renameFile :: [FileFlag] -- ^ Filename lookup mode.+renameFile :: [FileFlag] -- ^ Filename lookup mode (see 'nameLocate'). -> FilePath -- ^ Old name. -> FilePath -- ^ New name. -> Archive () renameFile flags oldname newname = do mbi <- nameLocate flags oldname- maybe (lift $ E.throwIO ErrNOENT) (\i -> renameFileIx i newname) mbi+ maybe (lift $ E.throwIO ErrNOENT)+ (\i -> renameFileIx i (UTF8.fromString newname) [FileENC_UTF_8])+ mbi -- | Rename file (referenced by position index) in the archive.-renameFileIx :: Integer -- ^ Position index of a file in the archive.- -> FilePath -- ^ New name.+renameFileIx :: Integer -- ^ Position index of a file in the archive.+ -> BS.ByteString -- ^ New name.+ -> [FileFlag] -- ^ Name encoding flags.+ -- 'FileENC_GUESS': guess encoding of the name (default).+ -- 'FileENC_UTF_8': interpret name as UTF-8.+ -- 'FileENC_CP437': interpret name as CP-437. -> Archive ()-renameFileIx i newname = do+renameFileIx i newname flags = do z <- getZip- r <- lift $ withCString newname $ c'zip_rename z (fromIntegral i)+ r <- lift $ BS.useAsCString newname $ \s ->+ c'zip_file_rename z (fromIntegral i) s (combine flags) if r == 0 then return () else lift $ get_error z >>= E.throwIO@@ -266,10 +319,21 @@ addFile :: FilePath -- ^ Name of the file to create. -> ZipSource -- ^ Source where file data is obtained from. -> Archive Int -- ^ Position index of the new file.-addFile name src = do+addFile name src =+ let utf8name = UTF8.fromString name+ in addFileWithFlags [FileENC_UTF_8] utf8name src++addFileWithFlags+ :: [FileFlag] -- ^ Can be a combination of 'FileOVERWRITE' and/or one of+ -- filename encoding flags: 'FileENC_GUESS' (default),+ -- 'FileENC_UTF_8', 'FileENC_CP437'.+ -> BS.ByteString -- ^ Name of the file to create.+ -> ZipSource -- ^ Source where file data is obtained from.+ -> Archive Int -- ^ Position index of the new file.+addFileWithFlags flags namebytes src = do z <- getZip- lift $ withCString name $ \name' -> do- i <- c'zip_add z name' src+ lift $ BS.useAsCString namebytes $ \name' -> do+ i <- c'zip_file_add z name' src (combine flags) if i < 0 then c'zip_source_free src >> get_error z >>= E.throwIO else return $ fromIntegral i@@ -277,15 +341,26 @@ -- | Add a directory to the archive. addDirectory :: FilePath -- ^ Directory's name in the archive. -> Archive Int -- ^ Position index of the new directory entry.-addDirectory name = do+addDirectory name =+ let utf8name = UTF8.fromString name+ in addDirectoryWithFlags [FileENC_UTF_8] utf8name++-- | Add a directory to the archive.+addDirectoryWithFlags+ :: [FileFlag] -- ^ Can be one of filename encoding flags:+ -- 'FileENC_GUESS (default), 'FileENC_UTF_8', 'FileENC_CP437'.+ -> BS.ByteString -- ^ Directory's name in the archive.+ -> Archive Int -- ^ Position index of the new directory entry.+addDirectoryWithFlags flags name = do z <- getZip- r <- lift $ withCString name $ c'zip_add_dir z+ r <- lift $ BS.useAsCString name $+ \name'-> c'zip_dir_add z name' (combine flags) if r < 0 then lift $ get_error z >>= E.throwIO else return (fromIntegral r) -- | Replace a file in the archive.-replaceFile :: [FileFlag] -- ^ Filename lookup mode.+replaceFile :: [FileFlag] -- ^ Filename lookup mode (see 'nameLocate'). -> FilePath -- ^ File to replace. -> ZipSource -- ^ Source where the new file data is obtained from. -> Archive ()@@ -294,6 +369,33 @@ maybe (lift $ c'zip_source_free src >> E.throwIO ErrNOENT) (\i -> replaceFileIx i src >> return ()) mbi +-- | Set compression method for a file in the archive.+setFileCompression+ :: [FileFlag] -- ^ Filename lookup mode (see 'nameLocate').+ -> FilePath -- ^ Filename.+ -> ZipCompMethod -- ^ Compression method.+ -- As of libzip 0.11, the following methods are supported:+ -- 'CompDEFAULT', 'CompSTORE', 'CompDEFLATE'.+ -> Archive ()+setFileCompression flags name method = do+ mbi <- nameLocate flags name+ maybe (lift $ E.throwIO ErrNOENT) (\i -> setFileCompressionIx i method) mbi++-- | Set compression method for a file in the archive.+setFileCompressionIx+ :: Integer -- ^ Position index of a file in the archive.+ -> ZipCompMethod -- ^ Compression method.+ -- As of libzip 0.11, the following methods are supported:+ -- 'CompDEFAULT', 'CompSTORE', 'CompDEFLATE'.+ -> Archive ()+setFileCompressionIx i method = do+ z <- getZip+ lift $ do+ r <- c'zip_set_file_compression z (fromIntegral i) (fromIntegral . fromEnum $ method) 0+ if r /= 0+ then get_error z >>= E.throwIO+ else return ()+ -- | Replace a file in the archive (referenced by position index). replaceFileIx :: Integer -- ^ Position index of a file in the archive. -> ZipSource -- ^ Source where the new file data is obtained from@@ -301,7 +403,7 @@ replaceFileIx i src = do z <- getZip lift $ do- r <- c'zip_replace z (fromIntegral i) src+ r <- c'zip_file_replace z (fromIntegral i) src 0 if r < 0 then c'zip_source_free src >> get_error z >>= E.throwIO else return ()@@ -412,7 +514,8 @@ | otherwise = return (-1) -- | Get zip archive comment.-getComment :: [FileFlag] -- ^ 'FileUNCHANGED' can be used.+getComment :: [FileFlag] -- ^ Can be a combination of 'FileUNCHANGED' and/or+ -- one of 'FileENC_GUESS' (default), 'FileENC_STRICT' (CP-437). -> Archive (Maybe String) getComment flags = do z <- getZip@@ -422,14 +525,15 @@ return (c,n) if c == nullPtr then return Nothing- else lift $ peekCString c >>= return . Just . take (fromIntegral n)+ else lift $ BS.packCStringLen (c, fromIntegral n) >>= return . Just . UTF8.toString -- | Set zip archive comment. setComment :: String -- ^ Comment message. -> Archive () setComment msg = do z <- getZip- r <- lift $ withCStringLen msg $ \(msg',i') ->+ let utf8msg = UTF8.fromString msg+ r <- lift $ BS.useAsCStringLen utf8msg $ \(msg',i') -> c'zip_set_archive_comment z msg' (fromIntegral i') if r < 0 then lift $ get_error z >>= E.throwIO@@ -445,50 +549,75 @@ else return () -- | Get comment for a file in the archive.-getFileComment :: [FileFlag] -- ^ Filename lookup mode.+getFileComment :: [FileFlag] -- ^ Filename lookup mode (see 'nameLocate'). -> FilePath -- ^ Filename -> Archive (Maybe String) getFileComment flags name = do mbi <- nameLocate flags name- maybe (lift $ E.throwIO ErrNOENT) (getFileCommentIx flags) mbi+ -- Backwards compatibility with LibZip < 0.11: FileUNCHANGED flag from+ -- the filename lookup mode was used to get the original unchanged comment.+ -- Please don't rely on this feature and use 'getFileCommentIx' instead.+ let comment_flags = filter (== FileUNCHANGED) flags+ maybe (lift $ E.throwIO ErrNOENT)+ (\i -> do+ mbs <- getFileCommentIx comment_flags i+ -- 'FileENC_GUESS' is default => mbs is UTF-8 encoded+ return $ liftM UTF8.toString mbs+ ) mbi -- | Get comment for a file in the archive (referenced by position index).-getFileCommentIx :: [FileFlag] -- ^ FileUNCHANGED can be used.+getFileCommentIx :: [FileFlag] -- ^ Comment lookup flags.+ -- 'FileUNCHANGED': return the original unchanged comment.+ -- 'FileENC_RAW': return the unmodified commment as it is.+ -- 'FileENC_GUESS': (default) guess the encoding of the comment+ -- and convert it to UTF-8, if necessary.+ -- 'FileENC_STRICT': follow the ZIP specification for file names+ -- and extend it to file comments, expect+ -- them to be encoded in CP-437. Convert it+ -- to UTF-8. -> Integer -- ^ Position index of the file.- -> Archive (Maybe String)+ -> Archive (Maybe BS.ByteString) getFileCommentIx flags i = do z <- getZip (c,n) <- lift $ alloca $ \lenp -> do- c <- c'zip_get_file_comment z (fromIntegral i) lenp (combine flags)+ c <- c'zip_file_get_comment z (fromIntegral i) lenp (combine flags) n <- peek lenp return (c,n) if c == nullPtr then return Nothing- else lift $ peekCString c >>= return . Just . take (fromIntegral n)+ else lift $ BS.packCStringLen (c,fromIntegral n) >>= return . Just -- | Set comment for a file in the archive.-setFileComment :: [FileFlag] -- ^ Name lookup mode.+setFileComment :: [FileFlag] -- ^ Filename lookup mode (see 'nameLocate'). -> FilePath -- ^ Filename. -> String -- ^ New file comment. -> Archive () setFileComment flags path comment = do mbi <- nameLocate flags path- maybe (lift $ E.throwIO ErrNOENT) (flip setFileCommentIx comment) mbi+ let utf8comment = UTF8.fromString comment+ let cflags = [FileENC_UTF_8]+ maybe (lift $ E.throwIO ErrNOENT)+ (\i -> setFileCommentIx i utf8comment cflags)+ mbi -- | Set comment for a file in the archive (referenced by position index).-setFileCommentIx :: Integer -- ^ Position index of a file in the archive.- -> String -- ^ New file comment.+setFileCommentIx :: Integer -- ^ Position index of a file in the archive.+ -> BS.ByteString -- ^ New file comment.+ -> [FileFlag] -- ^ Comment encoding flags.+ -- 'FileENC_GUESS': guess encoding of the comment (default).+ -- 'FileENC_UTF_8': interpret comment as UTF-8.+ -- 'FileENC_CP437': interpret comment as CP-437. -> Archive ()-setFileCommentIx i comment = do+setFileCommentIx i comment cflags = do z <- getZip- r <- lift $ withCStringLen comment $ \(msg,len) ->- c'zip_set_file_comment z (fromIntegral i) msg (fromIntegral len)+ r <- lift $ BS.useAsCStringLen comment $ \(msg,len) ->+ c'zip_file_set_comment z (fromIntegral i) msg (fromIntegral len) (combine cflags) if r < 0 then lift $ get_error z >>= E.throwIO else return () -- | Remove comment for a file in the archive.-removeFileComment :: [FileFlag] -- ^ Filename lookup mode.+removeFileComment :: [FileFlag] -- ^ Filename lookup mode (see 'nameLocate'). -> FilePath -- ^ Filename. -> Archive () removeFileComment flags path = do@@ -499,14 +628,15 @@ removeFileCommentIx :: Integer -- ^ Position index of a file in the archive. -> Archive () removeFileCommentIx i = do+ let flags = 0 -- file name encoding flags (*_FL_*) are irrelevant z <- getZip- r <- lift $ c'zip_set_file_comment z (fromIntegral i) nullPtr 0+ r <- lift $ c'zip_file_set_comment z (fromIntegral i) nullPtr 0 flags if r < 0 then lift $ get_error z >>= E.throwIO else return () -- | Undo changes to a file in the archive.-unchangeFile :: [FileFlag] -- ^ Filename lookup mode.+unchangeFile :: [FileFlag] -- ^ Filename lookup mode (see 'nameLocate'). -> FilePath -- ^ Filename. -> Archive () unchangeFile flags name = do
Codec/Archive/LibZip/Types.hs view
@@ -15,7 +15,7 @@ , ZipEncryptionMethod(..) , combine ) where- + import Data.Bits ((.|.)) import Data.Time (UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)@@ -35,6 +35,7 @@ type ZipFile = Ptr C'zip_file -- | Handler of data source for new files in the zip archive.+-- Constructors: 'sourceBuffer', 'sourceFile', 'sourceZip', 'sourcePure'. type ZipSource = Ptr C'zip_source -- | File statistics expressed in native Haskell types.@@ -67,22 +68,25 @@ let flags = toEnum . fromIntegral $ c'zip_stat'flags s return $ ZipStat valid name idx size comp_size mtime crc comp_meth enc_meth flags- + -- | Flags for opening an archive. data OpenFlag = CreateFlag -- ^ Create an archive if it does not exist. | ExclFlag -- ^ Error if the archive already exists. | CheckConsFlag -- ^ Check archive's consistency and error on failure.+ | TruncateFlag -- ^ If archive exists, ignore its current content. deriving (Show,Eq) instance Enum OpenFlag where fromEnum CheckConsFlag = c'ZIP_CHECKCONS fromEnum CreateFlag = c'ZIP_CREATE fromEnum ExclFlag = c'ZIP_EXCL+ fromEnum TruncateFlag = c'ZIP_TRUNCATE toEnum x | x == c'ZIP_CHECKCONS = CheckConsFlag toEnum x | x == c'ZIP_CREATE = CreateFlag toEnum x | x == c'ZIP_EXCL = ExclFlag+ toEnum x | x == c'ZIP_TRUNCATE = TruncateFlag toEnum _ = undefined -- | Flags for accessing files in the archive.@@ -94,6 +98,14 @@ | FileUNCHANGED -- ^ Read the original data, ignore changes. | FileRECOMPRESS -- ^ Force recompression of data. | FileENCRYPTED -- ^ Read encrypted data (implies FileCOMPRESSED).+ | FileENC_GUESS -- ^ Guess string encoding (default).+ | FileENC_RAW -- ^ Get unmodified string.+ | FileENC_STRICT -- ^ Follow specification strictly.+ | FileLOCAL -- ^ In local header.+ | FileCENTRAL -- ^ In central directory.+ | FileENC_UTF_8 -- ^ String is UTF-8 encoded.+ | FileENC_CP437 -- ^ String is CP437 encoded.+ | FileOVERWRITE -- ^ When adding files: if file name exists, overwrite. deriving (Show,Eq) instance Enum FileFlag where@@ -103,12 +115,28 @@ fromEnum FileRECOMPRESS = c'ZIP_FL_RECOMPRESS fromEnum FileUNCHANGED = c'ZIP_FL_UNCHANGED fromEnum FileENCRYPTED = c'ZIP_FL_ENCRYPTED+ fromEnum FileENC_GUESS = c'ZIP_FL_ENC_GUESS+ fromEnum FileENC_RAW = c'ZIP_FL_ENC_RAW+ fromEnum FileENC_STRICT = c'ZIP_FL_ENC_STRICT+ fromEnum FileLOCAL = c'ZIP_FL_LOCAL+ fromEnum FileCENTRAL = c'ZIP_FL_CENTRAL+ fromEnum FileENC_UTF_8 = c'ZIP_FL_ENC_UTF_8+ fromEnum FileENC_CP437 = c'ZIP_FL_ENC_CP437+ fromEnum FileOVERWRITE = c'ZIP_FL_OVERWRITE toEnum x | x == c'ZIP_FL_COMPRESSED = FileCOMPRESSED toEnum x | x == c'ZIP_FL_NOCASE = FileNOCASE toEnum x | x == c'ZIP_FL_NODIR = FileNODIR toEnum x | x == c'ZIP_FL_RECOMPRESS = FileRECOMPRESS toEnum x | x == c'ZIP_FL_UNCHANGED = FileUNCHANGED toEnum x | x == c'ZIP_FL_ENCRYPTED = FileENCRYPTED+ toEnum x | x == c'ZIP_FL_ENC_GUESS = FileENC_GUESS+ toEnum x | x == c'ZIP_FL_ENC_RAW = FileENC_RAW+ toEnum x | x == c'ZIP_FL_ENC_STRICT = FileENC_STRICT+ toEnum x | x == c'ZIP_FL_LOCAL = FileLOCAL+ toEnum x | x == c'ZIP_FL_CENTRAL = FileCENTRAL+ toEnum x | x == c'ZIP_FL_ENC_UTF_8 = FileENC_UTF_8+ toEnum x | x == c'ZIP_FL_ENC_CP437 = FileENC_CP437+ toEnum x | x == c'ZIP_FL_OVERWRITE = FileOVERWRITE toEnum _ = undefined @@ -127,11 +155,16 @@ -- | @libzip@ flags for compression and encryption sources-data CodecFlag = CodecENCODE deriving (Show, Eq)+data CodecFlag+ = CodecENCODE+ | CodecDECODE+ deriving (Show, Eq) instance Enum CodecFlag where fromEnum CodecENCODE = c'ZIP_CODEC_ENCODE+ fromEnum CodecDECODE = c'ZIP_CODEC_DECODE toEnum x | x == c'ZIP_CODEC_ENCODE = CodecENCODE+ toEnum x | x == c'ZIP_CODEC_DECODE = CodecDECODE toEnum _ = undefined @@ -254,7 +287,7 @@ show ErrREMOVE = "Can't remove file" show ErrDELETED = "Entry has been deleted" show ErrENCRNOTSUPP = "Encryption method not supported"- show ErrRDONLY = "Read-only archive" + show ErrRDONLY = "Read-only archive" show ErrNOPASSWD = "No password provided" show ErrWRONGPASSWD = "Wrong password provided" @@ -334,4 +367,3 @@ combine :: (Enum a, Num b) => [a] -> b combine fs = fromIntegral . foldr (.|.) 0 $ map fromEnum fs-
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2009, 2010, Sergey Astanin+Copyright (c) 2009-2013, Sergey Astanin All rights reserved. Redistribution and use in source and binary forms, with or without
LibZip.cabal view
@@ -1,5 +1,5 @@ Name: LibZip-Version: 0.10.2+Version: 0.11 License: BSD3 License-File: LICENSE Author: Sergey Astanin@@ -14,8 +14,7 @@ This package allows to use it from Haskell code. Build-Type: Simple-Cabal-Version: >= 1.2.3-Tested-With: GHC == 7.4.1, GHC == 7.6.1+Cabal-Version: >= 1.8 Extra-Source-Files: examples/hzip.hs@@ -30,10 +29,27 @@ Codec.Archive.LibZip.Errors Build-Depends: base >= 4.0 && < 5.0- , bindings-libzip >= 0.10 && < 0.11+ , bindings-libzip >= 0.11 && < 0.12 , bytestring , filepath , time , mtl+ , bytestring+ , utf8-string GHC-Options: -Wall++Test-Suite test-libzip+ Type: exitcode-stdio-1.0+ Main-Is: runTests.hs+ Build-Depends:+ LibZip+ , base >= 4.0 && < 5.0+ , bindings-libzip >= 0.11 && < 0.12+ , directory+ , filepath+ , HUnit+ , mtl+ , time+ , bytestring+ , utf8-string
Setup.lhs view
@@ -1,20 +1,7 @@ #!/usr/bin/env runhaskell-> import Distribution.Simple-> import System.Cmd (system)-> import System.Exit (ExitCode(..))-> import Distribution.PackageDescription (emptyHookedBuildInfo)->-> main = defaultMainWithHooks simpleUserHooks-> { runTests = runUnitTests-> }->+> module Main where >-> runUnitTests _ _ _ _ =-> system "runhaskell -lzip -fno-warn-warnings-deprecations runTests.hs" >>=-> onExit "\nSome tests did not pass." ()+> import Distribution.Simple >-> onExit :: String -> a -> ExitCode -> IO a-> onExit errmsg okvalue r =-> case r of-> ExitSuccess -> return okvalue-> _ -> fail errmsg+> main :: IO ()+> main = defaultMain
Tests/Common.hs view
@@ -1,5 +1,5 @@ module Tests.Common- ( testzip, testfiles, lastfile, lastfilesize+ ( testzip, encryptedzip, testfiles, lastfile, lastfilesize , world_txt , toUpper, toLower, map2 ) where@@ -7,6 +7,7 @@ import Data.Char (toUpper, toLower) testzip = "Tests/test.zip"+encryptedzip = "Tests/encrypted.zip" testfiles = [ "hello/", "hello/world.txt" ] lastfile = last testfiles lastfilesize = 71 :: Integer
Tests/MonadicTests.hs view
@@ -8,45 +8,57 @@ import Foreign.Storable import Foreign.Ptr (Ptr, castPtr) +import Control.Monad (liftM2) import System.Directory (doesFileExist, getTemporaryDirectory, removeFile) import System.FilePath ((</>))+import System.IO (openFile, hClose, hFileSize, IOMode(..)) import Test.HUnit import qualified Control.Exception as E+import qualified Data.ByteString as BS+import qualified Data.ByteString.UTF8 as UTF8 monadicTests = TestList [ "read list of files" ~: do files <- withArchive [] testzip $ fileNames [] files @?= testfiles+ , "read file size" ~: do sz <- withArchive [] testzip $ fileSize [] lastfile sz @?= lastfilesize+ , "case-insensitive file names" ~: do sz <- withArchive [] testzip $ fileSize [FileNOCASE] (map2 toUpper toLower $ lastfile) sz @?= lastfilesize+ , "open error if exists (with ExclFlag)" ~: do err <- catchZipError (withArchive [ExclFlag] testzip $ lift $ E.throwIO ErrOK) (return . id) err @?= ErrEXISTS+ , "open error if archive does not exists" ~: do err <- catchZipError (withArchive [] "notexists.zip" $ return ErrOK) (return . id) err @?= ErrOPEN+ , "read file" ~: do txt <- withArchive [] testzip $ fileContents [] lastfile txt @?= world_txt+ , "read file by index" ~: do let i = toInteger (length testfiles - 1) txt <- withArchive [] testzip $ fileContentsIx [] i txt @?= world_txt+ , "skipBytes/readBytes" ~: do txt <- withArchive [] testzip $ fromFile [] lastfile $ do skipBytes 13 readBytes 10 txt @?= (take 10 . drop 13 $ world_txt)+ , "create an archive/use sourceBuffer" ~: do tmpzip <- getTmpFileName "test_LibZip_sourceBuffer.zip" i <- withArchive [CreateFlag] tmpzip $ do@@ -56,6 +68,21 @@ txt <- withArchive [] f $ fileContents [] "hello/world.txt" removeFile f (txt, i) @?= (world_txt, 1)++ , "create an archive with Unicode filenames" ~: do+ tmpzip <- getTmpFileName "test_LibZip_unicode_filenames.zip"+ let dir = "\x4e16\x754c"+ let name1 = "\x4e16\x754c/привет.txt"+ let name2 = "\x4e16\x754c/мир.txt"+ i <- withArchive [CreateFlag] tmpzip $ do+ addDirectory dir+ addFile name1 =<< sourceBuffer world_txt+ addFileWithFlags [FileENC_UTF_8] (UTF8.fromString name2) =<< sourceBuffer world_txt+ tmpzip `doesExistAnd` \f -> do+ names <- withArchive [] f $ fileNames []+ removeFile f+ names @?= [dir ++ "/", name1, name2]+ , "create an archive/use sourceFile" ~: do tmpzip <- getTmpFileName "test_LibZip_sourceFile.zip" tmpsrc <- getTmpFileName "test_LibZip_sourceFile.txt"@@ -67,6 +94,7 @@ removeFile tmpzip removeFile tmpsrc txt @?= world_txt+ , "create an archive/use sourceZip" ~: do tmpzip <- getTmpFileName "test_LibZip_sourceZip.zip" withArchive [] testzip $ do@@ -77,6 +105,7 @@ txt <- withArchive [] f $ fileContents [] "world.txt" removeFile tmpzip txt @?= world_txt+ , "create an archive/use sourcePure" ~: do tmpzip <- getTmpFileName "test_LibZip_sourcePure.zip" let src = PureSource@@ -94,6 +123,7 @@ txt <- withArchive [] f $ fileContents [] "world.txt" removeFile tmpzip txt @?= world_txt+ , "delete a file" ~: do let orig = [("one", "one"), ("two", "two")] let final = init orig@@ -104,6 +134,7 @@ fs_final <- withArchive [] tmpzip $ fileNames [] removeFile tmpzip (fs_orig, fs_final) @?= (map fst orig, map fst final)+ , "attempt to delete a non-existing file" ~: do tmpzip <- getTmpFileName "test_LibZip_delete_ne.zip" mkArchive tmpzip [("world.txt", world_txt)]@@ -117,6 +148,7 @@ (return . id) removeFile tmpzip (r1, r2) @?= (ErrNOENT, ErrINVAL)+ , "rename a file" ~: do tmpzip <- getTmpFileName "test_LibZip_rename.zip" mkArchive tmpzip [("world.txt", world_txt)]@@ -125,6 +157,7 @@ fileNames [] removeFile tmpzip fs @?= ["hello.txt"]+ , "attempt to rename a non-existing file" ~: do tmpzip <- getTmpFileName "test_LibZip_rename_ne.zip" mkArchive tmpzip [("world.txt", world_txt)]@@ -135,16 +168,21 @@ (return . id) removeFile tmpzip r @?= ErrNOENT- , "attempt to rename to an empty name" ~: do- tmpzip <- getTmpFileName "test_LibZip_rename_inval.zip"- mkArchive tmpzip [("world.txt", world_txt)]- r <- catchZipError- (withArchive [] tmpzip $ do- renameFile [] "world.txt" ""- return ErrOK)- (return . id)- removeFile tmpzip- r @?= ErrINVAL++ -- -- libzip 0.11 renames an entry to an empty string without errors;+ -- the test is disabled.+ --+ -- , "attempt to rename to an empty name" ~: do+ -- tmpzip <- getTmpFileName "test_LibZip_rename_inval.zip"+ -- mkArchive tmpzip [("world.txt", world_txt)]+ -- r <- catchZipError+ -- (withArchive [] tmpzip $ do+ -- renameFile [] "world.txt" ""+ -- return ErrOK)+ -- (return . id)+ -- removeFile tmpzip+ -- r @?= ErrINVAL+ , "replace a file" ~: do tmpzip <- getTmpFileName "test_LibZip_replace.zip" mkArchive tmpzip [("hello/",""), ("hello/world.txt", "old contents")]@@ -152,6 +190,39 @@ replaceFile [] "hello/world.txt" =<< sourceBuffer world_txt txt <- withArchive [] tmpzip $ fileContents [] "hello/world.txt" txt @?= world_txt+ removeFile tmpzip++ , "set file compression method" ~: do+ tmpzip1 <- getTmpFileName "test_LibZip_compression_DEFLATE.zip"+ tmpzip2 <- getTmpFileName "test_LibZip_compression_some.zip"+ tmpzip3 <- getTmpFileName "test_LibZip_compression_STORE.zip"+ -- archive contents with high level of duplicity (compressibility)+ let long_text = concat $ replicate 100 world_txt+ let contents = [ ("hello.txt", long_text), ("world.txt", long_text) ]+ -- all files are compressed+ mkArchive tmpzip1 contents+ withArchive [] tmpzip1 $ do+ n <- numFiles []+ flip mapM_ [0..n-1] $ \i -> setFileCompressionIx i CompDEFLATE+ -- only some files are compessed+ mkArchive tmpzip2 contents+ withArchive [] tmpzip2 $ do+ setFileCompression [] "hello.txt" CompSTORE+ setFileCompression [] "world.txt" CompDEFLATE+ -- uncompressed archive+ mkArchive tmpzip3 contents+ withArchive [] tmpzip3 $ do+ n <- numFiles []+ flip mapM_ [0..n-1] $ \i -> setFileCompressionIx i CompSTORE+ -- compare file sizes+ sz1 <- getFileSize tmpzip1+ sz2 <- getFileSize tmpzip2+ sz3 <- getFileSize tmpzip3+ removeFile tmpzip1+ removeFile tmpzip2+ removeFile tmpzip3+ (liftM2 (<) sz1 sz2, liftM2 (<) sz2 sz3) @?= (Just True, Just True)+ , "set/get/remove archive comment" ~: do c1 <- withArchive [] testzip $ getComment [] tmpzip <- getTmpFileName "test_LibZip_comment.zip"@@ -163,7 +234,19 @@ withArchive [] tmpzip $ removeComment c2_removed <- withArchive [] tmpzip $ getComment [] removeFile tmpzip- (c1, c2, c2_added, c2_removed) @?= (Nothing, Nothing, Just com, Nothing)+ -- libzip-0.11 returns an empty string, instead of NULL pointer in 0.10.+ -- Haskell LibZip reflects it by returning Just "" rather than Nothing.+ (c1, c2, c2_added, c2_removed) @?= (Just "", Just "", Just com, Just "")++ , "set/get Unicode archive comment" ~: do+ tmpzip <- getTmpFileName "test_LibZip_Unicode_comment.zip"+ mkArchive tmpzip [("hello/",""), ("hello/world.txt", world_txt)]+ let unicodeComment = "Привет, мир!"+ withArchive [] tmpzip $ setComment unicodeComment+ comment <- withArchive [] tmpzip $ getComment []+ removeFile tmpzip+ comment @?= (Just unicodeComment)+ , "set/get/remove file comment" ~: do tmpzip <- getTmpFileName "test_LibZip_file_comment.zip" let world_path = "hello/world.txt"@@ -176,7 +259,25 @@ withArchive [] tmpzip $ removeFileComment [] world_path c_off' <- get_comm removeFile tmpzip- (c_off, c_on, c_off') @?= (Nothing, Just world_comm, Nothing)+ -- libzip-0.11 returns an empty string, instead of NULL pointer in 0.10.+ -- Haskell LibZip reflects it by returning Just "" rather than Nothing.+ (c_off, c_on, c_off') @?= (Just "", Just world_comm, Just "")++ , "set/get Unicode file comment" ~: do+ tmpzip <- getTmpFileName "test_LibZip_file_comment.zip"+ let world_path = "hello/world.txt"+ let world_comm = "\1087\1088\1080\1074\1077\1090"+ let world_comm2 = [208,188,208,184,209,128]+ mkArchive tmpzip [("hello/",undefined), (world_path,world_txt)]+ let get_comm = withArchive [] tmpzip $ getFileComment [] world_path+ c_off <- get_comm+ withArchive [] tmpzip $ setFileComment [] world_path world_comm+ c_on <- get_comm+ withArchive [] tmpzip $ setFileCommentIx 1 (BS.pack world_comm2) [FileENC_UTF_8]+ c_on2 <- get_comm+ removeFile tmpzip+ (c_off, c_on, c_on2) @?= (Just "", Just "привет", Just "мир")+ , "unchange file" ~: do tmpzip <- getTmpFileName "test_LibZip_unchange_file.zip" mkArchive tmpzip [("world.txt",world_txt)]@@ -185,7 +286,10 @@ unchangeFile [] "world.txt" getFileComment [] "world.txt" removeFile tmpzip- c @?= Nothing+ -- libzip-0.11 returns an empty string, instead of NULL pointer in 0.10.+ -- Haskell LibZip reflects it by returning Just "" rather than Nothing.+ c @?= Just ""+ , "unchange archive" ~: do tmpzip <- getTmpFileName "test_LibZip_unchange.zip" mkArchive tmpzip [("world.txt",world_txt)]@@ -194,7 +298,10 @@ unchangeArchive getComment [] removeFile tmpzip- c @?= Nothing+ -- libzip-0.11 returns an empty string, instead of NULL pointer in 0.10.+ -- Haskell LibZip reflects it by returning Just "" rather than Nothing.+ c @?= Just ""+ , "unchange all" ~: do tmpzip <- getTmpFileName "test_LibZip_unchange_all.zip" mkArchive tmpzip [("world.txt",world_txt)]@@ -206,8 +313,14 @@ c2 <- getFileComment [] "world.txt" return (c1,c2) removeFile tmpzip- c @?= (Nothing,Nothing)+ -- libzip-0.11 returns an empty string, instead of NULL pointer in 0.10.+ -- Haskell LibZip reflects it by returning Just "" rather than Nothing.+ c @?= (Just "", Just "") + , "read a file from an encrypted archive" ~: do+ txt <- withEncryptedArchive [] "purity" encryptedzip $ fileContents [] lastfile+ txt @?= world_txt+ -- libzip-0.11 doesn't support creating encrypted archives yet ] getTmpFileName basename = do@@ -240,12 +353,23 @@ mkArchive :: (Enum a) => FilePath -> [(FilePath, [a])] -> IO () mkArchive zipname contents =- withArchive [CreateFlag] zipname $+ withArchive [CreateFlag] zipname $ populateArchive contents++populateArchive :: (Enum a) => [(FilePath, [a])] -> Archive ()+populateArchive contents = mapM_ (\(f,d) -> if last f == '/' then addDirectory f else addFile f =<< sourceBuffer d ) contents- - +getFileSize :: FilePath -> IO (Maybe Integer)+getFileSize path =+ E.handle handler $+ E.bracket (openFile path ReadMode) (hClose) $+ \h -> do+ size <- hFileSize h+ return $ Just size+ where+ handler :: E.SomeException -> IO (Maybe Integer)+ handler _ = return Nothing