From fd64fce1887a4632ad7f5b483234902b26f8e894 Mon Sep 17 00:00:00 2001
From: Oleg Grenrus <oleg.grenrus@iki.fi>
Date: Wed, 24 Jun 2015 14:43:56 +0300
Subject: [PATCH] Correct maybeDecompress
---
.../Distribution/Client/GZipUtils.hs | 4 +--
.../Distribution/Client/GZipUtils.hs | 28 +++++++++++++++++--
2 files changed, 27 insertions(+), 5 deletions(-)
diff --git a/cabal-install/Distribution/Client/GZipUtils.hs b/cabal-install/Distribution/Client/GZipUtils.hs
index 0abc463c21..f5d688faf5 100644
--- a/cabal-install/Distribution/Client/GZipUtils.hs
+++ b/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
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/GZipUtils.hs b/cabal-install/tests/UnitTests/Distribution/Client/GZipUtils.hs
index 5ac14fe362..19808233db 100644
--- a/cabal-install/tests/UnitTests/Distribution/Client/GZipUtils.hs
+++ b/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
--
GitLab