conduit-algorithms 0.0.13.0 → 0.0.14.0

raw patch · 7 files changed

+239/−14 lines, 7 filesdep +lzmadep −lzma-conduitPVP ok

version bump matches the API change (PVP)

Dependencies added: lzma

Dependencies removed: lzma-conduit

API changes (from Hackage documentation)

Files

• ChangeLog +5/−0
• Data/Conduit/Algorithms/Async.hs +1/−1
• Data/Conduit/Lzma2.hs +105/−0
• README.md +2/−0
• conduit-algorithms.cabal +11/−11
• tests/TestLZMA.hs +108/−0
• tests/Tests.hs +7/−2

@@ -1,3 +1,8 @@+Version 0.0.14.0 2024-02-16 by luispedro+	* Data.Conduit.Lzma2: Incorporate Data.Conduit.Lzma2 (adapted from+	lzma-conduit) instead of using the external lzma-conduit package as that+	is no longer maintained.+ Version 0.0.13.0 2022-08-01 by luispedro 	* Support non-default values for compression level in more compression 	formats

@@ -47,7 +47,7 @@ import qualified Data.Conduit.TQueue as CA import qualified Data.Conduit.List as CL import qualified Data.Conduit.Zlib as CZ-import qualified Data.Conduit.Lzma as CX+import qualified Data.Conduit.Lzma2 as CX import qualified Data.Streaming.Zlib as SZ import qualified Data.Conduit.BZlib as CBZ import qualified Data.Conduit.Zstd as CZstd

