{-# 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 System.Directory (doesFileExist, getTemporaryDirectory, removeFile) import System.FilePath (()) import Test.HUnit import qualified Control.Exception as E 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 txt <- withArchive [] testzip $ fileContentsIx [] (length testfiles - 1) 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/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 , "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 , "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 (c1, c2, c2_added, c2_removed) @?= (Nothing, Nothing, Just com, Nothing) , "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 (c_off, c_on, c_off') @?= (Nothing, Just world_comm, Nothing) , "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 c @?= Nothing , "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 c @?= Nothing , "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 c @?= (Nothing,Nothing) ] 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 $ mapM_ (\(f,d) -> if last f == '/' then addDirectory f else addFile f =<< sourceBuffer d ) contents