cabal-install/tests/UnitTests/Distribution/Client/GZipUtils.hs

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