Correct maybeDecompress

cabal-install/Distribution/Client/GZipUtils.hs

@@ -50,7 +50,7 @@ maybeDecompress bytes = runST (go bytes decompressor)
     -- at the beginning of the gzip header.  (not an option for zlib, though.)
     go :: Monad m => ByteString -> DecompressStream m -> m ByteString
     go cs (DecompressOutputAvailable bs k) = liftM (Chunk bs) $ go' cs =<< k
-    go _  (DecompressStreamEnd       bs  ) = return $ Chunk bs Empty
+    go _  (DecompressStreamEnd       _bs ) = return Empty
     go _  (DecompressStreamError _err    ) = return bytes
     go cs (DecompressInputRequired      k) = go cs' =<< k c
       where
@@ -61,7 +61,7 @@ maybeDecompress bytes = runST (go bytes decompressor)
     -- TODO: We could (and should) avoid these pure exceptions.
     go' :: Monad m => ByteString -> DecompressStream m -> m ByteString
     go' cs (DecompressOutputAvailable bs k) = liftM (Chunk bs) $ go' cs =<< k
-    go' _  (DecompressStreamEnd       bs  ) = return $ Chunk bs Empty
+    go' _  (DecompressStreamEnd       _bs ) = return Empty
     go' _  (DecompressStreamError err     ) = throw err
     go' cs (DecompressInputRequired      k) = go' cs' =<< k c
       where

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

@@ -7,15 +7,22 @@ import Codec.Compression.Zlib          as Zlib
 import Control.Exception.Base                  (evaluate)
 import Control.Exception                       (try, SomeException)
 import Control.Monad                           (void)
-import Data.ByteString.Lazy.Char8     as BS    (pack, init, length)
+import Data.ByteString                as BS    (null)
+import Data.ByteString.Lazy           as BSL   (pack, toChunks)
+import Data.ByteString.Lazy.Char8     as BSLL  (pack, init, length)
 import Data.Monoid                             ((<>))
 import Distribution.Client.GZipUtils           (maybeDecompress)
+import Data.Word                               (Word8)
 
 import Test.Tasty
 import Test.Tasty.HUnit
+import Test.Tasty.QuickCheck
 
 tests :: [TestTree]
 tests = [ testCase "maybeDecompress" maybeDecompressUnitTest
+        , testProperty "decompress plain" prop_maybeDecompress_plain
+        , testProperty "decompress zlib"  prop_maybeDecompress_zlib
+        , testProperty "decompress gzip"  prop_maybeDecompress_gzip
         ]
 
 maybeDecompressUnitTest :: Assertion
@@ -25,14 +32,29 @@ maybeDecompressUnitTest =
      >> 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"        (Prelude.all (not . BS.null) . BSL.toChunks . maybeDecompress $ compressedZlib)
      >> (runBrokenStream >>= assertBool "decompress broken stream" . isLeft)
   where
-    original = BS.pack "original uncompressed input"
+    original = BSLL.pack "original uncompressed input"
     compressedZlib = Zlib.compress original
     compressedGZip = GZip.compress original
 
     runBrokenStream :: IO (Either SomeException ())
-    runBrokenStream = try . void . evaluate . BS.length $ maybeDecompress (BS.init compressedZlib <> BS.pack "*")
+    runBrokenStream = try . void . evaluate . BSLL.length $ maybeDecompress (BSLL.init compressedZlib <> BSLL.pack "*")
+
+prop_maybeDecompress_plain :: [Word8] -> Property
+prop_maybeDecompress_plain ws = property $ maybeDecompress original == original
+  where original = BSL.pack ws
+
+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