diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/lz4-bytes.cabal b/lz4-bytes.cabal --- a/lz4-bytes.cabal +++ b/lz4-bytes.cabal @@ -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 diff --git a/src/Lz4/Block.hs b/src/Lz4/Block.hs --- a/src/Lz4/Block.hs +++ b/src/Lz4/Block.hs @@ -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 diff --git a/src/Lz4/Frame.hs b/src/Lz4/Frame.hs --- a/src/Lz4/Frame.hs +++ b/src/Lz4/Frame.hs @@ -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 diff --git a/src/Lz4/Internal.hs b/src/Lz4/Internal.hs --- a/src/Lz4/Internal.hs +++ b/src/Lz4/Internal.hs @@ -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 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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 + ]