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