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