summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNathanHowell <>2017-08-12 23:39:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-08-12 23:39:00 (GMT)
commit19f7ee5ee922450d03d31b2564de96f487d3dad7 (patch)
treeff0954f388b901fc4cdc6d333712030a54e439ed
parentea44ac4791eba1b9317af353adb1a2963697be7b (diff)
version 1.1.3.21.1.3.2
-rw-r--r--lzma-conduit.cabal2
-rw-r--r--src/Data/Conduit/Lzma.hs21
-rw-r--r--tests/Main.hs23
3 files changed, 30 insertions, 16 deletions
diff --git a/lzma-conduit.cabal b/lzma-conduit.cabal
index 07e4059..197ee45 100644
--- a/lzma-conduit.cabal
+++ b/lzma-conduit.cabal
@@ -1,5 +1,5 @@
name: lzma-conduit
-version: 1.1.3.1
+version: 1.1.3.2
synopsis: Conduit interface for lzma/xz compression.
description:
High level bindings to xz-utils.
diff --git a/src/Data/Conduit/Lzma.hs b/src/Data/Conduit/Lzma.hs
index f5f6c21..8fb65cf 100644
--- a/src/Data/Conduit/Lzma.hs
+++ b/src/Data/Conduit/Lzma.hs
@@ -10,6 +10,7 @@ import Control.Monad.Trans.Resource
import Data.ByteString (ByteString)
import Data.ByteString.Internal (ByteString(PS))
import Data.Conduit
+import Data.Maybe (fromMaybe)
import Foreign
import Foreign.C.Types (CSize, CUChar)
@@ -67,7 +68,7 @@ initStream name fun = do
ret <- fun streamPtr
if ret == c'LZMA_OK
then return (streamPtr, buffer)
- else fail $ name ++ " failed: " ++ prettyRet ret
+ else monadThrow $ userError $ name ++ " failed: " ++ prettyRet ret
easyEncoder
:: Maybe Int
@@ -98,7 +99,7 @@ decompress memlimit = do
(\ (streamPtr, buffer) -> c'lzma_end streamPtr >> free streamPtr >> free buffer)
codeEnum streamKey streamPtr input
- Nothing -> return ()
+ Nothing -> monadThrow $ userError $ "decompress: invalid empty input"
-- | Compress a 'ByteString' into a xz container stream.
compress
@@ -107,14 +108,12 @@ compress
-> Conduit ByteString m ByteString
compress level = do
mval <- await
- case mval of
- Just input -> do
- (streamKey, (streamPtr, _)) <- lift $ allocate
- (initStream "lzma_easy_encoder" (easyEncoder level))
- (\ (streamPtr, buffer) -> c'lzma_end streamPtr >> free streamPtr >> free buffer)
- codeEnum streamKey streamPtr input
-
- Nothing -> return ()
+ process $ fromMaybe B.empty mval
+ where process input = do
+ (streamKey, (streamPtr, _)) <- lift $ allocate
+ (initStream "lzma_easy_encoder" (easyEncoder level))
+ (\ (streamPtr, buffer) -> c'lzma_end streamPtr >> free streamPtr >> free buffer)
+ codeEnum streamKey streamPtr input
lzmaConduit
:: (MonadResource m)
@@ -196,7 +195,7 @@ codeStep streamKey inputKey streamPtr action status availIn availOut
ret <- liftIO $ c'lzma_code streamPtr action
if ret == c'LZMA_OK || ret == c'LZMA_STREAM_END
then buildChunks streamKey inputKey streamPtr action ret
- else fail $ "lzma_code failed: " ++ prettyRet ret
+ else monadThrow $ userError $ "lzma_code failed: " ++ prettyRet ret
-- nothing to do here
| otherwise = do
diff --git a/tests/Main.hs b/tests/Main.hs
index 46e494d..f6e75ab 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -8,9 +8,11 @@ import Control.Monad.Trans.Resource
import qualified Data.ByteString as B
import qualified Data.Conduit as C
import qualified Data.Conduit.List as Cl
+import Data.Either (isLeft)
import Data.List
import Data.Word
import Data.Conduit.Lzma
+import System.IO.Error (tryIOError)
main = defaultMain tests
@@ -28,6 +30,7 @@ compressTests =
decompressTests =
[ testProperty "decompressRandom" prop_decompressRandom
, testProperty "decompressCorrupt" prop_decompressCorrupt
+ , testProperty "decompressEmpty" prop_decompressEmpty
]
chainedTests =
@@ -69,13 +72,15 @@ prop_compressThenDecompress = monadicIO . forAllM someBigString $ \ str -> do
return $ str == B.concat str'
prop_decompressRandom :: Property
-prop_decompressRandom = expectFailure . monadicIO . forAllM someBigString $ \ str -> do
+prop_decompressRandom = monadicIO . forAllM someBigString $ \ str -> do
header <- run . runResourceT $ Cl.sourceList [] C.$$ compress Nothing C.=$= Cl.consume
let blob = header ++ [str]
- run $ runResourceT $ Cl.sourceList blob C.$$ decompress Nothing C.=$= Cl.sinkNull
+ ioErrorE <- run $
+ tryIOError (runResourceT $ Cl.sourceList blob C.$$ decompress Nothing C.=$= Cl.sinkNull)
+ assert $ isLeft ioErrorE
prop_decompressCorrupt :: Property
-prop_decompressCorrupt = expectFailure . monadicIO . forAllM someBigString $ \ str -> do
+prop_decompressCorrupt = monadicIO . forAllM someBigString $ \ str -> do
header <- run . runResourceT $ Cl.sourceList [] C.$$ compress Nothing C.=$= Cl.consume
let header' = B.concat header
randVal <- pick $ elements [0..255::Word8]
@@ -83,4 +88,14 @@ prop_decompressCorrupt = expectFailure . monadicIO . forAllM someBigString $ \ s
let (left, right) = B.splitAt randIdx header'
updated = left `B.append` (randVal `B.cons` B.tail right)
blob = [updated, str]
- run $ runResourceT $ Cl.sourceList blob C.$$ decompress Nothing C.=$= Cl.sinkNull
+ ioErrorE <- run $
+ tryIOError (runResourceT $ Cl.sourceList blob C.$$ decompress Nothing C.=$= Cl.sinkNull)
+ assert $ isLeft ioErrorE
+
+prop_decompressEmpty :: Property
+prop_decompressEmpty = monadicIO . forAllM someBigString $ \ str -> do
+ count <- pick $ elements [0..10]
+ let blob = replicate count B.empty
+ ioErrorE <- run $
+ tryIOError (runResourceT $ Cl.sourceList blob C.$$ decompress Nothing C.=$= Cl.sinkNull)
+ assert $ isLeft ioErrorE