commit 381a22f0089883c4caf00c67eba10ff59cefa1c1
parent a59d3770529a4236dadc111ffbf484983d718e82
Author: Jared Tobin <jared@jtobin.io>
Date: Mon, 9 Sep 2024 12:09:24 +0400
lib: implement RFC 6234 4.1-6.1
Diffstat:
1 file changed, 127 insertions(+), 97 deletions(-)
diff --git a/lib/Crypto/Hash/SHA256.hs b/lib/Crypto/Hash/SHA256.hs
@@ -1,102 +1,132 @@
{-# OPTIONS_GHC -funbox-small-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
module Crypto.Hash.SHA256 where
--- import qualified Data.Binary as I
--- import qualified Data.Binary.Get as I
--- import qualified Data.Binary.Put as I
--- import qualified Data.Bits as B
--- import Data.Bits ((.|.), (.&.))
--- import Data.Word (Word32)
---
--- data SHA256S = SHA256S
--- !Word32 !Word32 !Word32 !Word32
--- !Word32 !Word32 !Word32 !Word32
---
--- sha256_iv :: SHA256S
--- sha256_iv = SHA256S
--- 0x6a09e667 0xbb67ae85 0x3c6ef372 0xa54ff53a
--- 0x510e527f 0x9b05688c 0x1f83d9ab 0x5be0cd19
---
--- data SHA256 = SHA256
--- !Word32 !Word32 !Word32 !Word32 !Word32 -- 00-04
--- !Word32 !Word32 !Word32 !Word32 !Word32 -- 05-09
--- !Word32 !Word32 !Word32 !Word32 !Word32 -- 10-04
--- !Word32 !Word32 !Word32 !Word32 !Word32 -- 15-09
--- !Word32 !Word32 !Word32 !Word32 !Word32 -- 20-04
--- !Word32 !Word32 !Word32 !Word32 !Word32 -- 25-09
--- !Word32 !Word32 !Word32 !Word32 !Word32 -- 30-04
--- !Word32 !Word32 !Word32 !Word32 !Word32 -- 35-09
--- !Word32 !Word32 !Word32 !Word32 !Word32 -- 40-04
--- !Word32 !Word32 !Word32 !Word32 !Word32 -- 45-09
--- !Word32 !Word32 !Word32 !Word32 !Word32 -- 50-04
--- !Word32 !Word32 !Word32 !Word32 !Word32 -- 55-09
--- !Word32 !Word32 !Word32 !Word32 -- 60-63
--- deriving Show
---
--- putsha256 :: SHA256S -> I.Put
--- putsha256 (SHA256S a b c d e f g h) = do
--- I.putWord32be a
--- I.putWord32be b
--- I.putWord32be c
--- I.putWord32be d
--- I.putWord32be e
--- I.putWord32be f
--- I.putWord32be g
--- I.putWord32be h
---
--- getSHA256 :: I.Get SHA256S
--- getSHA256 = do
--- a <- I.getWord32be
--- b <- I.getWord32be
--- c <- I.getWord32be
--- d <- I.getWord32be
--- e <- I.getWord32be
--- f <- I.getWord32be
--- g <- I.getWord32be
--- h <- I.getWord32be
--- return $! SHA256S a b c d e f g h
---
--- step :: SHA256S -> Word32 -> Word32 -> SHA256S
--- step !(SHA256S a b c d e f g h) k w = SHA256S a' b' c' d' e' f' g' h'
--- where
--- t1 = h + bsig1 e + ch e f g + k + w
--- t2 = bsig0 a + maj a b c
--- h' = g
--- g' = f
--- f' = e
--- e' = d + t1
--- d' = c
--- c' = b
--- b' = a
--- a' = t1 + t2
--- {-# INLINE step #-}
---
--- 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
---
--- lsig0 :: Word32 -> Word32
--- lsig0 x = B.rotateR x 7 `B.xor` B.rotateR x 18 `B.xor` B.shiftR x 3
---
--- lsig1 :: Word32 -> Word32
--- lsig1 x = B.rotateR x 17 `B.xor` B.rotateR x 19 `B.xor` B.shiftR x 10
---
--- -- choice, a ? b : c
--- ch :: Word32 -> Word32 -> Word32 -> Word32
--- ch x y z = (x .&. y) `B.xor` (B.complement x .&. z)
---
--- -- majority, (x & y) ^ (x & z) ^ (y & z)
--- --
--- -- XX from original
--- --
--- -- > 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:
--- maj :: Word32 -> Word32 -> Word32 -> Word32
--- maj x y z = (x .&. (y .|. z)) .|. (y .&. z)
+import qualified Data.Bits as B
+import Data.Bits ((.&.))
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Builder as BSB
+import qualified Data.ByteString.Lazy as BSL
+import Data.Word (Word32, Word64)
+
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral
+
+-- message padding and parsing
+-- https://datatracker.ietf.org/doc/html/rfc6234#section-4.1
+
+pad :: BSL.ByteString -> BSL.ByteString
+pad (BSL.toChunks -> m) = con 0 mempty m where
+ -- consume input, calculating bytelength and accumulating result
+ con !l acc = \case
+ (c:cs) ->
+ let nl = l + fi (BS.length c)
+ nacc = acc <> BSB.byteString c
+ in con nl nacc cs
+
+ [] ->
+ let k = sol l
+ don = fin l k (acc <> BSB.word8 0x80)
+ in BSB.toLazyByteString don
+
+ -- K, where (L + 1 + K) ≅ 56 (mod 64)
+ sol :: Word64 -> Word64
+ sol l =
+ let r :: Integer
+ r = 56 - fi l - 1 -- fi prevents potential underflow
+ in fi $ if r < 0 then r + 64 else r
+
+ -- finalize padding, given bytelength
+ fin l k acc
+ | k == 0 = acc <> BSB.word64BE (l * 8)
+ | otherwise =
+ let nacc = acc <> BSB.word8 0x00
+ in fin l (pred k) nacc
+
+-- functions and constants used
+-- https://datatracker.ietf.org/doc/html/rfc6234#section-5.1
+
+-- choice, a ? b : c
+ch :: Word32 -> Word32 -> Word32 -> Word32
+ch x y z = (x .&. y) `B.xor` (B.complement x .&. z)
+
+-- majority, (x & y) ^ (x & z) ^ (y & z)
+maj :: Word32 -> Word32 -> Word32 -> Word32
+maj x y z = (x .&. y) `B.xor` (x .&. z) `B.xor` (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.shiftR x 3
+
+ssig1 :: Word32 -> Word32
+ssig1 x = B.rotateR x 17 `B.xor` B.rotateR x 19 `B.xor` B.shiftR x 10
+
+data SHA256 = SHA256
+ !Word32 !Word32 !Word32 !Word32
+ !Word32 !Word32 !Word32 !Word32
+ !Word32 !Word32 !Word32 !Word32
+ !Word32 !Word32 !Word32 !Word32
+ !Word32 !Word32 !Word32 !Word32
+ !Word32 !Word32 !Word32 !Word32
+ !Word32 !Word32 !Word32 !Word32
+ !Word32 !Word32 !Word32 !Word32
+ !Word32 !Word32 !Word32 !Word32
+ !Word32 !Word32 !Word32 !Word32
+ !Word32 !Word32 !Word32 !Word32
+ !Word32 !Word32 !Word32 !Word32
+ !Word32 !Word32 !Word32 !Word32
+ !Word32 !Word32 !Word32 !Word32
+ !Word32 !Word32 !Word32 !Word32
+ !Word32 !Word32 !Word32 !Word32
+ deriving (Eq, Show)
+
+-- first 32 bits of the fractional parts of the cube roots of the first
+-- sixty-four primes
+sha256_constants :: SHA256
+sha256_constants = SHA256
+ 0x428a2f98 0x3956c25b 0xd807aa98 0x72be5d74
+ 0xe49b69c1 0x2de92c6f 0x983e5152 0xc6e00bf3
+ 0x27b70a85 0x650a7354 0xa2bfe8a1 0xd192e819
+ 0x19a4c116 0x391c0cb3 0x748f82ee 0x90befffa
+ 0x71374491 0x59f111f1 0x12835b01 0x80deb1fe
+ 0xefbe4786 0x4a7484aa 0xa831c66d 0xd5a79147
+ 0x2e1b2138 0x766a0abb 0xa81a664b 0xd6990624
+ 0x1e376c08 0x4ed8aa4a 0x78a5636f 0xa4506ceb
+ 0xb5c0fbcf 0x923f82a4 0x243185be 0x9bdc06a7
+ 0x0fc19dc6 0x5cb0a9dc 0xb00327c8 0x06ca6351
+ 0x4d2c6dfc 0x81c2c92e 0xc24b8b70 0xf40e3585
+ 0x2748774c 0x5b9cca4f 0x84c87814 0xbef9a3f7
+ 0xe9b5dba5 0xab1c5ed5 0x550c7dc3 0xc19bf174
+ 0x240ca1cc 0x76f988da 0xbf597fc7 0x14292967
+ 0x53380d13 0x92722c85 0xc76c51a3 0x106aa070
+ 0x34b0bcb5 0x682e6ff3 0x8cc70208 0xc67178f2
+
+-- initialization
+-- https://datatracker.ietf.org/doc/html/rfc6234#section-6.1
+
+data SHA256S = SHA256S
+ !Word32 !Word32 !Word32 !Word32
+ !Word32 !Word32 !Word32 !Word32
+ deriving (Eq, Show)
+
+-- first 32 bits of the fractional parts of the square roots of the
+-- first eight primes
+sha256_iv :: SHA256S
+sha256_iv = SHA256S
+ 0x6a09e667 0xbb67ae85 0x3c6ef372 0xa54ff53a
+ 0x510e527f 0x9b05688c 0x1f83d9ab 0x5be0cd19
+
+-- processing
+-- https://datatracker.ietf.org/doc/html/rfc6234#section-6.2
+
+
+
+
