LibZip-0.10: 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 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
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/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