lz4-bytes 0.1.1.1 → 0.1.2.0
raw patch · 6 files changed
+160/−51 lines, 6 filesdep +tasty-hunitdep ~primitivePVP ok
version bump matches the API change (PVP)
Dependencies added: tasty-hunit
Dependency ranges changed: primitive
API changes (from Hackage documentation)
+ Lz4.Frame: decompressU :: Int -> Bytes -> Maybe ByteArray
Files
- CHANGELOG.md +4/−0
- lz4-bytes.cabal +17/−12
- src/Lz4/Block.hs +3/−14
- src/Lz4/Frame.hs +68/−7
- src/Lz4/Internal.hs +12/−9
- test/Main.hs +56/−9
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for lz4-bytes +## 0.1.2.0 -- 2025-03-26++* Add `Lz4.Frame.decompressU`.+ ## 0.1.1.1 -- 2024-01-31 * Update package metadata.
lz4-bytes.cabal view
@@ -1,12 +1,11 @@ cabal-version: 2.2 name: lz4-bytes-version: 0.1.1.1+version: 0.1.2.0 synopsis: Bindings to LZ4 description: This library is similar to the @lz4@ library except that it works with the @Bytes@ type from @byteslice@ rather than @ByteString@. Also, this library has some amount of support for LZ4 frames.- homepage: https://github.com/byteverse/lz4-bytes bug-reports: https://github.com/byteverse/lz4-bytes/issues license: BSD-3-Clause@@ -21,9 +20,15 @@ cbits/lz4hc.h extra-doc-files: CHANGELOG.md+tested-with: GHC ==9.4.8 || ==9.6.3 || ==9.8.1 +common build-settings+ default-language: Haskell2010+ ghc-options: -Wall -Wunused-packages+ library- other-modules: Lz4.Internal+ import: build-settings+ other-modules: Lz4.Internal exposed-modules: Lz4.Block Lz4.Frame@@ -35,27 +40,27 @@ , primitive >=0.7 && <0.10 , run-st >=0.1.1 && <0.2 - hs-source-dirs: src- default-language: Haskell2010- include-dirs: cbits+ hs-source-dirs: src+ include-dirs: cbits+ ghc-options: -O2 c-sources: cbits/hs_lz4.c cbits/lz4.c cbits/lz4hc.c test-suite test- default-language: Haskell2010- type: exitcode-stdio-1.0- hs-source-dirs: test- main-is: Main.hs- ghc-options: -Wall -O2+ import: build-settings+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs build-depends: , base >=4.11.1 && <5 , byteslice , lz4-bytes- , primitive , tasty , tasty-quickcheck+ , tasty-hunit+ , primitive >=0.7 source-repository head type: git
src/Lz4/Block.hs view
@@ -27,7 +27,7 @@ , requiredBufferSize ) where -import Lz4.Internal (c_hs_compress_HC, requiredBufferSize)+import Lz4.Internal (requiredBufferSize,c_hs_compress_HC,c_hs_decompress_safe) import Control.Monad.ST (runST) import Control.Monad.ST.Run (runByteArrayST)@@ -35,11 +35,10 @@ import Data.Primitive (ByteArray (..), MutableByteArray (..)) import GHC.Exts (ByteArray#, MutableByteArray#) import GHC.IO (unsafeIOToST)-import GHC.ST (ST (ST))+import GHC.ST (ST) import qualified Control.Exception import qualified Data.Primitive as PM-import qualified GHC.Exts as Exts {- | Compress bytes using LZ4's HC algorithm. This is slower than 'compress' but provides better compression. A higher@@ -116,7 +115,7 @@ Int -> -- | Next available offset in destination buffer ST s Int-compressInto !lvl (Bytes (ByteArray arr) off len) dst@(MutableByteArray dst#) !doff !dlen = do+compressInto !lvl (Bytes (ByteArray arr) off len) _dst@(MutableByteArray dst#) !doff !dlen = do let maxSz = requiredBufferSize len if dlen < maxSz then unsafeIOToST (Control.Exception.throwIO Lz4BufferTooSmall)@@ -176,16 +175,6 @@ Int -> -- Input size Int -> -- Destination capacity Int -> -- Acceleration factor- IO Int -- Result length--foreign import ccall unsafe "hs_decompress_safe"- c_hs_decompress_safe ::- ByteArray# -> -- Source- Int -> -- Source offset- MutableByteArray# s -> -- Destination- Int -> -- Destination offset- Int -> -- Input size- Int -> -- Destination capacity IO Int -- Result length data Lz4BufferTooSmall = Lz4BufferTooSmall
src/Lz4/Frame.hs view
@@ -13,25 +13,82 @@ module Lz4.Frame ( -- * Compression compressHighlyU+ -- * Decompression+ , decompressU ) where -import Lz4.Internal (c_hs_compress_HC, requiredBufferSize)+import Lz4.Internal (requiredBufferSize,c_hs_compress_HC,c_hs_decompress_safe) +import Control.Monad (when) import Control.Monad.ST (runST)-import Control.Monad.ST.Run (runByteArrayST)+import Data.Bits ((.&.)) import Data.Bytes.Types (Bytes (Bytes)) import Data.Int (Int32) import Data.Primitive (ByteArray (..), MutableByteArray (..))-import Data.Word (Word8)-import GHC.Exts (ByteArray#, MutableByteArray#)+import Data.Word (Word8, Word32) import GHC.IO (unsafeIOToST)-import GHC.ST (ST (ST)) -import qualified Control.Exception import qualified Data.Primitive as PM import qualified Data.Primitive.ByteArray.LittleEndian as LE-import qualified GHC.Exts as Exts+import qualified Data.Bytes as Bytes +-- | Decompress an LZ4 frame. The caller must know the exact size+-- of the decompressed byte array.+--+-- Note: This currently fails if any of the optional headers are used.+-- It is difficult to find examples of lz4 frames that actually use+-- any of these. Open a PR with an example of an lz4 frame that fails+-- to decode if you find one.+decompressU ::+ Int -- ^ The exact size of the decompressed bytes+ -> Bytes -- ^ Compressed bytes+ -> Maybe ByteArray+decompressU !decompressedSize (Bytes arr@(ByteArray arr# ) off len) = do+ when (len < 11) Nothing+ when (indexWord8 arr off /= 0x04) Nothing+ when (indexWord8 arr (off + 1) /= 0x22) Nothing+ when (indexWord8 arr (off + 2) /= 0x4D) Nothing+ when (indexWord8 arr (off + 3) /= 0x18) Nothing+ let !flag = indexWord8 arr (off + 4)+ when (flag /= 0b0110_0000) Nothing+ -- Here is the code that would read the size hint from the bd. However,+ -- there is no reason to use this since this function takes the actual+ -- size as an argument. We ignore the checksum at position off+6 as well.+ -- let !bd = indexWord8 arr (off + 5)+ -- maximumDecompressedSize <- case bd of+ -- 0b0111_0000 -> pure 4194304+ -- 0b0110_0000 -> pure 1048576+ -- 0b0101_0000 -> pure 262144+ -- 0b0100_0000 -> pure 65536+ -- _ -> Nothing+ -- when (maximumDecompressedSize < decompressedSize) Nothing+ let !compressedSize = LE.indexUnalignedByteArray arr (off + 7) :: Word32+ let !compressedSizeI = fromIntegral (compressedSize .&. 0x7fff_ffff) :: Int+ when (compressedSizeI + (4 + 3 + 4 + 4) /= len) Nothing+ let !offPost = off + 11 + compressedSizeI+ when (indexWord8 arr offPost /= 0x00) Nothing+ when (indexWord8 arr (offPost + 1) /= 0x00) Nothing+ when (indexWord8 arr (offPost + 2) /= 0x00) Nothing+ when (indexWord8 arr (offPost + 3) /= 0x00) Nothing+ case compressedSize .&. 0x8000_0000 of+ 0 -> runST $ do+ dst@(MutableByteArray dst# ) <- PM.newByteArray decompressedSize+ actualSz <- unsafeIOToST (c_hs_decompress_safe arr# (off + 11) dst# 0 compressedSizeI decompressedSize)+ -- Note: actualSz will be negative if decompression fails. That's fine.+ if actualSz == decompressedSize+ then do+ dst' <- PM.unsafeFreezeByteArray dst+ pure (Just dst')+ else pure Nothing+ _ -> do+ -- When the upper bit of the size is set, it means that the data in+ -- the block is uncompressed. This code path is not tested in the test+ -- suite, and I cannot find examples of this feature used in the wild.+ -- If anyone knows of an example, open a PR.+ when (decompressedSize /= compressedSizeI) Nothing+ when (decompressedSize + 15 /= len) Nothing+ Just $! Bytes.toByteArrayClone (Bytes arr (off + 11) decompressedSize)+ {- | Use HC compression to produce a frame with a single block. All optional fields (checksums, content sizes, and dictionary IDs) are omitted.@@ -79,3 +136,7 @@ PM.writeByteArray dst (actualSz + 14) (0x00 :: Word8) PM.shrinkMutableByteArray dst (actualSz + 15) PM.unsafeFreezeByteArray dst++indexWord8 :: ByteArray -> Int -> Word8+{-# inline indexWord8 #-}+indexWord8 = PM.indexByteArray
src/Lz4/Internal.hs view
@@ -9,24 +9,17 @@ module Lz4.Internal ( requiredBufferSize , c_hs_compress_HC+ , c_hs_decompress_safe ) where -import Control.Monad.ST (runST)-import Control.Monad.ST.Run (runByteArrayST)-import Data.Bytes.Types (Bytes (Bytes))-import Data.Primitive (ByteArray (..), MutableByteArray (..)) import GHC.Exts (ByteArray#, MutableByteArray#)-import GHC.IO (unsafeIOToST)-import GHC.ST (ST (ST)) -import qualified Control.Exception-import qualified Data.Primitive as PM-import qualified GHC.Exts as Exts {- | Copied from the @LZ4_COMPRESSBOUND@ macro lz4.h to avoid using FFI for simple arithmetic. Make sure this stays in sync with the macro. -} requiredBufferSize :: Int -> Int+{-# inline requiredBufferSize #-} requiredBufferSize s = s + (div s 255) + 16 foreign import ccall unsafe "hs_compress_HC"@@ -39,3 +32,13 @@ Int -> -- Destination capacity Int -> -- Compression level IO Int -- Result length++foreign import ccall unsafe "hs_decompress_safe"+ c_hs_decompress_safe ::+ ByteArray# -- Source+ -> Int -- Source offset+ -> MutableByteArray# s -- Destination+ -> Int -- Destination offset+ -> Int -- Input size+ -> Int -- Destination capacity+ -> IO Int -- Result length
test/Main.hs view
@@ -2,33 +2,80 @@ {-# LANGUAGE ScopedTypeVariables #-} import Data.Bytes (Bytes)+import Data.Primitive (ByteArray,sizeofByteArray) import Data.Word (Word8) import Lz4.Block (compress, compressHighly, decompress) import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit (testCase,(@=?)) import Test.Tasty.QuickCheck (Gen, choose, forAll, testProperty, vectorOf, (===)) import qualified Data.Bytes as Bytes import qualified GHC.Exts as Exts+import qualified Lz4.Frame as Frame main :: IO () main = defaultMain tests tests :: TestTree-tests =- testGroup- "lz4"+tests = testGroup "lz4"+ [ testGroup "block" [ testProperty "roundtrip" $ forAll genBytes $ \bs ->- let cs = compress 1 bs- in Just bs- === decompress (Bytes.length bs) cs+ let cs = compress 1 bs in+ Just bs+ ===+ decompress (Bytes.length bs) cs , testProperty "roundtrip-HC" $ forAll genBytes $ \bs ->- let cs = compressHighly 3 bs- in Just bs- === decompress (Bytes.length bs) cs+ let cs = compressHighly 3 bs in+ Just bs+ ===+ decompress (Bytes.length bs) cs ]+ , testGroup "frame"+ [ testProperty "roundtrip-HC" $ forAll genByteArray $ \bs ->+ let cs = Frame.compressHighlyU 3 (Bytes.fromByteArray bs) in+ Just bs+ ===+ Frame.decompressU (sizeofByteArray bs) (Bytes.fromByteArray cs)+ , testCase "example-a" $ case Frame.decompressU 20 (Bytes.fromByteArray exampleA) of+ Nothing -> fail "decompression failed"+ Just _ -> pure ()+ , testCase "example-b" $ case Frame.decompressU 10 (Bytes.fromByteArray exampleB) of+ Nothing -> fail "decompression failed"+ Just x -> x @=? Exts.fromList [0xbb :: Word8, 0x01, 0xbb, 0x01, 0xbb, 0x01, 0xbb, 0x01, 0xbb, 0x01 ]+ ]+ ] genBytes :: Gen Bytes genBytes = do n <- choose (0, 200) bs <- vectorOf n (choose (0, 2 :: Word8)) pure (Exts.fromList bs)++genByteArray :: Gen ByteArray+genByteArray = fmap Bytes.toByteArray genBytes++-- Example from Clickhouse arrow output+-- Compressed Length: 28+-- Decompressed Length: 20+exampleA :: ByteArray+exampleA = Exts.fromList+ [ 0x04, 0x22, 0x4d, (0x18 :: Word8)+ , 0x60, 0x40, 0x82+ , 0x0d, 0x00, 0x00, 0x00 -- little-endian encoding of the number 13+ , 0x47, 0x15, 0x08, 0x01, 0x0a, 0x04 , 0x00, 0x50, 0x0a, 0x15, 0x08, 0x01, 0x0a+ , 0x00, 0x00, 0x00, 0x00+ ]++-- Example that tests a frame that does not use compression+exampleB :: ByteArray+exampleB = Exts.fromList+ [ 0x04, 0x22, 0x4d, (0x18 :: Word8)+ , 0x60, 0x40, 0x82+ , 0x0a, 0x00, 0x00, 0x80 -- little-endian encoding of 10 but with the high bit set to disable compression+ , 0xbb, 0x01+ , 0xbb, 0x01+ , 0xbb, 0x01+ , 0xbb, 0x01+ , 0xbb, 0x01+ , 0x00, 0x00, 0x00, 0x00+ ]