diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,11 @@ # Changelog +- 0.3.7 (2026-11-13) + * Adds 'hash_prefixed', which hashes the concatenation of two strict + bytestrings. When the length of the first is a multiple of the + 64-byte block size, the second is hashed in place, rather than + being copied into a new buffer alongside it. + - 0.3.6 (2026-10-31) * Uses the x86 SHA extensions on x86_64 CPUs that support them, detected at runtime, falling back to the pure Haskell diff --git a/lib/Crypto/Hash/SHA256.hs b/lib/Crypto/Hash/SHA256.hs --- a/lib/Crypto/Hash/SHA256.hs +++ b/lib/Crypto/Hash/SHA256.hs @@ -18,6 +18,7 @@ module Crypto.Hash.SHA256 ( -- * SHA-256 message digest functions hash + , hash_prefixed , Lazy.hash_lazy -- * SHA256-based MAC functions @@ -52,6 +53,24 @@ | Native.sha256_native_available = Native.hash m | otherwise = Pure.hash m {-# INLINABLE hash #-} + +-- | Compute a condensed representation of the concatenation of two +-- strict bytestrings via SHA-256, i.e. @hash (p <> m)@. +-- +-- When the length of the prefix @p@ is a multiple of 64 bytes (the +-- SHA-256 block size), @m@ is hashed in place, rather than being +-- copied into a new buffer. Otherwise both are copied, as for +-- @hash (p <> m)@. +-- +-- The 256-bit output digest is returned as a strict bytestring. +-- +-- >>> hash_prefixed "64-byte prefix" "strict bytestring input" +-- "" +hash_prefixed :: BS.ByteString -> BS.ByteString -> BS.ByteString +hash_prefixed p m + | Native.sha256_native_available = Native.hash_prefixed p m + | otherwise = Pure.hash_prefixed p m +{-# INLINABLE hash_prefixed #-} -- hmac ---------------------------------------------------------------------- diff --git a/lib/Crypto/Hash/SHA256/Native.hs b/lib/Crypto/Hash/SHA256/Native.hs --- a/lib/Crypto/Hash/SHA256/Native.hs +++ b/lib/Crypto/Hash/SHA256/Native.hs @@ -16,6 +16,7 @@ module Crypto.Hash.SHA256.Native ( sha256_native_available , hash + , hash_prefixed , hmac , _hmac_rr , _hmac_rsb @@ -111,6 +112,21 @@ _hash rp bp 0 m let !rs = peek_registers rp pure (cat rs) + +hash_prefixed + :: BS.ByteString + -> BS.ByteString + -> BS.ByteString +hash_prefixed p@(BI.PS _ _ l) m + | l `rem` 64 /= 0 = hash (p <> m) + | otherwise = unsafeDupablePerformIO $ + allocaBytes 32 $ \rp -> + allocaBytes 64 $ \bp -> do + poke_registers rp (iv ()) + hash_blocks rp bp p + _hash rp bp (fi l) m + let !rs = peek_registers rp + pure (cat rs) _hash :: Ptr Word32 -- ^ register state diff --git a/lib/Crypto/Hash/SHA256/Pure.hs b/lib/Crypto/Hash/SHA256/Pure.hs --- a/lib/Crypto/Hash/SHA256/Pure.hs +++ b/lib/Crypto/Hash/SHA256/Pure.hs @@ -15,6 +15,7 @@ module Crypto.Hash.SHA256.Pure ( hash + , hash_prefixed , hmac , _hmac_rr , _hmac_rsb @@ -41,6 +42,16 @@ hash :: BS.ByteString -> BS.ByteString hash m = cat (_hash 0 (iv ()) m) {-# INLINABLE hash #-} + +-- | Compute a condensed representation of the concatenation of two +-- strict bytestrings via SHA-256, using the pure Haskell +-- implementation. The second bytestring is not copied when the +-- length of the first is a multiple of 64. +hash_prefixed :: BS.ByteString -> BS.ByteString -> BS.ByteString +hash_prefixed p@(BI.PS _ _ l) m + | l `rem` 64 /= 0 = hash (p <> m) + | otherwise = cat (_hash (fi l) (_hash_blocks (iv ()) p) m) +{-# INLINABLE hash_prefixed #-} _hash :: Word64 -- ^ extra prefix length for padding calculations diff --git a/ppad-sha256.cabal b/ppad-sha256.cabal --- a/ppad-sha256.cabal +++ b/ppad-sha256.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-sha256 -version: 0.3.6 +version: 0.3.7 synopsis: The SHA-256 and HMAC-SHA256 algorithms license: MIT license-file: LICENSE diff --git a/test/Property.hs b/test/Property.hs --- a/test/Property.hs +++ b/test/Property.hs @@ -68,6 +68,15 @@ l <- Q.chooseInt (0, 8 * 64) Msg . BS.pack <$> Q.vectorOf l Q.arbitrary +-- block-aligned prefixes +newtype Prefix = Prefix BS.ByteString + deriving Show + +instance Q.Arbitrary Prefix where + arbitrary = do + k <- Q.chooseInt (0, 3) + Prefix . BS.pack <$> Q.vectorOf (k * 64) Q.arbitrary + -- register-sized strings newtype Bytes32 = Bytes32 BS.ByteString deriving Show @@ -101,6 +110,17 @@ hash_matches_pure :: Msg -> Bool hash_matches_pure (Msg m) = hash m == Pure.hash m +hash_prefixed_matches_hash :: Prefix -> Msg -> Bool +hash_prefixed_matches_hash (Prefix p) (Msg m) = + let expected = hash (p <> m) + in hash_prefixed p m == expected && Pure.hash_prefixed p m == expected + +-- unaligned prefixes fall back to hashing the concatenation +hash_prefixed_unaligned :: Msg -> Msg -> Bool +hash_prefixed_unaligned (Msg p) (Msg m) = + let expected = hash (p <> m) + in hash_prefixed p m == expected && Pure.hash_prefixed p m == expected + hmac_matches_pure :: Msg -> Msg -> Bool hmac_matches_pure (Msg k) (Msg m) = unmac (hmac k m) == Pure.hmac k m @@ -132,6 +152,17 @@ H.assertBool mempty $ all (\l -> hash (msg l) == Pure.hash (msg l)) [0 .. 3 * 64] +hash_prefixed_all_lengths :: TestTree +hash_prefixed_all_lengths = + H.testCase "hash_prefixed ~ hash (all lengths)" $ + H.assertBool mempty $ and [ + hash_prefixed p (msg l) == e && Pure.hash_prefixed p (msg l) == e + | k <- [0 .. 2] + , l <- [0 .. 3 * 64] + , let p = BS.reverse (msg (k * 64)) + e = hash (p <> msg l) + ] + hmac_all_lengths :: TestTree hmac_all_lengths = H.testCase "hmac ~ Pure.hmac (all lengths)" $ H.assertBool mempty $ @@ -174,6 +205,10 @@ , testGroup "dispatch ~ pure" [ Q.testProperty "hash ~ Pure.hash" $ Q.withMaxSuccess 1000 hash_matches_pure + , Q.testProperty "hash_prefixed p m ~ hash (p <> m)" $ + Q.withMaxSuccess 1000 hash_prefixed_matches_hash + , Q.testProperty "hash_prefixed p m ~ hash (p <> m) (unaligned)" $ + Q.withMaxSuccess 1000 hash_prefixed_unaligned , Q.testProperty "hmac ~ Pure.hmac" $ Q.withMaxSuccess 1000 hmac_matches_pure , Q.testProperty "_hmac_rr k m ~ hmac (cat k) (cat m)" $ @@ -181,6 +216,7 @@ , Q.testProperty "_hmac_rsb k v s d ~ hmac (cat k) (cat v <> s <> d)" $ Q.withMaxSuccess 1000 hmac_rsb_matches_hmac , hash_all_lengths + , hash_prefixed_all_lengths , hmac_all_lengths , hmac_all_key_lengths , hmac_rsb_all_lengths