1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
module UnitTests.Distribution.Client.GZipUtils
( tests
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import Codec.Compression.GZip as GZip
import Codec.Compression.Zlib as Zlib
import Control.Exception (try)
import Data.ByteString as BS (null)
import Data.ByteString.Lazy as BSL (pack, toChunks)
import Data.ByteString.Lazy.Char8 as BSLL (init, length, pack)
import Distribution.Client.GZipUtils (maybeDecompress)
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
tests :: [TestTree]
tests =
[ testCase "maybeDecompress" maybeDecompressUnitTest
, -- "decompress plain" property is non-trivial to state,
-- maybeDecompress returns input bytestring only if error occurs right at the beginning of the decompression process
-- generating such input would essentially duplicate maybeDecompress implementation
testProperty "decompress zlib" prop_maybeDecompress_zlib
, testProperty "decompress gzip" prop_maybeDecompress_gzip
]
maybeDecompressUnitTest :: Assertion
maybeDecompressUnitTest =
assertBool "decompress plain" (maybeDecompress original == original)
>> assertBool "decompress zlib (with show)" (show (maybeDecompress compressedZlib) == show original)
>> assertBool "decompress gzip (with show)" (show (maybeDecompress compressedGZip) == show original)
>> assertBool "decompress zlib" (maybeDecompress compressedZlib == original)
>> assertBool "decompress gzip" (maybeDecompress compressedGZip == original)
>> assertBool "have no empty chunks" (all (not . BS.null) . BSL.toChunks . maybeDecompress $ compressedZlib)
>> (runBrokenStream >>= assertBool "decompress broken stream" . isLeft)
where
original = BSLL.pack "original uncompressed input"
compressedZlib = Zlib.compress original
compressedGZip = GZip.compress original
runBrokenStream :: IO (Either SomeException ())
runBrokenStream = try . void . evaluate . BSLL.length $ maybeDecompress (BSLL.init compressedZlib <> BSLL.pack "*")
prop_maybeDecompress_zlib :: [Word8] -> Property
prop_maybeDecompress_zlib ws = property $ maybeDecompress compressedZlib === original
where
original = BSL.pack ws
compressedZlib = Zlib.compress original
prop_maybeDecompress_gzip :: [Word8] -> Property
prop_maybeDecompress_gzip ws = property $ maybeDecompress compressedGZip === original
where
original = BSL.pack ws
compressedGZip = GZip.compress original
-- (Only available from "Data.Either" since 7.8.)
isLeft :: Either a b -> Bool
isLeft (Right _) = False
isLeft (Left _) = True
|
