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