lzma-streams 0.0.0.0 → 0.1.0.0

raw patch · 6 files changed

+95/−431 lines, 6 filesdep +lzmadep ~HUnitdep ~basedep ~io-streamsPVP ok

version bump matches the API change (PVP)

Dependencies added: lzma

Dependency ranges changed: HUnit, base, io-streams

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• cbits/lzma_wrapper.c +0/−65
• lzma-streams.cabal +7/−7
• src-tests/lzma-streams-test.hs +6/−1
• src/LibLzma.hsc +0/−282
• src/System/IO/Streams/Lzma.hs +71/−76

@@ -0,0 +1,11 @@+# 0.1.0.0++- Factor out `io-streams`-independent code to `lzma` package.++- `CompressParams` and `DecompressParams` constructors aren't exported anymore++- Add support for flush-operation on `OutputStream ByteString`++# 0.0.0.0++Initial version

@@ -1,65 +0,0 @@-/*- * FFI wrappers for `lzma-streams`- *- * Copyright (c) 2014, Herbert Valerio Riedel <hvr@gnu.org>- *- * This code is BSD3 licensed, see ../LICENSE file for details- *- */--#include <stdio.h>-#include <string.h>-#include <lzma.h>-#include <HsFFI.h>--HsInt-hs_lzma_init_decoder(lzma_stream *ls, HsBool autolzma, uint64_t memlimit, uint32_t flags)-{-  /* recommended super-portable initialization */-  const lzma_stream ls_init = LZMA_STREAM_INIT;-  *ls = ls_init;--  const lzma_ret ret = (autolzma ? lzma_auto_decoder : lzma_stream_decoder)(ls, memlimit, flags);--  return ret;-}--HsInt-hs_lzma_init_encoder(lzma_stream *ls, uint32_t preset, HsInt check)-{-  /* recommended super-portable initialization */-  const lzma_stream ls_init = LZMA_STREAM_INIT;-  *ls = ls_init;--  const lzma_ret ret = lzma_easy_encoder(ls, preset, check);--  return ret;-}--void-hs_lzma_done(lzma_stream *ls)-{-  lzma_end(ls);-}--HsInt-hs_lzma_run(lzma_stream *const ls, const HsInt action,-            const uint8_t ibuf[], const HsInt ibuf_len,-            uint8_t obuf[], const HsInt obuf_len)-{-  ls->next_in = ibuf;-  ls->avail_in = ibuf_len;-  ls->next_out = obuf;-  ls->avail_out = obuf_len;--  // paranoia-  memset(obuf, 0, obuf_len);-  -  const lzma_ret ret = lzma_code(ls, action);--  // paranoia-  ls->next_in = NULL;-  ls->next_out = NULL;--  return ret;-}

@@ -1,5 +1,5 @@ name:                lzma-streams-version:             0.0.0.0+version:             0.1.0.0 synopsis:            IO-Streams interface for lzma/xz compression homepage:            https://github.com/hvr/lzma-streams bug-reports:         https://github.com/hvr/lzma-streams/issues@@ -12,6 +12,8 @@ category:            Codec, Compression, IO-Streams build-type:          Simple cabal-version:       >=1.10+tested-with:         GHC ==7.4.2, GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.1+ description:    This package provides an IO-Streams interface for the LZMA    compression algorithm used in the @.xz@ file format.@@ -21,6 +23,8 @@    .    See also the XZ Utils home page: <http://tukaani.org/xz/> +extra-source-files:    CHANGELOG.md+ source-repository head   type:     git   location: https://github.com/hvr/lzma-streams.git@@ -32,15 +36,11 @@   hs-source-dirs:      src    exposed-modules:     System.IO.Streams.Lzma-  other-modules:       LibLzma -  includes:            lzma.h-  extra-libraries:     lzma-  c-sources:           cbits/lzma_wrapper.c-   build-depends:       base       >=4.5    && <4.9,                        bytestring >=0.9.2  && <0.11,-                       io-streams >=1.3    && <1.4+                       io-streams >=1.3    && <1.4,+                       lzma       ==0.0.*    ghc-options:         -Wall 

