LibZip-0.11: Tests/MonadicTests.hs
{-# LANGUAGE FlexibleInstances #-}
module Tests.MonadicTests where
import Codec.Archive.LibZip
import Tests.Common
import Data.Int (Int64)
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
addDirectory "hello"
addFile "hello/world.txt" =<< sourceBuffer world_txt
tmpzip `doesExistAnd` \f -> do
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"
writeFile tmpsrc world_txt
withArchive [CreateFlag] tmpzip $
addFile "world.txt" =<< sourceFile tmpsrc 0 0
tmpzip `doesExistAnd` \f -> do
txt <- withArchive [] f $ fileContents [] "world.txt"
removeFile tmpzip
removeFile tmpsrc
txt @?= world_txt
, "create an archive/use sourceZip" ~: do
tmpzip <- getTmpFileName "test_LibZip_sourceZip.zip"
withArchive [] testzip $ do
zsrc <- getZip
lift $ withArchive [CreateFlag] tmpzip $
addFile "world.txt" =<< sourceZip [] zsrc 1 0 0
tmpzip `doesExistAnd` \f -> do
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
{ srcState = (0, length world_txt) -- needs a Storable instance
, srcSize = length world_txt
, srcMTime = Nothing
, readSrc = \len (pos,lft) ->
let n = min len lft
buf = take n . drop pos $ world_txt
in Just (n, buf, (pos+n,lft-n))
}
withArchive [CreateFlag] tmpzip $ do
addFile "world.txt" =<< sourcePure src
tmpzip `doesExistAnd` \f -> do
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
tmpzip <- getTmpFileName "test_LibZip_delete.zip"
mkArchive tmpzip orig
fs_orig <- withArchive [] tmpzip $ fileNames []
withArchive [] tmpzip $ deleteFile [] "two"
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)]
r1 <- catchZipError
(withArchive [] tmpzip $
deleteFile [] "doesnotexist" >> return ErrOK)
(return . id)
r2 <- catchZipError
(withArchive [] tmpzip $
deleteFileIx 100 >> return ErrOK)
(return . id)
removeFile tmpzip
(r1, r2) @?= (ErrNOENT, ErrINVAL)
, "rename a file" ~: do
tmpzip <- getTmpFileName "test_LibZip_rename.zip"
mkArchive tmpzip [("world.txt", world_txt)]
fs <- withArchive [] tmpzip $ do
renameFile [] "world.txt" "hello.txt"
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)]
r <- catchZipError
(withArchive [] tmpzip $ do
renameFile [] "doesnotexist" "hello.txt"
return ErrOK)
(return . id)
removeFile tmpzip
r @?= ErrNOENT
-- -- 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")]
withArchive [] tmpzip $
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"
mkArchive tmpzip [("hello/",""), ("hello/world.txt", world_txt)]
c2 <- withArchive [] tmpzip $ getComment []
let com = "this is a test"
withArchive [] tmpzip $ setComment com
c2_added <- withArchive [] tmpzip $ getComment []
withArchive [] tmpzip $ removeComment
c2_removed <- withArchive [] tmpzip $ getComment []
removeFile tmpzip
-- 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"
let world_comm = "this is a test"
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 $ removeFileComment [] world_path
c_off' <- get_comm
removeFile tmpzip
-- 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)]
c <- withArchive [] tmpzip $ do
setFileComment [] "world.txt" "a comment to undo"
unchangeFile [] "world.txt"
getFileComment [] "world.txt"
removeFile tmpzip
-- 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)]
c <- withArchive [] tmpzip $ do
setComment "a comment to undo"
unchangeArchive
getComment []
removeFile tmpzip
-- 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)]
c <- withArchive [] tmpzip $ do
setComment "a comment to undo"
setFileComment [] "world.txt" "a file comment to undo"
unchangeAll
c1 <- getComment []
c2 <- getFileComment [] "world.txt"
return (c1,c2)
removeFile tmpzip
-- 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
tmpdir <- getTemporaryDirectory
let tmpfile = tmpdir </> basename
doesFileExist tmpfile >>= \b ->
if b
then removeFile tmpfile >> return tmpfile
else return tmpfile
doesExistAnd filepath assertion = do
exists <- doesFileExist filepath
if exists
then assertion filepath
else False @? ( "File " ++ filepath ++ " does not exist." )
-- for sourcePure, requires FlexibleInstances
instance Storable (Int,Int) where
sizeOf _ = 2 * sizeOf (0::Int)
alignment _ = alignment (0::Int)
peek ptr = do
let ptr' = castPtr ptr :: Ptr Int
a <- peekElemOff ptr' 0
b <- peekElemOff ptr' 1
return (a, b)
poke ptr (a,b) = do
let ptr' = castPtr ptr :: Ptr Int
pokeElemOff ptr' 0 $ a
pokeElemOff ptr' 1 $ b
mkArchive :: (Enum a) => FilePath -> [(FilePath, [a])] -> IO ()
mkArchive zipname contents =
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