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