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