sha256

Pure Haskell SHA-256, HMAC-SHA256 as specified by RFC's 6234 and 2104.
git clone git://git.ppad.tech/sha256.git
Log | Files | Refs | README | LICENSE

commit 83463c2f9fd6779eeac6649b0df72a459372197f
parent fa894763f81fca955438dd94f12f83dc5fc32925
Author: Jared Tobin <jared@jtobin.io>
Date:   Sat, 14 Sep 2024 00:22:52 +0400

lib: remove old lifted code

Diffstat:
MREADME.md | 5+++--
Mlib/Crypto/Hash/SHA256.hs | 314++++++++++---------------------------------------------------------------------
2 files changed, 40 insertions(+), 279 deletions(-)

diff --git a/README.md b/README.md @@ -150,8 +150,9 @@ to get a REPL for the main library. ## Attribution -This implementation has benefitted from the [SHA][hacka] package -available on Hackage, which was used as a reference during development. +This implementation has benefitted immensely from the [SHA][hacka] +package available on Hackage, which was used as a reference during +development. Many parts wound up as direct translations. [nixos]: https://nixos.org/ [flake]: https://nixos.org/manual/nix/unstable/command-ref/new-cli/nix3-flake.html diff --git a/lib/Crypto/Hash/SHA256.hs b/lib/Crypto/Hash/SHA256.hs @@ -29,7 +29,7 @@ module Crypto.Hash.SHA256 ( ) where import qualified Data.Bits as B -import Data.Bits ((.&.), (.|.)) +import Data.Bits ((.|.)) import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as BSB import qualified Data.ByteString.Builder.Extra as BE @@ -37,7 +37,6 @@ import qualified Data.ByteString.Internal as BI import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Internal as BLI import qualified Data.ByteString.Unsafe as BU -import qualified Data.List as L import Data.Word (Word32, Word64) import Foreign.ForeignPtr (plusForeignPtr) import GHC.Exts (Word32#, Int#) @@ -54,17 +53,6 @@ p32# :: Word32# -> Word32# -> Word32# p32# = E.plusWord32# {-# INLINE p32# #-} --- break a bytestring into blocks of the specified bytelength -blocks :: Int -> BS.ByteString -> [BS.ByteString] -blocks s = blocks_lazy s . BL.fromStrict - -blocks_lazy :: Int -> BL.ByteString -> [BS.ByteString] -blocks_lazy s = loop where - loop bs - | BL.null bs = [] - | otherwise = case BL.splitAt (fi s) bs of - (c, r) -> BL.toStrict c : loop r - -- unsafe parse, strict ByteString to Word32 (verbatim from Data.Binary) word32be :: BS.ByteString -> Word32 word32be s = @@ -80,7 +68,7 @@ data SLPair = SLPair {-# UNPACK #-} !BS.ByteString !BL.ByteString data WSPair = WSPair {-# UNPACK #-} !Word32 {-# UNPACK #-} !BS.ByteString --- a variant of Data.ByteString.Lazy.splitAt that returns the initial +-- variant of Data.ByteString.Lazy.splitAt that returns the initial -- component as a strict, unboxed ByteString splitAt64 :: BL.ByteString -> SLPair splitAt64 = splitAt' (64 :: Int) where @@ -92,10 +80,8 @@ splitAt64 = splitAt' (64 :: Int) where let SLPair cs' cs'' = splitAt' (n - fi (BS.length c)) cs in SLPair (c <> cs') cs'' --- this unsafe function turns Data.ByteString.splitAt into an --- incremental Word32 parser; the initial 32 bits are parsed to an --- unboxed Word32, and the rest of the ByteString is returned strict and --- unboxed +-- variant of Data.ByteString.splitAt that behaves like an incremental +-- Word32 parser parseWord32 :: BS.ByteString -> WSPair parseWord32 (BI.BS x l) = WSPair (word32be (BI.BS x 4)) (BI.BS (plusForeignPtr x 4) (l - 4)) @@ -135,13 +121,11 @@ unsafeShiftR# :: Word32# -> Int# -> Word32# unsafeShiftR# x# i# = E.wordToWord32# ((E.word32ToWord# x#) `E.uncheckedShiftRL#` i#) --- unbox a Word32 unW32 :: Word32 -> Word32# unW32 (fi -> i) = case i of E.I# i# -> E.wordToWord32# (E.int2Word# i#) {-# INLINE unW32 #-} --- box a Word32 lw32 :: Word32# -> Word32 lw32 w = fi (E.I# (E.word2Int# (E.word32ToWord# w))) {-# INLINE lw32 #-} @@ -151,9 +135,11 @@ lw32 w = fi (E.I# (E.word2Int# (E.word32ToWord# w))) -- k such that (l + 1 + k) mod 64 = 56 sol :: Word64 -> Word64 -sol l = let r = 56 - fi l `mod` 64 - 1 :: Integer -- fi prevents underflow - in fi (if r < 0 then r + 64 else r) +sol l = + let r = 56 - fi l `mod` 64 - 1 :: Integer -- fi prevents underflow + in fi (if r < 0 then r + 64 else r) +-- RFC 6234 4.1 (strict) pad :: BS.ByteString -> BS.ByteString pad m = BL.toStrict . BSB.toLazyByteString $ padded where l = fi (BS.length m) @@ -164,7 +150,7 @@ pad m = BL.toStrict . BSB.toLazyByteString $ padded where | j == 0 = acc <> BSB.word64BE (l * 8) | otherwise = fill (pred j) (acc <> BSB.word8 0x00) --- hat tip to hackage SHA authors for traversal strategy +-- RFC 6234 4.1 (lazy) pad_lazy :: BL.ByteString -> BL.ByteString pad_lazy (BL.toChunks -> m) = BL.fromChunks (walk 0 m) where -- walk chunks, calculating length and appending padding @@ -177,7 +163,9 @@ pad_lazy (BL.toChunks -> m) = BL.fromChunks (walk 0 m) where | k == 0 = pure . BL.toStrict - . BE.toLazyByteStringWith (BE.safeStrategy 128 BE.smallChunkSize) mempty + -- more efficient for small builder + . BE.toLazyByteStringWith + (BE.safeStrategy 128 BE.smallChunkSize) mempty $ bs <> BSB.word64BE (l * 8) | otherwise = let nacc = bs <> BSB.word8 0x00 @@ -186,33 +174,6 @@ pad_lazy (BL.toChunks -> m) = BL.fromChunks (walk 0 m) where -- functions and constants used -- https://datatracker.ietf.org/doc/html/rfc6234#section-5.1 -ch :: Word32 -> Word32 -> Word32 -> Word32 -ch x y z = (x .&. y) `B.xor` (B.complement x .&. z) - --- credit to SHA authors for the following optimisation. their text: --- --- > note: --- > the original functions is (x & y) ^ (x & z) ^ (y & z) --- > if you fire off truth tables, this is equivalent to --- > (x & y) | (x & z) | (y & z) --- > which you can the use distribution on: --- > (x & (y | z)) | (y & z) --- > which saves us one operation. -maj :: Word32 -> Word32 -> Word32 -> Word32 -maj x y z = (x .&. (y .|. z)) .|. (y .&. z) - -bsig0 :: Word32 -> Word32 -bsig0 x = B.rotateR x 2 `B.xor` B.rotateR x 13 `B.xor` B.rotateR x 22 - -bsig1 :: Word32 -> Word32 -bsig1 x = B.rotateR x 6 `B.xor` B.rotateR x 11 `B.xor` B.rotateR x 25 - -ssig0 :: Word32 -> Word32 -ssig0 x = B.rotateR x 7 `B.xor` B.rotateR x 18 `B.xor` B.unsafeShiftR x 3 - -ssig1 :: Word32 -> Word32 -ssig1 x = B.rotateR x 17 `B.xor` B.rotateR x 19 `B.xor` B.unsafeShiftR x 10 - ch# :: Word32# -> Word32# -> Word32# -> Word32# ch# x# y# z# = (x# .&.# y#) .^.# (complement# x# .&.# z#) {-# INLINE ch# #-} @@ -246,27 +207,7 @@ ssig1# :: Word32# -> Word32# ssig1# x# = rotateR# x# 17# .^.# rotateR# x# 19# .^.# unsafeShiftR# x# 10# {-# INLINE ssig1# #-} -data Schedule = Schedule { - w00 :: !Word32, w01 :: !Word32, w02 :: !Word32, w03 :: !Word32 - , w04 :: !Word32, w05 :: !Word32, w06 :: !Word32, w07 :: !Word32 - , w08 :: !Word32, w09 :: !Word32, w10 :: !Word32, w11 :: !Word32 - , w12 :: !Word32, w13 :: !Word32, w14 :: !Word32, w15 :: !Word32 - , w16 :: !Word32, w17 :: !Word32, w18 :: !Word32, w19 :: !Word32 - , w20 :: !Word32, w21 :: !Word32, w22 :: !Word32, w23 :: !Word32 - , w24 :: !Word32, w25 :: !Word32, w26 :: !Word32, w27 :: !Word32 - , w28 :: !Word32, w29 :: !Word32, w30 :: !Word32, w31 :: !Word32 - , w32 :: !Word32, w33 :: !Word32, w34 :: !Word32, w35 :: !Word32 - , w36 :: !Word32, w37 :: !Word32, w38 :: !Word32, w39 :: !Word32 - , w40 :: !Word32, w41 :: !Word32, w42 :: !Word32, w43 :: !Word32 - , w44 :: !Word32, w45 :: !Word32, w46 :: !Word32, w47 :: !Word32 - , w48 :: !Word32, w49 :: !Word32, w50 :: !Word32, w51 :: !Word32 - , w52 :: !Word32, w53 :: !Word32, w54 :: !Word32, w55 :: !Word32 - , w56 :: !Word32, w57 :: !Word32, w58 :: !Word32, w59 :: !Word32 - , w60 :: !Word32, w61 :: !Word32, w62 :: !Word32, w63 :: !Word32 - } deriving (Eq, Show) - --- unboxed 64-tuple (message schedule) -type Sd = (# +type Schedule = (# Word32#, Word32#, Word32#, Word32#, Word32#, Word32#, Word32#, Word32# , Word32#, Word32#, Word32#, Word32#, Word32#, Word32#, Word32#, Word32# , Word32#, Word32#, Word32#, Word32#, Word32#, Word32#, Word32#, Word32# @@ -277,110 +218,19 @@ type Sd = (# , Word32#, Word32#, Word32#, Word32#, Word32#, Word32#, Word32#, Word32# #) --- unboxed 8-tuple (registers) -type Rs = (# - Word32#, Word32#, Word32#, Word32# - , Word32#, Word32#, Word32#, Word32# - #) - --- unboxed 16-tuple (block) -type Bl = (# +type Registers = (# Word32#, Word32#, Word32#, Word32#, Word32#, Word32#, Word32#, Word32# - , Word32#, Word32#, Word32#, Word32#, Word32#, Word32#, Word32#, Word32# #) -choose_w :: Schedule -> Int -> Word32 -choose_w s = \case - 0 -> w00 s; 1 -> w01 s; 2 -> w02 s; 3 -> w03 s - 4 -> w04 s; 5 -> w05 s; 6 -> w06 s; 7 -> w07 s - 8 -> w08 s; 9 -> w09 s; 10 -> w10 s; 11 -> w11 s - 12 -> w12 s; 13 -> w13 s; 14 -> w14 s; 15 -> w15 s - 16 -> w16 s; 17 -> w17 s; 18 -> w18 s; 19 -> w19 s - 20 -> w20 s; 21 -> w21 s; 22 -> w22 s; 23 -> w23 s - 24 -> w24 s; 25 -> w25 s; 26 -> w26 s; 27 -> w27 s - 28 -> w28 s; 29 -> w29 s; 30 -> w30 s; 31 -> w31 s - 32 -> w32 s; 33 -> w33 s; 34 -> w34 s; 35 -> w35 s - 36 -> w36 s; 37 -> w37 s; 38 -> w38 s; 39 -> w39 s - 40 -> w40 s; 41 -> w41 s; 42 -> w42 s; 43 -> w43 s - 44 -> w44 s; 45 -> w45 s; 46 -> w46 s; 47 -> w47 s - 48 -> w48 s; 49 -> w49 s; 50 -> w50 s; 51 -> w51 s - 52 -> w52 s; 53 -> w53 s; 54 -> w54 s; 55 -> w55 s - 56 -> w56 s; 57 -> w57 s; 58 -> w58 s; 59 -> w59 s - 60 -> w60 s; 61 -> w61 s; 62 -> w62 s; 63 -> w63 s - _ -> error "ppad-sha256: internal error (invalid schedule index)" - --- k0-k63 are the first 32 bits of the fractional parts of the cube --- roots of the first sixty-four prime numbers -choose_k :: Int -> Word32 -choose_k = \case - 0 -> 0x428a2f98; 1 -> 0x71374491; 2 -> 0xb5c0fbcf; 3 -> 0xe9b5dba5 - 4 -> 0x3956c25b; 5 -> 0x59f111f1; 6 -> 0x923f82a4; 7 -> 0xab1c5ed5 - 8 -> 0xd807aa98; 9 -> 0x12835b01; 10 -> 0x243185be; 11 -> 0x550c7dc3 - 12 -> 0x72be5d74; 13 -> 0x80deb1fe; 14 -> 0x9bdc06a7; 15 -> 0xc19bf174 - 16 -> 0xe49b69c1; 17 -> 0xefbe4786; 18 -> 0x0fc19dc6; 19 -> 0x240ca1cc - 20 -> 0x2de92c6f; 21 -> 0x4a7484aa; 22 -> 0x5cb0a9dc; 23 -> 0x76f988da - 24 -> 0x983e5152; 25 -> 0xa831c66d; 26 -> 0xb00327c8; 27 -> 0xbf597fc7 - 28 -> 0xc6e00bf3; 29 -> 0xd5a79147; 30 -> 0x06ca6351; 31 -> 0x14292967 - 32 -> 0x27b70a85; 33 -> 0x2e1b2138; 34 -> 0x4d2c6dfc; 35 -> 0x53380d13 - 36 -> 0x650a7354; 37 -> 0x766a0abb; 38 -> 0x81c2c92e; 39 -> 0x92722c85 - 40 -> 0xa2bfe8a1; 41 -> 0xa81a664b; 42 -> 0xc24b8b70; 43 -> 0xc76c51a3 - 44 -> 0xd192e819; 45 -> 0xd6990624; 46 -> 0xf40e3585; 47 -> 0x106aa070 - 48 -> 0x19a4c116; 49 -> 0x1e376c08; 50 -> 0x2748774c; 51 -> 0x34b0bcb5 - 52 -> 0x391c0cb3; 53 -> 0x4ed8aa4a; 54 -> 0x5b9cca4f; 55 -> 0x682e6ff3 - 56 -> 0x748f82ee; 57 -> 0x78a5636f; 58 -> 0x84c87814; 59 -> 0x8cc70208 - 60 -> 0x90befffa; 61 -> 0xa4506ceb; 62 -> 0xbef9a3f7; 63 -> 0xc67178f2 - _ -> error "ppad-sha256: internal error (invalid constant index)" - --- initialization --- https://datatracker.ietf.org/doc/html/rfc6234#section-6.1 - -data Registers = Registers { - h0 :: !Word32, h1 :: !Word32, h2 :: !Word32, h3 :: !Word32 - , h4 :: !Word32, h5 :: !Word32, h6 :: !Word32, h7 :: !Word32 - } deriving (Eq, Show) - --- first 32 bits of the fractional parts of the square roots of the --- first eight primes -iv :: Registers -iv = Registers - 0x6a09e667 0xbb67ae85 0x3c6ef372 0xa54ff53a - 0x510e527f 0x9b05688c 0x1f83d9ab 0x5be0cd19 - -- processing -- https://datatracker.ietf.org/doc/html/rfc6234#section-6.2 -data Block = Block { - m00 :: !Word32, m01 :: !Word32, m02 :: !Word32, m03 :: !Word32 - , m04 :: !Word32, m05 :: !Word32, m06 :: !Word32, m07 :: !Word32 - , m08 :: !Word32, m09 :: !Word32, m10 :: !Word32, m11 :: !Word32 - , m12 :: !Word32, m13 :: !Word32, m14 :: !Word32, m15 :: !Word32 - } deriving (Eq, Show) - --- parse a 512-bit block into sixteen 32-bit words -parse :: BS.ByteString -> Block -parse bs = - let (word32be -> m00, t00) = BS.splitAt 4 bs - (word32be -> m01, t01) = BS.splitAt 4 t00 - (word32be -> m02, t02) = BS.splitAt 4 t01 - (word32be -> m03, t03) = BS.splitAt 4 t02 - (word32be -> m04, t04) = BS.splitAt 4 t03 - (word32be -> m05, t05) = BS.splitAt 4 t04 - (word32be -> m06, t06) = BS.splitAt 4 t05 - (word32be -> m07, t07) = BS.splitAt 4 t06 - (word32be -> m08, t08) = BS.splitAt 4 t07 - (word32be -> m09, t09) = BS.splitAt 4 t08 - (word32be -> m10, t10) = BS.splitAt 4 t09 - (word32be -> m11, t11) = BS.splitAt 4 t10 - (word32be -> m12, t12) = BS.splitAt 4 t11 - (word32be -> m13, t13) = BS.splitAt 4 t12 - (word32be -> m14, t14) = BS.splitAt 4 t13 - (word32be -> m15, t15) = BS.splitAt 4 t14 - in if BS.null t15 - then Block {..} - else error "ppad-sha256: internal error (bytes remaining)" +type Block = (# + Word32#, Word32#, Word32#, Word32#, Word32#, Word32#, Word32#, Word32# + , Word32#, Word32#, Word32#, Word32#, Word32#, Word32#, Word32#, Word32# + #) --- parse a 512-bit block into sixteen 32-bit words -parse# :: BS.ByteString -> Bl +parse# :: BS.ByteString -> Block parse# bs = let !(WSPair (unW32 -> m00) t00) = parseWord32 bs !(WSPair (unW32 -> m01) t01) = parseWord32 t00 @@ -405,75 +255,7 @@ parse# bs = else error "ppad-sha256: internal error (bytes remaining)" -- RFC 6234 6.2 step 1 -prepare_schedule :: Block -> Schedule -prepare_schedule Block {..} = Schedule {..} where - w00 = m00 - w01 = m01 - w02 = m02 - w03 = m03 - w04 = m04 - w05 = m05 - w06 = m06 - w07 = m07 - w08 = m08 - w09 = m09 - w10 = m10 - w11 = m11 - w12 = m12 - w13 = m13 - w14 = m14 - w15 = m15 - w16 = ssig1 w14 + w09 + ssig0 w01 + w00 - w17 = ssig1 w15 + w10 + ssig0 w02 + w01 - w18 = ssig1 w16 + w11 + ssig0 w03 + w02 - w19 = ssig1 w17 + w12 + ssig0 w04 + w03 - w20 = ssig1 w18 + w13 + ssig0 w05 + w04 - w21 = ssig1 w19 + w14 + ssig0 w06 + w05 - w22 = ssig1 w20 + w15 + ssig0 w07 + w06 - w23 = ssig1 w21 + w16 + ssig0 w08 + w07 - w24 = ssig1 w22 + w17 + ssig0 w09 + w08 - w25 = ssig1 w23 + w18 + ssig0 w10 + w09 - w26 = ssig1 w24 + w19 + ssig0 w11 + w10 - w27 = ssig1 w25 + w20 + ssig0 w12 + w11 - w28 = ssig1 w26 + w21 + ssig0 w13 + w12 - w29 = ssig1 w27 + w22 + ssig0 w14 + w13 - w30 = ssig1 w28 + w23 + ssig0 w15 + w14 - w31 = ssig1 w29 + w24 + ssig0 w16 + w15 - w32 = ssig1 w30 + w25 + ssig0 w17 + w16 - w33 = ssig1 w31 + w26 + ssig0 w18 + w17 - w34 = ssig1 w32 + w27 + ssig0 w19 + w18 - w35 = ssig1 w33 + w28 + ssig0 w20 + w19 - w36 = ssig1 w34 + w29 + ssig0 w21 + w20 - w37 = ssig1 w35 + w30 + ssig0 w22 + w21 - w38 = ssig1 w36 + w31 + ssig0 w23 + w22 - w39 = ssig1 w37 + w32 + ssig0 w24 + w23 - w40 = ssig1 w38 + w33 + ssig0 w25 + w24 - w41 = ssig1 w39 + w34 + ssig0 w26 + w25 - w42 = ssig1 w40 + w35 + ssig0 w27 + w26 - w43 = ssig1 w41 + w36 + ssig0 w28 + w27 - w44 = ssig1 w42 + w37 + ssig0 w29 + w28 - w45 = ssig1 w43 + w38 + ssig0 w30 + w29 - w46 = ssig1 w44 + w39 + ssig0 w31 + w30 - w47 = ssig1 w45 + w40 + ssig0 w32 + w31 - w48 = ssig1 w46 + w41 + ssig0 w33 + w32 - w49 = ssig1 w47 + w42 + ssig0 w34 + w33 - w50 = ssig1 w48 + w43 + ssig0 w35 + w34 - w51 = ssig1 w49 + w44 + ssig0 w36 + w35 - w52 = ssig1 w50 + w45 + ssig0 w37 + w36 - w53 = ssig1 w51 + w46 + ssig0 w38 + w37 - w54 = ssig1 w52 + w47 + ssig0 w39 + w38 - w55 = ssig1 w53 + w48 + ssig0 w40 + w39 - w56 = ssig1 w54 + w49 + ssig0 w41 + w40 - w57 = ssig1 w55 + w50 + ssig0 w42 + w41 - w58 = ssig1 w56 + w51 + ssig0 w43 + w42 - w59 = ssig1 w57 + w52 + ssig0 w44 + w43 - w60 = ssig1 w58 + w53 + ssig0 w45 + w44 - w61 = ssig1 w59 + w54 + ssig0 w46 + w45 - w62 = ssig1 w60 + w55 + ssig0 w47 + w46 - w63 = ssig1 w61 + w56 + ssig0 w48 + w47 - --- RFC 6234 6.2 step 1 -prepare_schedule# :: Bl -> Sd +prepare_schedule# :: Block -> Schedule prepare_schedule# b = case b of (# m00, m01, m02, m03, m04, m05, m06, m07, m08, m09, m10, m11, m12, m13, m14, m15 #) -> @@ -540,20 +322,7 @@ prepare_schedule# b = case b of #) -- RFC 6234 6.2 steps 2, 3, 4 -block_hash :: Registers -> Schedule -> Registers -block_hash r@Registers {..} s = loop 0 r where - loop t (Registers a b c d e f g h) - | t == 64 = Registers { - h0 = a + h0, h1 = b + h1, h2 = c + h2, h3 = d + h3 - , h4 = e + h4, h5 = f + h5, h6 = g + h6, h7 = h + h7 - } - | otherwise = - let t1 = h + bsig1 e + ch e f g + choose_k t + choose_w s t - t2 = bsig0 a + maj a b c - nacc = Registers (t1 + t2) a b c (d + t1) e f g - in loop (succ t) nacc - -block_hash# :: Rs -> Sd -> Rs +block_hash# :: Registers -> Schedule -> Registers block_hash# r00@(# h0, h1, h2, h3, h4, h5, h6, h7 #) s# = case s# of (# w00, w01, w02, w03, w04, w05, w06, w07, w08, w09, w10, w11, w12, w13, w14, w15, @@ -563,6 +332,8 @@ block_hash# r00@(# h0, h1, h2, h3, h4, h5, h6, h7 #) s# = case s# of w40, w41, w42, w43, w44, w45, w46, w47, w48, w49, w50, w51, w52, w53, w54, w55, w56, w57, w58, w59, w60, w61, w62, w63 #) -> + -- constants are the first 32 bits of the fractional parts of the + -- cube roots of the first sixty-four prime numbers let r01 = step# r00 0x428a2f98#Word32 w00 r02 = step# r01 0x71374491#Word32 w01 r03 = step# r02 0xb5c0fbcf#Word32 w02 @@ -631,10 +402,8 @@ block_hash# r00@(# h0, h1, h2, h3, h4, h5, h6, h7 #) s# = case s# of in (# p32# a h0, p32# b h1, p32# c h2, p32# d h3 , p32# e h4, p32# f h5, p32# g h6, p32# h h7 #) -{-# SCC block_hash# #-} --- translation of SHA's step256 -step# :: Rs -> Word32# -> Word32# -> Rs +step# :: Registers -> Word32# -> Word32# -> Registers step# (# a, b, c, d, e, f, g, h #) k w = let t1 = p32# h (p32# (bsig1# e) (p32# (ch# e f g) (p32# k w))) t2 = p32# (bsig0# a) (maj# a b c) @@ -649,31 +418,14 @@ step# (# a, b, c, d, e, f, g, h #) k w = in (# a#, b#, c#, d#, e#, f#, g#, h# #) -- RFC 6234 6.2 block pipeline -hash_alg :: Registers -> BS.ByteString -> Registers -hash_alg rs = block_hash rs . prepare_schedule . parse - -hash_alg# :: Rs -> BS.ByteString -> Rs +hash_alg# :: Registers -> BS.ByteString -> Registers hash_alg# rs bs = block_hash# rs (prepare_schedule# (parse# bs)) -- register concatenation -cat :: Registers -> BS.ByteString -cat Registers {..} = - BL.toStrict - . BE.toLazyByteStringWith (BE.safeStrategy 128 BE.smallChunkSize) mempty - $ mconcat [ - BSB.word32BE h0 - , BSB.word32BE h1 - , BSB.word32BE h2 - , BSB.word32BE h3 - , BSB.word32BE h4 - , BSB.word32BE h5 - , BSB.word32BE h6 - , BSB.word32BE h7 - ] - -cat# :: Rs -> BS.ByteString +cat# :: Registers -> BS.ByteString cat# (# h0, h1, h2, h3, h4, h5, h6, h7 #) = BL.toStrict + -- more efficient for small builder . BE.toLazyByteStringWith (BE.safeStrategy 128 BE.smallChunkSize) mempty $ mconcat [ BSB.word32BE (lw32 h0) @@ -695,6 +447,10 @@ cat# (# h0, h1, h2, h3, h4, h5, h6, h7 #) = -- "<strict 256-bit message digest>" hash :: BS.ByteString -> BS.ByteString hash bs = cat# (go r_iv (pad bs)) where + -- https://datatracker.ietf.org/doc/html/rfc6234#section-6.1 + -- + -- first 32 bits of the fractional parts of the square roots of the + -- first eight primes r_iv = (# 0x6a09e667#Word32, 0xbb67ae85#Word32 , 0x3c6ef372#Word32, 0xa54ff53a#Word32 @@ -702,7 +458,7 @@ hash bs = cat# (go r_iv (pad bs)) where , 0x1f83d9ab#Word32, 0x5be0cd19#Word32 #) - go :: Rs -> BS.ByteString -> Rs + go :: Registers -> BS.ByteString -> Registers go !acc b | BS.null b = acc | otherwise = case BS.splitAt 64 b of @@ -717,6 +473,10 @@ hash bs = cat# (go r_iv (pad bs)) where -- "<strict 256-bit message digest>" hash_lazy :: BL.ByteString -> BS.ByteString hash_lazy bl = cat# (go r_iv (pad_lazy bl)) where + -- https://datatracker.ietf.org/doc/html/rfc6234#section-6.1 + -- + -- first 32 bits of the fractional parts of the square roots of the + -- first eight primes r_iv = (# 0x6a09e667#Word32, 0xbb67ae85#Word32 , 0x3c6ef372#Word32, 0xa54ff53a#Word32 @@ -724,7 +484,7 @@ hash_lazy bl = cat# (go r_iv (pad_lazy bl)) where , 0x1f83d9ab#Word32, 0x5be0cd19#Word32 #) - go :: Rs -> BL.ByteString -> Rs + go :: Registers -> BL.ByteString -> Registers go !acc bs | BL.null bs = acc | otherwise = case splitAt64 bs of