@@ -11,7 +11,7 @@ main :: IO () main = defaultMain [ testGroup "System.IO.Streams.Lzma" tests ]   where-    tests =  [ test0, test1, prop1, prop2 ]+    tests =  [ test0, test1, test2, prop1, prop2 ]  test0 :: Test test0 = testCase "empty" $ (decode . encode) BS.empty @?= BS.empty@@ -20,6 +20,11 @@ test1 = testCase "hello" $ (decode . encode) bs @?= bs   where     bs = BS.pack [104,101,108,108,111]++test2 :: Test+test2 = testCase "10MiB" $ (decode . encode) bs @?= bs+  where+    bs = BS.replicate (10*1024*1024) 0xaa  prop1 :: Test prop1 = testProperty "random" go

@@ -1,282 +0,0 @@-{-# LANGUAGE RecordWildCards, DeriveDataTypeable #-}---- Copyright (c) 2014, Herbert Valerio Riedel <hvr@gnu.org>------ This code is BSD3 licensed, see ../LICENSE file for details------- | Internal low-level binding to liblzma------ TODO: Polish, generalise, and factor out into streaming-API---       agnostic package w/ minimal build-deps.---       Something in the style of the incremental API in---       "Codec.Compression.Zlib.Internal" would be nice----module LibLzma-    ( LzmaStream-    , LzmaRet(..)-    , IntegrityCheck(..)-    , CompressionLevel(..)--    , newDecodeLzmaStream-    , DecompressParams(..)-    , defaultDecompressParams--    , newEncodeLzmaStream-    , CompressParams(..)-    , defaultCompressParams--    , runLzmaStream--    , CompressStream(..)-    , compressIO-    ) where--import           Control.Applicative-import           Control.Exception-import           Control.Monad-import           Data.ByteString (ByteString)-import qualified Data.ByteString.Internal as BS-import qualified Data.ByteString.Unsafe as BS-import qualified Data.ByteString as BS-import           Data.Typeable-import           Foreign-import           Prelude--#include <lzma.h>--newtype LzmaStream = LS (ForeignPtr LzmaStream)--data LzmaRet = LzmaRetOK-             | LzmaRetStreamEnd-             | LzmaRetUnsupportedCheck-             | LzmaRetGetCheck-             | LzmaRetMemError-             | LzmaRetMemlimitError-             | LzmaRetFormatError-             | LzmaRetOptionsError-             | LzmaRetDataError-             | LzmaRetBufError-             | LzmaRetProgError-             deriving (Eq,Ord,Show,Typeable)--instance Exception LzmaRet--toLzmaRet :: Int -> Maybe LzmaRet-toLzmaRet i = case i of-    (#const LZMA_OK               ) -> Just LzmaRetOK-    (#const LZMA_STREAM_END       ) -> Just LzmaRetStreamEnd-    (#const LZMA_UNSUPPORTED_CHECK) -> Just LzmaRetUnsupportedCheck-    (#const LZMA_GET_CHECK        ) -> Just LzmaRetGetCheck-    (#const LZMA_MEM_ERROR        ) -> Just LzmaRetMemError-    (#const LZMA_MEMLIMIT_ERROR   ) -> Just LzmaRetMemlimitError-    (#const LZMA_FORMAT_ERROR     ) -> Just LzmaRetFormatError-    (#const LZMA_OPTIONS_ERROR    ) -> Just LzmaRetOptionsError-    (#const LZMA_DATA_ERROR       ) -> Just LzmaRetDataError-    (#const LZMA_BUF_ERROR        ) -> Just LzmaRetBufError-    (#const LZMA_PROG_ERROR       ) -> Just LzmaRetProgError-    _                               -> Nothing---- | Integrity check type (only supported when compressing @.xz@ files)-data IntegrityCheck = IntegrityCheckNone   -- ^ disable integrity check (not recommended)-               | IntegrityCheckCrc32  -- ^ CRC32 using the polynomial from IEEE-802.3-               | IntegrityCheckCrc64  -- ^ CRC64 using the polynomial from ECMA-182-               | IntegrityCheckSha256 -- ^ SHA-256-               deriving (Eq,Ord,Show)---- | Compression level presets that define the tradeoff between--- computational complexity and compression ratio------ 'CompressionLevel0' has the lowest compression ratio as well as the--- lowest memory requirements, whereas 'CompressionLevel9' has the--- highest compression ratio and can require over 600MiB during--- compression (and over 60MiB during decompression). The--- <https://www.freebsd.org/cgi/man.cgi?query=xz&sektion=1&manpath=FreeBSD+10.2-stable&arch=default&format=html man-page for xz(1)>--- contains more detailed information with tables describing the--- properties of all compression level presets.------ 'CompressionLevel6' is the default setting in--- 'defaultCompressParams' as it provides a good trade-off and--- matches the default of the @xz(1)@ tool.--data CompressionLevel = CompressionLevel0-                      | CompressionLevel1-                      | CompressionLevel2-                      | CompressionLevel3-                      | CompressionLevel4-                      | CompressionLevel5-                      | CompressionLevel6-                      | CompressionLevel7-                      | CompressionLevel8-                      | CompressionLevel9-                      deriving (Eq,Ord,Show,Enum)--fromIntegrityCheck :: IntegrityCheck -> Int-fromIntegrityCheck lc = case lc of-    IntegrityCheckNone   -> #const LZMA_CHECK_NONE-    IntegrityCheckCrc32  -> #const LZMA_CHECK_CRC32-    IntegrityCheckCrc64  -> #const LZMA_CHECK_CRC64-    IntegrityCheckSha256 -> #const LZMA_CHECK_SHA256---- | Set of parameters for decompression. The defaults are 'defaultDecompressParams'.-data DecompressParams = DecompressParams-    { decompressTellNoCheck          :: !Bool-    , decompressTellUnsupportedCheck :: !Bool-    , decompressTellAnyCheck         :: !Bool-    , decompressConcatenated         :: !Bool-    , decompressAutoDecoder          :: !Bool-    , decompressMemLimit             :: !Word64 -- ^ Set to 'maxBound' to disable memory limit-    } deriving (Eq,Show)---- | The default set of parameters for decompression. This is typically used with the decompressWith function with specific parameters overridden.-defaultDecompressParams :: DecompressParams-defaultDecompressParams = DecompressParams {..}-  where-    decompressTellNoCheck          = False-    decompressTellUnsupportedCheck = False-    decompressTellAnyCheck         = False-    decompressConcatenated         = True-    decompressAutoDecoder          = False-    decompressMemLimit             = maxBound -- disables limit-check---- | Set of parameters for compression. The defaults are 'defaultCompressParams'.-data CompressParams = CompressParams-    { compressIntegrityCheck :: !IntegrityCheck -- ^ Specify type of integrity check-    , compressLevel          :: !CompressionLevel -- ^ See documentation of 'CompressionLevel'-    , compressLevelExtreme   :: !Bool  -- ^ Enable slower variant of the-                                       -- 'lzmaCompLevel' preset, see @xz(1)@-                                       -- man-page for details.-    } deriving (Eq,Show)---- | The default set of parameters for compression. This is typically used with the compressWith function with specific parameters overridden.-defaultCompressParams :: CompressParams-defaultCompressParams = CompressParams {..}-  where-    compressIntegrityCheck = IntegrityCheckCrc64-    compressLevel          = CompressionLevel6-    compressLevelExtreme   = False--newDecodeLzmaStream :: DecompressParams -> IO (Either LzmaRet LzmaStream)-newDecodeLzmaStream (DecompressParams {..}) = do-    fp <- mallocForeignPtrBytes (#size lzma_stream)-    addForeignPtrFinalizer c_hs_lzma_done_funptr fp-    rc <- withForeignPtr fp (\ptr -> c_hs_lzma_init_decoder ptr decompressAutoDecoder decompressMemLimit flags')-    rc' <- maybe (fail "newDecodeLzmaStream: invalid return code") pure $ toLzmaRet rc--    return $ case rc' of-        LzmaRetOK -> Right (LS fp)-        _         -> Left rc'-  where-    flags' =-        (if decompressTellNoCheck          then (#const LZMA_TELL_NO_CHECK)          else 0) .|.-        (if decompressTellUnsupportedCheck then (#const LZMA_TELL_UNSUPPORTED_CHECK) else 0) .|.-        (if decompressTellAnyCheck         then (#const LZMA_TELL_ANY_CHECK)         else 0) .|.-        (if decompressConcatenated         then (#const LZMA_CONCATENATED)           else 0)--newEncodeLzmaStream :: CompressParams -> IO (Either LzmaRet LzmaStream)-newEncodeLzmaStream (CompressParams {..}) = do-    fp <- mallocForeignPtrBytes (#size lzma_stream)-    addForeignPtrFinalizer c_hs_lzma_done_funptr fp-    rc <- withForeignPtr fp (\ptr -> c_hs_lzma_init_encoder ptr preset check)-    rc' <- maybe (fail "newDecodeLzmaStream: invalid return code") pure $ toLzmaRet rc--    return $ case rc' of-        LzmaRetOK -> Right (LS fp)-        _         -> Left rc'--  where-    preset = fromIntegral (fromEnum compressLevel) .|.-             (if compressLevelExtreme then (#const LZMA_PRESET_EXTREME) else 0)-    check = fromIntegrityCheck compressIntegrityCheck--runLzmaStream :: LzmaStream -> ByteString -> Bool -> Int -> IO (LzmaRet,Int,ByteString)-runLzmaStream (LS ls) ibs finish buflen-  | buflen <= 0 = fail "runLzmaStream: invalid buflen argument"-  | otherwise = withForeignPtr ls $ \lsptr -> do-      BS.unsafeUseAsCStringLen ibs $ \(ibsptr, ibslen) -> do-          (obuf,rc) <- BS.createAndTrim' buflen $ \bufptr -> do-              rc' <- c_hs_lzma_run lsptr action (castPtr ibsptr) ibslen bufptr buflen-              rc'' <- maybe (fail "runLzmaStream: invalid return code") pure $ toLzmaRet rc'--              availOut <- (#peek lzma_stream, avail_out) lsptr-              unless (buflen >= availOut && availOut >= 0) (fail "runLzmaStream: invalid avail_out")-              let produced = buflen - availOut--              return (0, produced, rc'')--          availIn <- (#peek lzma_stream, avail_in) lsptr-          unless (ibslen >= availIn && availIn >= 0) (fail "runLzmaStream: invalid avail_in")-          let consumed = ibslen - availIn--          return (rc, fromIntegral consumed, obuf)-  where-    action = if finish then (#const LZMA_FINISH) else (#const LZMA_RUN)--------------------------------------------------------------------------------- trivial helper wrappers defined in ../cbits/lzma_wrapper.c--foreign import ccall "hs_lzma_init_decoder"-    c_hs_lzma_init_decoder :: Ptr LzmaStream -> Bool -> Word64 -> Word32 -> IO Int--foreign import ccall "hs_lzma_init_encoder"-    c_hs_lzma_init_encoder :: Ptr LzmaStream -> Word32 -> Int -> IO Int--foreign import ccall "hs_lzma_run"-    c_hs_lzma_run :: Ptr LzmaStream -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> Int -> IO Int--foreign import ccall "&hs_lzma_done"-    c_hs_lzma_done_funptr :: FunPtr (Ptr LzmaStream -> IO ())---------------------------------------------------------------------------------- type stolen from 'zlib', we may actually just depend on zlib at some point in the future--data CompressStream m =-     CompressInputRequired (ByteString -> m (CompressStream m))-   | CompressOutputAvailable !ByteString (m (CompressStream m))-   | CompressStreamEnd--compressIO :: CompressParams -> IO (CompressStream IO)-compressIO parms = newEncodeLzmaStream parms >>= either throwIO go-  where-    bUFSIZ = 32752--    go :: LzmaStream -> IO (CompressStream IO)-    go ls = return $ CompressInputRequired goInput-      where-        goInput :: ByteString -> IO (CompressStream IO)-        goInput chunk-          | BS.null chunk = goFinish-          | otherwise     = do-              (rc, used, obuf) <- runLzmaStream ls chunk False bUFSIZ--              unless (used > 0) $ fail "compressIO: input chunk not consumed"--              let chunk' = BS.drop used chunk--              case rc of-                  LzmaRetOK-                      | BS.null obuf -> if BS.null chunk'-                                        then return (CompressInputRequired goInput)-                                        else goInput chunk'--                      | otherwise -> return (CompressOutputAvailable obuf-                                             (if BS.null chunk'-                                              then return (CompressInputRequired goInput)-                                              else goInput chunk'))--                  _ -> throwIO rc--        goFinish :: IO (CompressStream IO)-        goFinish = do-            (rc, 0, obuf) <- runLzmaStream ls BS.empty True bUFSIZ--            case rc of-                LzmaRetOK-                    | BS.null obuf -> fail "compressIO: empty output chunk"-                    | otherwise    -> return (CompressOutputAvailable obuf goFinish)-                LzmaRetStreamEnd-                    | BS.null obuf -> return CompressStreamEnd-                    | otherwise    -> return (CompressOutputAvailable obuf (return CompressStreamEnd))--                _ -> throwIO rc

@@ -14,87 +14,81 @@     ( -- * 'ByteString' decompression       decompress     , decompressWith-    , defaultDecompressParams-    , DecompressParams(..)+    , Lzma.defaultDecompressParams+    , Lzma.DecompressParams+    , Lzma.compressIntegrityCheck+    , Lzma.compressLevel+    , Lzma.compressLevelExtreme        -- * 'ByteString' compression     , compress     , compressWith-    , defaultCompressParams-    , CompressParams(..)-    , IntegrityCheck(..)-    , CompressionLevel(..)+    , Lzma.defaultCompressParams+    , Lzma.CompressParams+    , Lzma.decompressTellNoCheck+    , Lzma.decompressTellUnsupportedCheck+    , Lzma.decompressTellAnyCheck+    , Lzma.decompressConcatenated+    , Lzma.decompressAutoDecoder+    , Lzma.decompressMemLimit+    , Lzma.IntegrityCheck(..)+    , Lzma.CompressionLevel(..)      ) where +import           Codec.Compression.Lzma (DecompressStream(..), CompressStream(..))+import qualified Codec.Compression.Lzma as Lzma+ import           Control.Exception import           Control.Monad-import           Data.ByteString   (ByteString)-import qualified Data.ByteString   as BS+import           Data.ByteString        (ByteString)+import qualified Data.ByteString        as BS import           Data.IORef-import           LibLzma-import           System.IO.Streams (InputStream, OutputStream, makeInputStream,-                                    makeOutputStream)-import qualified System.IO.Streams as Streams+import           Data.Maybe+import           System.IO.Streams      (InputStream, OutputStream,+                                         makeInputStream, makeOutputStream)+import qualified System.IO.Streams      as Streams  -- | Decompress an 'InputStream' of strict 'ByteString's from the @.xz@ format decompress :: InputStream ByteString -> IO (InputStream ByteString)-decompress = decompressWith defaultDecompressParams+decompress = decompressWith Lzma.defaultDecompressParams  -- | Like 'decompress' but with the ability to specify various decompression -- parameters. Typical usage: -- -- > decompressWith defaultDecompressParams { decompress... = ... }-decompressWith :: DecompressParams -> InputStream ByteString -> IO (InputStream ByteString)-decompressWith flags ibs-    = newDecodeLzmaStream flags >>= either throwIO (wrapLzmaInStream ibs)---- TODO: figure out sensible buffer-size & refactor into generic--- incremental API in the style of zlib's incremental API-wrapLzmaInStream :: InputStream ByteString -> LzmaStream -> IO (InputStream ByteString)-wrapLzmaInStream ibs ls0 = do-    st <- newIORef (Right ls0)+decompressWith :: Lzma.DecompressParams -> InputStream ByteString -> IO (InputStream ByteString)+decompressWith parms ibs = do+    st <- newIORef =<< Lzma.decompressIO parms     makeInputStream (go st)   where-    go st = readIORef st >>= either goLeft goRight-      where-        goRight ls = do-            ibuf <- getChunk--            (rc, _, obuf) <- case ibuf of-                Nothing -> runLzmaStream ls BS.empty True bUFSIZ-                Just bs -> do-                    retval@(_, consumed, _) <- runLzmaStream ls bs False bUFSIZ-                    when (consumed < BS.length bs) $ do-                        Streams.unRead (BS.drop consumed bs) ibs-                    return retval--            unless (rc == LzmaRetOK) $ do-                writeIORef st (Left rc)-                unless (rc == LzmaRetStreamEnd) $-                    throwIO rc--            case rc of-                LzmaRetOK -> if (BS.null obuf)-                             then goRight ls -- feed de/encoder some more-                             else return (Just obuf)+    go stref = do+        st' <- goFeed =<< readIORef stref+        case st' of+            DecompressInputRequired _ -> do+                writeIORef stref st'+                fail "the impossible happened" -                LzmaRetStreamEnd -> do-                    writeIORef st (Left rc)-                    if BS.null obuf-                        then return Nothing-                        else return (Just obuf)+            DecompressOutputAvailable outb next -> do+                writeIORef stref =<< next+                return (Just outb) -                _ -> writeIORef st (Left rc) >> throwIO rc+            DecompressStreamEnd leftover -> do+                unless (BS.null leftover) $ do+                    Streams.unRead leftover ibs+                writeIORef stref (DecompressStreamEnd BS.empty)+                return Nothing -    goLeft err = case err of-        LzmaRetStreamEnd -> return Nothing-        _                -> throwIO err+            DecompressStreamError rc -> do+                writeIORef stref st'+                throwIO rc -    bUFSIZ = 32752+    -- feed engine+    goFeed (DecompressInputRequired supply) =+        goFeed =<< supply . fromMaybe BS.empty =<< getChunk+    goFeed s = return s      -- wrapper around 'read ibs' to retry until a non-empty ByteString or Nothing is returned-    -- TODO: consider implementing flush semantics     getChunk = do         mbs <- Streams.read ibs         case mbs of@@ -108,47 +102,48 @@ -- (in the @.xz@ format) into an 'OutputStream' that consumes -- uncompressed 'ByteString's compress :: OutputStream ByteString -> IO (OutputStream ByteString)-compress = compressWith defaultCompressParams+compress = compressWith Lzma.defaultCompressParams  -- | Like 'compress' but with the ability to specify various compression -- parameters. Typical usage: -- -- > compressWith defaultCompressParams { compress... = ... }-compressWith :: CompressParams -> OutputStream ByteString -> IO (OutputStream ByteString)+compressWith :: Lzma.CompressParams -> OutputStream ByteString -> IO (OutputStream ByteString) compressWith parms obs = do-    st <- newIORef =<< compressIO parms+    st <- newIORef =<< Lzma.compressIO parms     makeOutputStream (go st)   where-    go stref (Just chunk)-      | BS.null chunk = return () -- we don't support flushing yet-      | otherwise = do-          st <- readIORef stref-          st' <- case st of-              CompressInputRequired supply -> goOutput =<< supply chunk-              _ -> fail "compressWith: unexpected state"-          writeIORef stref st'--          case st' of-              CompressInputRequired _ -> return ()-              _ -> fail "compressWith:  unexpected state"-+    go stref (Just chunk) = do+        st <- readIORef stref+        st' <- case st of+            CompressInputRequired flush supply+              | BS.null chunk -> goOutput True =<< flush+              | otherwise     -> goOutput False =<< supply chunk+            _ -> fail "compressWith: unexpected state"+        writeIORef stref st'+        case st' of+            CompressInputRequired _ _ -> return ()+            _ -> fail "compressWith:  unexpected state"      -- EOF     go stref Nothing = do         st <- readIORef stref         st' <- case st of-            CompressInputRequired supply -> goOutput =<< supply BS.empty+            CompressInputRequired _ supply -> goOutput False =<< supply BS.empty             _ -> fail "compressWith[EOF]: unexpected state"         writeIORef stref st'         case st' of             CompressStreamEnd -> return ()             _ -> fail "compressWith[EOF]:  unexpected state" -    goOutput st@(CompressInputRequired _) = do+    -- Drain output from CompressStream+    goOutput flush st@(CompressInputRequired _ _) = do+        when flush $+            Streams.write (Just BS.empty) obs         return st-    goOutput (CompressOutputAvailable obuf next) = do+    goOutput flush (CompressOutputAvailable obuf next) = do         Streams.write (Just obuf) obs-        goOutput =<< next-    goOutput st@CompressStreamEnd = do+        goOutput flush =<< next+    goOutput _ st@CompressStreamEnd = do         Streams.write Nothing obs         return st