{-# 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 @?= ErrNOENT , "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