339 lines
12 KiB
Haskell
339 lines
12 KiB
Haskell
|
{-# LANGUAGE CPP #-}
|
||
|
|
{-# LANGUAGE RankNTypes #-}
|
||
|
|
module Main where
|
||
|
|
|
||
|
|
import Codec.Compression.Zlib.Internal
|
||
|
|
import qualified Codec.Compression.Zlib as Zlib
|
||
|
|
import qualified Codec.Compression.GZip as GZip
|
||
|
|
import qualified Codec.Compression.Zlib.Raw as Raw
|
||
|
|
|
||
|
|
import Test.Codec.Compression.Zlib.Internal ()
|
||
|
|
import Test.Codec.Compression.Zlib.Stream ()
|
||
|
|
|
||
|
|
import Test.QuickCheck
|
||
|
|
import Test.Tasty
|
||
|
|
import Test.Tasty.QuickCheck
|
||
|
|
import Test.Tasty.HUnit
|
||
|
|
import Utils ()
|
||
|
|
|
||
|
|
import Control.Monad
|
||
|
|
import Control.Monad.ST.Lazy (ST)
|
||
|
|
import Control.Exception
|
||
|
|
import qualified Data.ByteString.Char8 as BS.Char8
|
||
|
|
import qualified Data.ByteString.Lazy as BL
|
||
|
|
import qualified Data.ByteString as BS
|
||
|
|
import System.IO
|
||
|
|
#if !(MIN_VERSION_base(4,6,0))
|
||
|
|
import Prelude hiding (catch)
|
||
|
|
#endif
|
||
|
|
|
||
|
|
|
||
|
|
main :: IO ()
|
||
|
|
main = defaultMain $
|
||
|
|
testGroup "zlib tests" [
|
||
|
|
testGroup "property tests" [
|
||
|
|
testProperty "decompress . compress = id (standard)" prop_decompress_after_compress,
|
||
|
|
testProperty "decompress . compress = id (Zlib -> GZipOrZLib)" prop_gziporzlib1,
|
||
|
|
testProperty "decompress . compress = id (GZip -> GZipOrZlib)" prop_gziporzlib2,
|
||
|
|
testProperty "concatenated gzip members" prop_gzip_concat,
|
||
|
|
testProperty "multiple gzip members, boundaries (all 2-chunks)" prop_multiple_members_boundary2,
|
||
|
|
testProperty "multiple gzip members, boundaries (all 3-chunks)" prop_multiple_members_boundary3,
|
||
|
|
testProperty "prefixes of valid stream detected as truncated" prop_truncated
|
||
|
|
],
|
||
|
|
testGroup "unit tests" [
|
||
|
|
testCase "simple gzip case" test_simple_gzip,
|
||
|
|
testCase "detect bad crc" test_bad_crc,
|
||
|
|
testCase "detect non-gzip" test_non_gzip,
|
||
|
|
testCase "detect custom dictionary" test_custom_dict,
|
||
|
|
testCase "dectect inflate with wrong dict" test_wrong_dictionary,
|
||
|
|
testCase "dectect inflate with right dict" test_right_dictionary,
|
||
|
|
testCase "handle trailing data" test_trailing_data,
|
||
|
|
testCase "multiple gzip members" test_multiple_members,
|
||
|
|
testCase "check small input chunks" test_small_chunks,
|
||
|
|
testCase "check empty input" test_empty,
|
||
|
|
testCase "check exception raised" test_exception
|
||
|
|
]
|
||
|
|
]
|
||
|
|
|
||
|
|
|
||
|
|
prop_decompress_after_compress :: Format
|
||
|
|
-> CompressParams
|
||
|
|
-> DecompressParams
|
||
|
|
-> Property
|
||
|
|
prop_decompress_after_compress w cp dp =
|
||
|
|
(w /= zlibFormat || decompressWindowBits dp >= compressWindowBits cp) &&
|
||
|
|
(decompressWindowBits dp > compressWindowBits cp) &&
|
||
|
|
decompressBufferSize dp > 0 && compressBufferSize cp > 0 ==>
|
||
|
|
liftM2 (==) (decompress w dp . compress w cp) id
|
||
|
|
|
||
|
|
|
||
|
|
prop_gziporzlib1 :: CompressParams
|
||
|
|
-> DecompressParams
|
||
|
|
-> Property
|
||
|
|
prop_gziporzlib1 cp dp =
|
||
|
|
decompressWindowBits dp > compressWindowBits cp &&
|
||
|
|
decompressBufferSize dp > 0 && compressBufferSize cp > 0 ==>
|
||
|
|
liftM2 (==) (decompress gzipOrZlibFormat dp . compress zlibFormat cp) id
|
||
|
|
|
||
|
|
|
||
|
|
prop_gziporzlib2 :: CompressParams
|
||
|
|
-> DecompressParams
|
||
|
|
-> Property
|
||
|
|
prop_gziporzlib2 cp dp =
|
||
|
|
decompressWindowBits dp >= compressWindowBits cp &&
|
||
|
|
decompressBufferSize dp > 0 && compressBufferSize cp > 0 ==>
|
||
|
|
liftM2 (==) (decompress gzipOrZlibFormat dp . compress gzipFormat cp) id
|
||
|
|
|
||
|
|
prop_gzip_concat :: CompressParams
|
||
|
|
-> DecompressParams
|
||
|
|
-> BL.ByteString
|
||
|
|
-> Property
|
||
|
|
prop_gzip_concat cp dp input =
|
||
|
|
decompressWindowBits dp >= compressWindowBits cp &&
|
||
|
|
decompressBufferSize dp > 0 && compressBufferSize cp > 0 ==>
|
||
|
|
let catComp = BL.concat (replicate 5 (compress gzipFormat cp input))
|
||
|
|
compCat = compress gzipFormat cp (BL.concat (replicate 5 input))
|
||
|
|
|
||
|
|
in decompress gzipFormat dp { decompressAllMembers = True } catComp
|
||
|
|
== decompress gzipFormat dp { decompressAllMembers = True } compCat
|
||
|
|
|
||
|
|
prop_multiple_members_boundary2 :: Property
|
||
|
|
prop_multiple_members_boundary2 =
|
||
|
|
forAll shortStrings $ \bs ->
|
||
|
|
all (\c -> decomp c == BL.append bs bs)
|
||
|
|
(twoChunkSplits (comp bs `BL.append` comp bs))
|
||
|
|
where
|
||
|
|
comp = compress gzipFormat defaultCompressParams
|
||
|
|
decomp = decompress gzipFormat defaultDecompressParams
|
||
|
|
|
||
|
|
shortStrings = fmap BL.pack $ listOf arbitrary
|
||
|
|
|
||
|
|
prop_multiple_members_boundary3 :: Property
|
||
|
|
prop_multiple_members_boundary3 =
|
||
|
|
forAll shortStrings $ \bs ->
|
||
|
|
all (\c -> decomp c == BL.append bs bs)
|
||
|
|
(threeChunkSplits (comp bs `BL.append` comp bs))
|
||
|
|
where
|
||
|
|
comp = compress gzipFormat defaultCompressParams
|
||
|
|
decomp = decompress gzipFormat defaultDecompressParams
|
||
|
|
|
||
|
|
shortStrings = sized $ \sz -> resize (sz `div` 10) $
|
||
|
|
fmap BL.pack $ listOf arbitrary
|
||
|
|
|
||
|
|
prop_truncated :: Format -> Property
|
||
|
|
prop_truncated format =
|
||
|
|
forAll shortStrings $ \bs ->
|
||
|
|
all (truncated decomp)
|
||
|
|
(init (BL.inits (comp bs)))
|
||
|
|
-- All the initial prefixes of a valid compressed stream should be detected
|
||
|
|
-- as truncated.
|
||
|
|
where
|
||
|
|
comp = compress format defaultCompressParams
|
||
|
|
decomp = decompressST format defaultDecompressParams
|
||
|
|
truncated :: (forall s. DecompressStream (ST s)) -> BL.ByteString -> Bool
|
||
|
|
truncated = foldDecompressStreamWithInput (\_ r -> r) (\_ -> False)
|
||
|
|
(\err -> case err of TruncatedInput -> True; _ -> False)
|
||
|
|
|
||
|
|
shortStrings = sized $ \sz -> resize (sz `div` 6) arbitrary
|
||
|
|
|
||
|
|
|
||
|
|
test_simple_gzip :: Assertion
|
||
|
|
test_simple_gzip =
|
||
|
|
withSampleData "hello.gz" $ \hnd ->
|
||
|
|
let decomp = decompressIO gzipFormat defaultDecompressParams
|
||
|
|
in assertDecompressOk hnd decomp
|
||
|
|
|
||
|
|
test_bad_crc :: Assertion
|
||
|
|
test_bad_crc =
|
||
|
|
withSampleData "bad-crc.gz" $ \hnd -> do
|
||
|
|
let decomp = decompressIO gzipFormat defaultDecompressParams
|
||
|
|
err <- assertDecompressError hnd decomp
|
||
|
|
msg <- assertDataFormatError err
|
||
|
|
msg @?= "incorrect data check"
|
||
|
|
|
||
|
|
test_non_gzip :: Assertion
|
||
|
|
test_non_gzip = do
|
||
|
|
withSampleData "not-gzip" $ \hnd -> do
|
||
|
|
let decomp = decompressIO gzipFormat defaultDecompressParams
|
||
|
|
err <- assertDecompressError hnd decomp
|
||
|
|
msg <- assertDataFormatError err
|
||
|
|
msg @?= "incorrect header check"
|
||
|
|
|
||
|
|
withSampleData "not-gzip" $ \hnd -> do
|
||
|
|
let decomp = decompressIO zlibFormat defaultDecompressParams
|
||
|
|
err <- assertDecompressError hnd decomp
|
||
|
|
msg <- assertDataFormatError err
|
||
|
|
msg @?= "incorrect header check"
|
||
|
|
|
||
|
|
withSampleData "not-gzip" $ \hnd -> do
|
||
|
|
let decomp = decompressIO rawFormat defaultDecompressParams
|
||
|
|
err <- assertDecompressError hnd decomp
|
||
|
|
msg <- assertDataFormatError err
|
||
|
|
msg @?= "invalid code lengths set"
|
||
|
|
|
||
|
|
withSampleData "not-gzip" $ \hnd -> do
|
||
|
|
let decomp = decompressIO gzipOrZlibFormat defaultDecompressParams
|
||
|
|
err <- assertDecompressError hnd decomp
|
||
|
|
msg <- assertDataFormatError err
|
||
|
|
msg @?= "incorrect header check"
|
||
|
|
|
||
|
|
test_custom_dict :: Assertion
|
||
|
|
test_custom_dict =
|
||
|
|
withSampleData "custom-dict.zlib" $ \hnd -> do
|
||
|
|
let decomp = decompressIO zlibFormat defaultDecompressParams
|
||
|
|
err <- assertDecompressError hnd decomp
|
||
|
|
err @?= DictionaryRequired
|
||
|
|
|
||
|
|
test_wrong_dictionary :: Assertion
|
||
|
|
test_wrong_dictionary = do
|
||
|
|
withSampleData "custom-dict.zlib" $ \hnd -> do
|
||
|
|
let decomp = decompressIO zlibFormat defaultDecompressParams {
|
||
|
|
decompressDictionary = -- wrong dict!
|
||
|
|
Just (BS.pack [65,66,67])
|
||
|
|
}
|
||
|
|
|
||
|
|
err <- assertDecompressError hnd decomp
|
||
|
|
err @?= DictionaryMismatch
|
||
|
|
|
||
|
|
test_right_dictionary :: Assertion
|
||
|
|
test_right_dictionary = do
|
||
|
|
withSampleData "custom-dict.zlib" $ \hnd -> do
|
||
|
|
dict <- readSampleData "custom-dict.zlib-dict"
|
||
|
|
let decomp = decompressIO zlibFormat defaultDecompressParams {
|
||
|
|
decompressDictionary =
|
||
|
|
Just (toStrict dict)
|
||
|
|
}
|
||
|
|
assertDecompressOk hnd decomp
|
||
|
|
|
||
|
|
test_trailing_data :: Assertion
|
||
|
|
test_trailing_data =
|
||
|
|
withSampleData "two-files.gz" $ \hnd -> do
|
||
|
|
let decomp = decompressIO gzipFormat defaultDecompressParams {
|
||
|
|
decompressAllMembers = False
|
||
|
|
}
|
||
|
|
chunks <- assertDecompressOkChunks hnd decomp
|
||
|
|
case chunks of
|
||
|
|
[chunk] -> chunk @?= BS.Char8.pack "Test 1"
|
||
|
|
_ -> assertFailure "expected single chunk"
|
||
|
|
|
||
|
|
test_multiple_members :: Assertion
|
||
|
|
test_multiple_members =
|
||
|
|
withSampleData "two-files.gz" $ \hnd -> do
|
||
|
|
let decomp = decompressIO gzipFormat defaultDecompressParams {
|
||
|
|
decompressAllMembers = True
|
||
|
|
}
|
||
|
|
chunks <- assertDecompressOkChunks hnd decomp
|
||
|
|
case chunks of
|
||
|
|
[chunk1,
|
||
|
|
chunk2] -> do chunk1 @?= BS.Char8.pack "Test 1"
|
||
|
|
chunk2 @?= BS.Char8.pack "Test 2"
|
||
|
|
_ -> assertFailure "expected two chunks"
|
||
|
|
|
||
|
|
test_small_chunks :: Assertion
|
||
|
|
test_small_chunks = do
|
||
|
|
uncompressedFile <- readSampleData "not-gzip"
|
||
|
|
GZip.compress (smallChunks uncompressedFile) @?= GZip.compress uncompressedFile
|
||
|
|
Zlib.compress (smallChunks uncompressedFile) @?= Zlib.compress uncompressedFile
|
||
|
|
Raw.compress (smallChunks uncompressedFile) @?= Raw.compress uncompressedFile
|
||
|
|
|
||
|
|
GZip.decompress (smallChunks (GZip.compress uncompressedFile)) @?= uncompressedFile
|
||
|
|
Zlib.decompress (smallChunks (Zlib.compress uncompressedFile)) @?= uncompressedFile
|
||
|
|
Raw.decompress (smallChunks (Raw.compress uncompressedFile)) @?= uncompressedFile
|
||
|
|
|
||
|
|
compressedFile <- readSampleData "hello.gz"
|
||
|
|
(GZip.decompress . smallChunks) compressedFile @?= GZip.decompress compressedFile
|
||
|
|
|
||
|
|
test_empty :: Assertion
|
||
|
|
test_empty = do
|
||
|
|
-- Regression test to make sure we only ask for input once in the case of
|
||
|
|
-- initially empty input. We previously asked for input twice before
|
||
|
|
-- returning the error.
|
||
|
|
let decomp = decompressIO zlibFormat defaultDecompressParams
|
||
|
|
case decomp of
|
||
|
|
DecompressInputRequired next -> do
|
||
|
|
decomp' <- next BS.empty
|
||
|
|
case decomp' of
|
||
|
|
DecompressStreamError TruncatedInput -> return ()
|
||
|
|
_ -> assertFailure "expected truncated error"
|
||
|
|
|
||
|
|
_ -> assertFailure "expected input"
|
||
|
|
|
||
|
|
test_exception :: Assertion
|
||
|
|
test_exception =
|
||
|
|
(do
|
||
|
|
compressedFile <- readSampleData "bad-crc.gz"
|
||
|
|
_ <- evaluate (BL.length (GZip.decompress compressedFile))
|
||
|
|
assertFailure "expected exception")
|
||
|
|
|
||
|
|
`catch` \err -> do
|
||
|
|
msg <- assertDataFormatError err
|
||
|
|
msg @?= "incorrect data check"
|
||
|
|
|
||
|
|
toStrict :: BL.ByteString -> BS.ByteString
|
||
|
|
#if MIN_VERSION_bytestring(0,10,0)
|
||
|
|
toStrict = BL.toStrict
|
||
|
|
#else
|
||
|
|
toStrict = BS.concat . BL.toChunks
|
||
|
|
#endif
|
||
|
|
|
||
|
|
-----------------------
|
||
|
|
-- Chunk boundary utils
|
||
|
|
|
||
|
|
smallChunks :: BL.ByteString -> BL.ByteString
|
||
|
|
smallChunks = BL.fromChunks . map (\c -> BS.pack [c]) . BL.unpack
|
||
|
|
|
||
|
|
twoChunkSplits :: BL.ByteString -> [BL.ByteString]
|
||
|
|
twoChunkSplits bs = zipWith (\a b -> BL.fromChunks [a,b]) (BS.inits sbs) (BS.tails sbs)
|
||
|
|
where
|
||
|
|
sbs = toStrict bs
|
||
|
|
|
||
|
|
threeChunkSplits :: BL.ByteString -> [BL.ByteString]
|
||
|
|
threeChunkSplits bs =
|
||
|
|
[ BL.fromChunks [a,b,c]
|
||
|
|
| (a,x) <- zip (BS.inits sbs) (BS.tails sbs)
|
||
|
|
, (b,c) <- zip (BS.inits x) (BS.tails x) ]
|
||
|
|
where
|
||
|
|
sbs = toStrict bs
|
||
|
|
|
||
|
|
--------------
|
||
|
|
-- HUnit Utils
|
||
|
|
|
||
|
|
readSampleData :: FilePath -> IO BL.ByteString
|
||
|
|
readSampleData file = BL.readFile ("test/data/" ++ file)
|
||
|
|
|
||
|
|
withSampleData :: FilePath -> (Handle -> IO a) -> IO a
|
||
|
|
withSampleData file = withFile ("test/data/" ++ file) ReadMode
|
||
|
|
|
||
|
|
expected :: String -> String -> IO a
|
||
|
|
expected e g = assertFailure ("expected: " ++ e ++ "\nbut got: " ++ g)
|
||
|
|
>> fail ""
|
||
|
|
|
||
|
|
assertDecompressOk :: Handle -> DecompressStream IO -> Assertion
|
||
|
|
assertDecompressOk hnd =
|
||
|
|
foldDecompressStream
|
||
|
|
(BS.hGet hnd 4000 >>=)
|
||
|
|
(\_ r -> r)
|
||
|
|
(\_ -> return ())
|
||
|
|
(\err -> expected "decompress ok" (show err))
|
||
|
|
|
||
|
|
assertDecompressOkChunks :: Handle -> DecompressStream IO -> IO [BS.ByteString]
|
||
|
|
assertDecompressOkChunks hnd =
|
||
|
|
foldDecompressStream
|
||
|
|
(BS.hGet hnd 4000 >>=)
|
||
|
|
(\chunk -> liftM (chunk:))
|
||
|
|
(\_ -> return [])
|
||
|
|
(\err -> expected "decompress ok" (show err))
|
||
|
|
|
||
|
|
assertDecompressError :: Handle -> DecompressStream IO -> IO DecompressError
|
||
|
|
assertDecompressError hnd =
|
||
|
|
foldDecompressStream
|
||
|
|
(BS.hGet hnd 4000 >>=)
|
||
|
|
(\_ r -> r)
|
||
|
|
(\_ -> expected "StreamError" "StreamEnd")
|
||
|
|
return
|
||
|
|
|
||
|
|
assertDataFormatError :: DecompressError -> IO String
|
||
|
|
assertDataFormatError (DataFormatError detail) = return detail
|
||
|
|
assertDataFormatError _ = assertFailure "expected DataError"
|
||
|
|
>> return ""
|