Lazy.hs (5632B)
1 {-# OPTIONS_HADDOCK hide #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE ViewPatterns #-} 4 5 -- | 6 -- Module: Crypto.Hash.SHA256.Lazy 7 -- Copyright: (c) 2024 Jared Tobin 8 -- License: MIT 9 -- Maintainer: Jared Tobin <jared@ppad.tech> 10 -- 11 -- Pure SHA-256 and HMAC-SHA256 implementations for lazy ByteStrings, 12 -- as specified by RFC's 13 -- [6234](https://datatracker.ietf.org/doc/html/rfc6234) and 14 -- [2104](https://datatracker.ietf.org/doc/html/rfc2104). 15 16 module Crypto.Hash.SHA256.Lazy ( 17 -- * SHA-256 message digest functions 18 hash_lazy 19 20 -- * SHA256-based MAC functions 21 , hmac_lazy 22 ) where 23 24 import qualified Data.Bits as B 25 import qualified Data.ByteString as BS 26 import qualified Data.ByteString.Builder as BSB 27 import qualified Data.ByteString.Builder.Extra as BE 28 import qualified Data.ByteString.Internal as BI 29 import qualified Data.ByteString.Lazy as BL 30 import qualified Data.ByteString.Lazy.Internal as BLI 31 import Data.Word (Word64) 32 import Foreign.ForeignPtr (plusForeignPtr) 33 import Crypto.Hash.SHA256.Internal 34 35 -- preliminary utils 36 37 -- keystroke saver 38 fi :: (Integral a, Num b) => a -> b 39 fi = fromIntegral 40 {-# INLINE fi #-} 41 42 -- utility types for more efficient ByteString management 43 44 data SSPair = SSPair 45 {-# UNPACK #-} !BS.ByteString 46 {-# UNPACK #-} !BS.ByteString 47 48 data SLPair = SLPair {-# UNPACK #-} !BS.ByteString !BL.ByteString 49 50 -- unsafe version of splitAt that does no bounds checking 51 -- 52 -- invariant: 53 -- 0 <= n <= l 54 unsafe_splitAt :: Int -> BS.ByteString -> SSPair 55 unsafe_splitAt n (BI.BS x l) = 56 SSPair (BI.BS x n) (BI.BS (plusForeignPtr x n) (l - n)) 57 58 -- variant of Data.ByteString.Lazy.splitAt that returns the initial 59 -- component as a strict, unboxed ByteString 60 splitAt64 :: BL.ByteString -> SLPair 61 splitAt64 = splitAt' (64 :: Int) where 62 splitAt' _ BLI.Empty = SLPair mempty BLI.Empty 63 splitAt' n (BLI.Chunk c@(BI.PS _ _ l) cs) = 64 if n < l 65 then 66 -- n < BS.length c, so unsafe_splitAt is safe 67 let !(SSPair c0 c1) = unsafe_splitAt n c 68 in SLPair c0 (BLI.Chunk c1 cs) 69 else 70 let SLPair cs' cs'' = splitAt' (n - l) cs 71 in SLPair (c <> cs') cs'' 72 73 -- builder realization strategies 74 75 to_strict :: BSB.Builder -> BS.ByteString 76 to_strict = BL.toStrict . BSB.toLazyByteString 77 78 -- message padding and parsing 79 -- https://datatracker.ietf.org/doc/html/rfc6234#section-4.1 80 81 -- k such that (l + 1 + k) mod 64 = 56 82 sol :: Word64 -> Word64 83 sol l = 84 let r = 56 - fi l `rem` 64 - 1 :: Integer -- fi prevents underflow 85 in fi (if r < 0 then r + 64 else r) 86 87 -- RFC 6234 4.1 (lazy) 88 pad_lazy :: BL.ByteString -> BL.ByteString 89 pad_lazy (BL.toChunks -> m) = BL.fromChunks (walk 0 m) where 90 walk !l bs = case bs of 91 (c:cs) -> c : walk (l + fi (BS.length c)) cs 92 [] -> padding l (sol l) (BSB.word8 0x80) 93 94 padding l k bs 95 | k == 0 = 96 pure 97 . to_strict 98 -- more efficient for small builder 99 $ bs <> BSB.word64BE (l * 8) 100 | otherwise = 101 let nacc = bs <> BSB.word8 0x00 102 in padding l (pred k) nacc 103 104 -- | Compute a condensed representation of a lazy bytestring via 105 -- SHA-256. 106 -- 107 -- The 256-bit output digest is returned as a strict bytestring. 108 -- 109 -- >>> hash_lazy "lazy bytestring input" 110 -- "<strict 256-bit message digest>" 111 hash_lazy :: BL.ByteString -> BS.ByteString 112 hash_lazy bl = cat (go (iv ()) (pad_lazy bl)) where 113 go :: Registers -> BL.ByteString -> Registers 114 go !acc bs 115 | BL.null bs = acc 116 | otherwise = case splitAt64 bs of 117 SLPair c r -> go (unsafe_hash_alg acc c) r 118 119 -- HMAC ----------------------------------------------------------------------- 120 -- https://datatracker.ietf.org/doc/html/rfc2104#section-2 121 122 data KeyAndLen = KeyAndLen 123 {-# UNPACK #-} !BS.ByteString 124 {-# UNPACK #-} !Int 125 126 -- | Produce a message authentication code for a lazy bytestring, based 127 -- on the provided (strict, bytestring) key, via SHA-256. 128 -- 129 -- The 256-bit MAC is returned as a strict bytestring. 130 -- 131 -- Per RFC 2104, the key /should/ be a minimum of 32 bytes long. Keys 132 -- exceeding 64 bytes in length will first be hashed (via SHA-256). 133 -- 134 -- >>> hmac_lazy "strict bytestring key" "lazy bytestring input" 135 -- "<strict 256-bit MAC>" 136 hmac_lazy 137 :: BS.ByteString -- ^ key 138 -> BL.ByteString -- ^ text 139 -> MAC 140 hmac_lazy mk@(BI.PS _ _ l) text = 141 let step1 = k <> BS.replicate (64 - lk) 0x00 142 step2 = BS.map (B.xor 0x36) step1 143 step3 = BL.fromStrict step2 <> text 144 step4 = hash_lazy step3 145 step5 = BS.map (B.xor 0x5C) step1 146 step6 = step5 <> step4 147 in MAC (hash step6) 148 where 149 hash bs = cat (go (iv ()) (pad bs)) where 150 go :: Registers -> BS.ByteString -> Registers 151 go !acc b 152 | BS.null b = acc 153 | otherwise = case unsafe_splitAt 64 b of 154 SSPair c r -> go (unsafe_hash_alg acc c) r 155 156 pad m@(BI.PS _ _ (fi -> len)) 157 | len < 128 = to_strict_small padded 158 | otherwise = to_strict padded 159 where 160 padded = BSB.byteString m 161 <> fill (sol len) (BSB.word8 0x80) 162 <> BSB.word64BE (len * 8) 163 164 to_strict_small = BL.toStrict . BE.toLazyByteStringWith 165 (BE.safeStrategy 128 BE.smallChunkSize) mempty 166 167 fill j !acc 168 | j `rem` 8 == 0 = loop64 j acc 169 | otherwise = loop8 j acc 170 171 loop64 j !acc 172 | j == 0 = acc 173 | otherwise = loop64 (j - 8) (acc <> BSB.word64BE 0x00) 174 175 loop8 j !acc 176 | j == 0 = acc 177 | otherwise = loop8 (pred j) (acc <> BSB.word8 0x00) 178 179 !(KeyAndLen k lk) 180 | l > 64 = KeyAndLen (hash mk) 32 181 | otherwise = KeyAndLen mk l