1{-# LANGUAGE CPP #-} 2{-# LANGUAGE RankNTypes #-} 3module Main where 4 5import Codec.Compression.Zlib.Internal 6import qualified Codec.Compression.Zlib as Zlib 7import qualified Codec.Compression.GZip as GZip 8import qualified Codec.Compression.Zlib.Raw as Raw 9 10import Test.Codec.Compression.Zlib.Internal () 11import Test.Codec.Compression.Zlib.Stream () 12 13import Test.QuickCheck 14import Test.Tasty 15import Test.Tasty.QuickCheck 16import Test.Tasty.HUnit 17import Utils () 18 19import Control.Monad 20import Control.Monad.ST.Lazy (ST) 21import Control.Exception 22import qualified Data.ByteString.Char8 as BS.Char8 23import qualified Data.ByteString.Lazy as BL 24import qualified Data.ByteString as BS 25import System.IO 26#if !(MIN_VERSION_base(4,6,0)) 27import Prelude hiding (catch) 28#endif 29 30 31main :: IO () 32main = defaultMain $ 33 testGroup "zlib tests" [ 34 testGroup "property tests" [ 35 testProperty "decompress . compress = id (standard)" prop_decompress_after_compress, 36 testProperty "decompress . compress = id (Zlib -> GZipOrZLib)" prop_gziporzlib1, 37 testProperty "decompress . compress = id (GZip -> GZipOrZlib)" prop_gziporzlib2, 38 testProperty "concatenated gzip members" prop_gzip_concat, 39 testProperty "multiple gzip members, boundaries (all 2-chunks)" prop_multiple_members_boundary2, 40 testProperty "multiple gzip members, boundaries (all 3-chunks)" prop_multiple_members_boundary3, 41 testProperty "prefixes of valid stream detected as truncated" prop_truncated 42 ], 43 testGroup "unit tests" [ 44 testCase "simple gzip case" test_simple_gzip, 45 testCase "detect bad crc" test_bad_crc, 46 testCase "detect non-gzip" test_non_gzip, 47 testCase "detect custom dictionary" test_custom_dict, 48 testCase "dectect inflate with wrong dict" test_wrong_dictionary, 49 testCase "dectect inflate with right dict" test_right_dictionary, 50 testCase "handle trailing data" test_trailing_data, 51 testCase "multiple gzip members" test_multiple_members, 52 testCase "check small input chunks" test_small_chunks, 53 testCase "check empty input" test_empty, 54 testCase "check exception raised" test_exception 55 ] 56 ] 57 58 59prop_decompress_after_compress :: Format 60 -> CompressParams 61 -> DecompressParams 62 -> Property 63prop_decompress_after_compress w cp dp = 64 (w /= zlibFormat || decompressWindowBits dp >= compressWindowBits cp) && 65 (decompressWindowBits dp > compressWindowBits cp) && 66 decompressBufferSize dp > 0 && compressBufferSize cp > 0 ==> 67 liftM2 (==) (decompress w dp . compress w cp) id 68 69 70prop_gziporzlib1 :: CompressParams 71 -> DecompressParams 72 -> Property 73prop_gziporzlib1 cp dp = 74 decompressWindowBits dp > compressWindowBits cp && 75 decompressBufferSize dp > 0 && compressBufferSize cp > 0 ==> 76 liftM2 (==) (decompress gzipOrZlibFormat dp . compress zlibFormat cp) id 77 78 79prop_gziporzlib2 :: CompressParams 80 -> DecompressParams 81 -> Property 82prop_gziporzlib2 cp dp = 83 decompressWindowBits dp >= compressWindowBits cp && 84 decompressBufferSize dp > 0 && compressBufferSize cp > 0 ==> 85 liftM2 (==) (decompress gzipOrZlibFormat dp . compress gzipFormat cp) id 86 87prop_gzip_concat :: CompressParams 88 -> DecompressParams 89 -> BL.ByteString 90 -> Property 91prop_gzip_concat cp dp input = 92 decompressWindowBits dp >= compressWindowBits cp && 93 decompressBufferSize dp > 0 && compressBufferSize cp > 0 ==> 94 let catComp = BL.concat (replicate 5 (compress gzipFormat cp input)) 95 compCat = compress gzipFormat cp (BL.concat (replicate 5 input)) 96 97 in decompress gzipFormat dp { decompressAllMembers = True } catComp 98 == decompress gzipFormat dp { decompressAllMembers = True } compCat 99 100prop_multiple_members_boundary2 :: Property 101prop_multiple_members_boundary2 = 102 forAll shortStrings $ \bs -> 103 all (\c -> decomp c == BL.append bs bs) 104 (twoChunkSplits (comp bs `BL.append` comp bs)) 105 where 106 comp = compress gzipFormat defaultCompressParams 107 decomp = decompress gzipFormat defaultDecompressParams 108 109 shortStrings = fmap BL.pack $ listOf arbitrary 110 111prop_multiple_members_boundary3 :: Property 112prop_multiple_members_boundary3 = 113 forAll shortStrings $ \bs -> 114 all (\c -> decomp c == BL.append bs bs) 115 (threeChunkSplits (comp bs `BL.append` comp bs)) 116 where 117 comp = compress gzipFormat defaultCompressParams 118 decomp = decompress gzipFormat defaultDecompressParams 119 120 shortStrings = sized $ \sz -> resize (sz `div` 10) $ 121 fmap BL.pack $ listOf arbitrary 122 123prop_truncated :: Format -> Property 124prop_truncated format = 125 forAll shortStrings $ \bs -> 126 all (truncated decomp) 127 (init (BL.inits (comp bs))) 128 -- All the initial prefixes of a valid compressed stream should be detected 129 -- as truncated. 130 where 131 comp = compress format defaultCompressParams 132 decomp = decompressST format defaultDecompressParams 133 truncated :: (forall s. DecompressStream (ST s)) -> BL.ByteString -> Bool 134 truncated = foldDecompressStreamWithInput (\_ r -> r) (\_ -> False) 135 (\err -> case err of TruncatedInput -> True; _ -> False) 136 137 shortStrings = sized $ \sz -> resize (sz `div` 6) arbitrary 138 139 140test_simple_gzip :: Assertion 141test_simple_gzip = 142 withSampleData "hello.gz" $ \hnd -> 143 let decomp = decompressIO gzipFormat defaultDecompressParams 144 in assertDecompressOk hnd decomp 145 146test_bad_crc :: Assertion 147test_bad_crc = 148 withSampleData "bad-crc.gz" $ \hnd -> do 149 let decomp = decompressIO gzipFormat defaultDecompressParams 150 err <- assertDecompressError hnd decomp 151 msg <- assertDataFormatError err 152 msg @?= "incorrect data check" 153 154test_non_gzip :: Assertion 155test_non_gzip = do 156 withSampleData "not-gzip" $ \hnd -> do 157 let decomp = decompressIO gzipFormat defaultDecompressParams 158 err <- assertDecompressError hnd decomp 159 msg <- assertDataFormatError err 160 msg @?= "incorrect header check" 161 162 withSampleData "not-gzip" $ \hnd -> do 163 let decomp = decompressIO zlibFormat defaultDecompressParams 164 err <- assertDecompressError hnd decomp 165 msg <- assertDataFormatError err 166 msg @?= "incorrect header check" 167 168 withSampleData "not-gzip" $ \hnd -> do 169 let decomp = decompressIO rawFormat defaultDecompressParams 170 err <- assertDecompressError hnd decomp 171 msg <- assertDataFormatError err 172 msg @?= "invalid code lengths set" 173 174 withSampleData "not-gzip" $ \hnd -> do 175 let decomp = decompressIO gzipOrZlibFormat defaultDecompressParams 176 err <- assertDecompressError hnd decomp 177 msg <- assertDataFormatError err 178 msg @?= "incorrect header check" 179 180test_custom_dict :: Assertion 181test_custom_dict = 182 withSampleData "custom-dict.zlib" $ \hnd -> do 183 let decomp = decompressIO zlibFormat defaultDecompressParams 184 err <- assertDecompressError hnd decomp 185 err @?= DictionaryRequired 186 187test_wrong_dictionary :: Assertion 188test_wrong_dictionary = do 189 withSampleData "custom-dict.zlib" $ \hnd -> do 190 let decomp = decompressIO zlibFormat defaultDecompressParams { 191 decompressDictionary = -- wrong dict! 192 Just (BS.pack [65,66,67]) 193 } 194 195 err <- assertDecompressError hnd decomp 196 err @?= DictionaryMismatch 197 198test_right_dictionary :: Assertion 199test_right_dictionary = do 200 withSampleData "custom-dict.zlib" $ \hnd -> do 201 dict <- readSampleData "custom-dict.zlib-dict" 202 let decomp = decompressIO zlibFormat defaultDecompressParams { 203 decompressDictionary = 204 Just (toStrict dict) 205 } 206 assertDecompressOk hnd decomp 207 208test_trailing_data :: Assertion 209test_trailing_data = 210 withSampleData "two-files.gz" $ \hnd -> do 211 let decomp = decompressIO gzipFormat defaultDecompressParams { 212 decompressAllMembers = False 213 } 214 chunks <- assertDecompressOkChunks hnd decomp 215 case chunks of 216 [chunk] -> chunk @?= BS.Char8.pack "Test 1" 217 _ -> assertFailure "expected single chunk" 218 219test_multiple_members :: Assertion 220test_multiple_members = 221 withSampleData "two-files.gz" $ \hnd -> do 222 let decomp = decompressIO gzipFormat defaultDecompressParams { 223 decompressAllMembers = True 224 } 225 chunks <- assertDecompressOkChunks hnd decomp 226 case chunks of 227 [chunk1, 228 chunk2] -> do chunk1 @?= BS.Char8.pack "Test 1" 229 chunk2 @?= BS.Char8.pack "Test 2" 230 _ -> assertFailure "expected two chunks" 231 232test_small_chunks :: Assertion 233test_small_chunks = do 234 uncompressedFile <- readSampleData "not-gzip" 235 GZip.compress (smallChunks uncompressedFile) @?= GZip.compress uncompressedFile 236 Zlib.compress (smallChunks uncompressedFile) @?= Zlib.compress uncompressedFile 237 Raw.compress (smallChunks uncompressedFile) @?= Raw.compress uncompressedFile 238 239 GZip.decompress (smallChunks (GZip.compress uncompressedFile)) @?= uncompressedFile 240 Zlib.decompress (smallChunks (Zlib.compress uncompressedFile)) @?= uncompressedFile 241 Raw.decompress (smallChunks (Raw.compress uncompressedFile)) @?= uncompressedFile 242 243 compressedFile <- readSampleData "hello.gz" 244 (GZip.decompress . smallChunks) compressedFile @?= GZip.decompress compressedFile 245 246test_empty :: Assertion 247test_empty = do 248 -- Regression test to make sure we only ask for input once in the case of 249 -- initially empty input. We previously asked for input twice before 250 -- returning the error. 251 let decomp = decompressIO zlibFormat defaultDecompressParams 252 case decomp of 253 DecompressInputRequired next -> do 254 decomp' <- next BS.empty 255 case decomp' of 256 DecompressStreamError TruncatedInput -> return () 257 _ -> assertFailure "expected truncated error" 258 259 _ -> assertFailure "expected input" 260 261test_exception :: Assertion 262test_exception = 263 (do 264 compressedFile <- readSampleData "bad-crc.gz" 265 _ <- evaluate (BL.length (GZip.decompress compressedFile)) 266 assertFailure "expected exception") 267 268 `catch` \err -> do 269 msg <- assertDataFormatError err 270 msg @?= "incorrect data check" 271 272toStrict :: BL.ByteString -> BS.ByteString 273#if MIN_VERSION_bytestring(0,10,0) 274toStrict = BL.toStrict 275#else 276toStrict = BS.concat . BL.toChunks 277#endif 278 279----------------------- 280-- Chunk boundary utils 281 282smallChunks :: BL.ByteString -> BL.ByteString 283smallChunks = BL.fromChunks . map (\c -> BS.pack [c]) . BL.unpack 284 285twoChunkSplits :: BL.ByteString -> [BL.ByteString] 286twoChunkSplits bs = zipWith (\a b -> BL.fromChunks [a,b]) (BS.inits sbs) (BS.tails sbs) 287 where 288 sbs = toStrict bs 289 290threeChunkSplits :: BL.ByteString -> [BL.ByteString] 291threeChunkSplits bs = 292 [ BL.fromChunks [a,b,c] 293 | (a,x) <- zip (BS.inits sbs) (BS.tails sbs) 294 , (b,c) <- zip (BS.inits x) (BS.tails x) ] 295 where 296 sbs = toStrict bs 297 298-------------- 299-- HUnit Utils 300 301readSampleData :: FilePath -> IO BL.ByteString 302readSampleData file = BL.readFile ("test/data/" ++ file) 303 304withSampleData :: FilePath -> (Handle -> IO a) -> IO a 305withSampleData file = withFile ("test/data/" ++ file) ReadMode 306 307expected :: String -> String -> IO a 308expected e g = assertFailure ("expected: " ++ e ++ "\nbut got: " ++ g) 309 >> fail "" 310 311assertDecompressOk :: Handle -> DecompressStream IO -> Assertion 312assertDecompressOk hnd = 313 foldDecompressStream 314 (BS.hGet hnd 4000 >>=) 315 (\_ r -> r) 316 (\_ -> return ()) 317 (\err -> expected "decompress ok" (show err)) 318 319assertDecompressOkChunks :: Handle -> DecompressStream IO -> IO [BS.ByteString] 320assertDecompressOkChunks hnd = 321 foldDecompressStream 322 (BS.hGet hnd 4000 >>=) 323 (\chunk -> liftM (chunk:)) 324 (\_ -> return []) 325 (\err -> expected "decompress ok" (show err)) 326 327assertDecompressError :: Handle -> DecompressStream IO -> IO DecompressError 328assertDecompressError hnd = 329 foldDecompressStream 330 (BS.hGet hnd 4000 >>=) 331 (\_ r -> r) 332 (\_ -> expected "StreamError" "StreamEnd") 333 return 334 335assertDataFormatError :: DecompressError -> IO String 336assertDataFormatError (DataFormatError detail) = return detail 337assertDataFormatError _ = assertFailure "expected DataError" 338 >> return "" 339