@@ -0,0 +1,105 @@+{-- Originally from the lzma-conduit package+ -- https://hackage.haskell.org/package/lzma-conduit+ --+ -- Adapted & updated+ -}+module Data.Conduit.Lzma2(compress, compressWith, decompress, decompressWith) where++import qualified Codec.Compression.Lzma       as Lzma+import           Control.Monad.IO.Class       (MonadIO (liftIO))+import           Control.Monad.Trans.Resource+import           Data.ByteString              (ByteString)+import qualified Data.ByteString              as B+import           Data.Conduit+import           Data.Conduit.List            (peek)+import           Data.Maybe                   (fromMaybe)+import           Data.Word++prettyRet+  :: Lzma.LzmaRet+  -> String+prettyRet r = case r of+  Lzma.LzmaRetOK               -> "Operation completed successfully"+  Lzma.LzmaRetStreamEnd        -> "End of stream was reached"+  Lzma.LzmaRetUnsupportedCheck -> "Cannot calculate the integrity check"+  Lzma.LzmaRetGetCheck         -> "Integrity check type is now available"+  Lzma.LzmaRetMemError         -> "Cannot allocate memory"+  Lzma.LzmaRetMemlimitError    -> "Memory usage limit was reached"+  Lzma.LzmaRetFormatError      -> "File format not recognized"+  Lzma.LzmaRetOptionsError     -> "Invalid or unsupported options"+  Lzma.LzmaRetDataError        -> "Data is corrupt"+  Lzma.LzmaRetBufError         -> "No progress is possible"+  Lzma.LzmaRetProgError        -> "Programming error"+++-- | Decompress a 'ByteString' from a lzma or xz container stream.+decompress+  :: (MonadThrow m, MonadIO m)+  => Maybe Word64 -- ^ Memory limit, in bytes.+  -> ConduitM ByteString ByteString m ()+decompress memlimit =+    decompressWith Lzma.defaultDecompressParams+                   { Lzma.decompressMemLimit     = fromMaybe maxBound memlimit+                   , Lzma.decompressAutoDecoder  = True+                   , Lzma.decompressConcatenated = True+                   }++decompressWith+  :: (MonadThrow m, MonadIO m)+  => Lzma.DecompressParams+  -> ConduitM ByteString ByteString m ()+decompressWith parms = do+    c <- peek+    case c of+      Nothing -> throwM $ userError "Data.Conduit.Lzma.decompress: invalid empty input"+      Just _  -> liftIO (Lzma.decompressIO parms) >>= go+  where+    go s@(Lzma.DecompressInputRequired more) = do+        mx <- await+        case mx of+          Just x+            | B.null x  -> go s -- ignore/skip empty bytestring chunks+            | otherwise -> liftIO (more x) >>= go+          Nothing       -> liftIO (more B.empty) >>= go+    go (Lzma.DecompressOutputAvailable output cont) = do+        yield output+        liftIO cont >>= go+    go (Lzma.DecompressStreamEnd rest)+        | B.null rest = return ()+        | otherwise   = leftover rest+    go (Lzma.DecompressStreamError err) =+        throwM $ userError $ "Data.Conduit.Lzma.decompress: error: "++prettyRet err+++-- | Compress a 'ByteString' into a xz container stream.+compress+  :: (MonadIO m)+  => Maybe Int -- ^ Compression level from [0..9], defaults to 6.+  -> ConduitM ByteString ByteString m ()+compress level =+   compressWith Lzma.defaultCompressParams { Lzma.compressLevel = level' }+ where+   level' = case level of+              Nothing -> Lzma.CompressionLevel6+              Just n  -> let+                            n' = max minBound (min maxBound n) -- clamp to [minBound..maxBound] range+                        in toEnum n'++compressWith+  :: MonadIO m+  => Lzma.CompressParams+  -> ConduitM ByteString ByteString m ()+compressWith parms =+    liftIO (Lzma.compressIO parms) >>= go+  where+    go s@(Lzma.CompressInputRequired _flush more) = do+        mx <- await+        case mx of+          Just x+            | B.null x     -> go s -- ignore/skip empty bytestring chunks+            | otherwise    -> liftIO (more x) >>= go+          Nothing          -> liftIO (more B.empty) >>= go+    go (Lzma.CompressOutputAvailable output cont) = do+        yield output+        liftIO cont >>= go+    go Lzma.CompressStreamEnd = return ()

@@ -14,3 +14,5 @@  ## Author Luis Pedro Coelho | [Email](mailto:luis@luispedro.org) | [Twitter](https://twitter.com/luispedrocoelho)++Since version `0.0.14.0`, this includes code originally in [lzma-conduit](https://github.com/alphaHeavy/lzma-conduit) from Alpha Heavy Industries

@@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack------ hash: 92a9214b73c5e10d0b9b949f0ee1ff3be9366c137750238aa91f8b3ce28ba130  name:           conduit-algorithms-version:        0.0.13.0+version:        0.0.14.0 synopsis:       Conduit-based algorithms description:    Algorithms on Conduits, including higher level asynchronous processing and some other utilities. category:       Conduit@@ -28,6 +26,7 @@  library   exposed-modules:+      Data.Conduit.Lzma2       Data.Conduit.Algorithms       Data.Conduit.Algorithms.Utils       Data.Conduit.Algorithms.Async@@ -52,7 +51,7 @@     , deepseq     , exceptions     , fingertree-    , lzma-conduit+    , lzma     , monad-control     , mtl     , resourcet@@ -62,17 +61,18 @@     , transformers     , unliftio-core     , vector+  default-language: Haskell2010   if os(windows)     cpp-options: -DWINDOWS-  default-language: Haskell2010  test-suite conduit-algorithms-test   type: exitcode-stdio-1.0   main-is: Tests.hs   other-modules:+      TestLZMA       Paths_conduit_algorithms   hs-source-dirs:-      ./tests+      tests   default-extensions:       BangPatterns       OverloadedStrings@@ -96,7 +96,7 @@     , directory     , exceptions     , fingertree-    , lzma-conduit+    , lzma     , monad-control     , mtl     , resourcet@@ -110,9 +110,9 @@     , transformers     , unliftio-core     , vector+  default-language: Haskell2010   if os(windows)     cpp-options: -DWINDOWS-  default-language: Haskell2010  benchmark conduit-algorithms-bench   type: exitcode-stdio-1.0@@ -140,7 +140,7 @@     , deepseq     , exceptions     , fingertree-    , lzma-conduit+    , lzma     , monad-control     , mtl     , resourcet@@ -150,6 +150,6 @@     , transformers     , unliftio-core     , vector+  default-language: Haskell2010   if os(windows)     cpp-options: -DWINDOWS-  default-language: Haskell2010

@@ -0,0 +1,108 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}+module TestLZMA+    ( tgroup_lzma+    ) where+import Test.Tasty.TH+import Test.Tasty.HUnit (assertFailure, (@?=))+import Test.Tasty.QuickCheck+import Test.QuickCheck.Monadic (monadicIO, run, pick, pre, assert)+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 Conduit ((.|))+import Data.Word+import Data.Conduit.Lzma2+import System.IO.Error (tryIOError)++tgroup_lzma = $(testGroupGenerator)++assertLeft (Left _) = return ()+assertLeft _ = run $ assertFailure "Expected Left, got Right"++someString :: Gen B.ByteString+someString = do+  val <- listOf $ elements [0..255::Word8]+  return $ B.pack val++runC :: MonadUnliftIO m => C.ConduitT () C.Void (ResourceT m) a -> m a+runC = runResourceT . C.runConduit++newtype BigString = BigString B.ByteString+    deriving (Eq, Show)+++instance Arbitrary BigString where+    arbitrary = BigString <$> resize (1024*16) someString++prop_compressAndDiscard :: BigString -> Property+prop_compressAndDiscard (BigString str) = monadicIO $ do+    run . runC $+        CL.sourceList [str]+            .| compress Nothing+            .| CL.sinkNull++prop_compressAndCheckLength :: BigString -> Property+prop_compressAndCheckLength (BigString str) = monadicIO $ do+  len <- run . runC $+            CL.sourceList [str]+            .| compress Nothing+            .| CL.fold (\ acc el -> acc + B.length el) 0+  -- random strings don't compress very well+  assert $ len > B.length str `div` 2+  assert $ len - 64 < B.length str * 2++prop_chain :: BigString -> Property+prop_chain (BigString str) = monadicIO . run $ do+    str' <- runC $+        CL.sourceList [str]+            .| compress Nothing+            .| decompress Nothing+            .| CL.consume+    str @?= B.concat str'++prop_compressThenDecompress :: BigString -> Property+prop_compressThenDecompress (BigString str) = monadicIO $ do+    blob <- run . runC $ CL.sourceList [str] .| compress Nothing .| CL.consume+    let blob' = B.concat blob+    randIdx <- pick $ elements [0..B.length blob'-1]+    let resplit = let (x,y) = B.splitAt randIdx blob' in [x,y]+    str' <- run . runC $ CL.sourceList resplit .| decompress Nothing .| CL.consume+    run $ str @?= B.concat str'+++prop_decompressRandom :: BigString -> Property+prop_decompressRandom (BigString str) = monadicIO $ do+  -- The BigString is not necessarily big. It can even be the empty string+  -- https://github.com/alphaHeavy/lzma-conduit/issues/19+  pre $ B.length str > 64+  header <- run . runC $+            CL.sourceList []+                .| compress Nothing+                .| CL.consume+  let blob = header ++ [str]+  ioErrorE <- run $+    tryIOError (runC $ CL.sourceList blob .| decompress Nothing .| CL.sinkNull)+  assertLeft ioErrorE++prop_decompressCorrupt :: BigString -> Property+prop_decompressCorrupt (BigString str) = monadicIO $ do+  header <- run . runC $ (CL.sourceList [] .| compress Nothing .| CL.consume)+  let header' = B.concat header+  randVal <- pick $ elements [0..255::Word8]+  randIdx <- pick $ elements [0..B.length header'-1]+  let (left, right) = B.splitAt randIdx header'+      updated = left `B.append` (randVal `B.cons` B.tail right)+      blob = [updated, str]+  ioErrorE <- run $+    tryIOError (runC $ CL.sourceList blob .| decompress Nothing .| CL.sinkNull)+  assertLeft ioErrorE+++prop_decompressEmpty :: Property+prop_decompressEmpty = monadicIO $ do+  count <- pick $ elements [0..10]+  let blob = replicate count B.empty+  ioErrorE <- run . tryIOError . runC $ CL.sourceList blob .| decompress Nothing .| CL.sinkNull+  assertLeft ioErrorE

@@ -1,9 +1,10 @@-{- Copyright 2017-2021 Luis Pedro Coelho+{- Copyright 2017-2024 Luis Pedro Coelho  - License: MIT  -} {-# LANGUAGE TemplateHaskell, CPP, QuasiQuotes, FlexibleContexts, OverloadedStrings #-} module Main where +import Test.Tasty import Test.Tasty.TH import Test.Tasty.HUnit @@ -31,8 +32,12 @@ import qualified Data.Conduit.Algorithms.Async as CAlg import qualified Data.Conduit.Algorithms.Async.ByteString as CAlg +import TestLZMA (tgroup_lzma)+ main :: IO ()-main = $(defaultMainGenerator)+main = defaultMain $ testGroup "All tests" [tgroup_lzma, maintests]++maintests = $(testGroupGenerator)  testingFileNameGZ :: FilePath testingFileNameGZ = "file_just_for_testing_delete_me_please.gz"