Lazy.hs (4302B)
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.Internal as BI 28 import qualified Data.ByteString.Lazy as BL 29 import qualified Data.ByteString.Lazy.Internal as BLI 30 import Data.Word (Word64) 31 import Foreign.ForeignPtr (plusForeignPtr) 32 import Crypto.Hash.SHA256.Internal 33 import qualified Crypto.Hash.SHA256.Pure as Pure 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 = (55 - l) B..&. 63 -- wraps mod 2^64, a multiple of 64 81 82 -- RFC 6234 4.1 (lazy) 83 pad_lazy :: BL.ByteString -> BL.ByteString 84 pad_lazy (BL.toChunks -> m) = BL.fromChunks (walk 0 m) where 85 walk !l bs = case bs of 86 (c:cs) -> c : walk (l + fi (BS.length c)) cs 87 [] -> [padding l] 88 89 padding l = to_strict $ 90 BSB.word8 0x80 91 <> BSB.byteString (BS.replicate (fi (sol l)) 0x00) 92 <> BSB.word64BE (l * 8) 93 94 -- | Compute a condensed representation of a lazy bytestring via 95 -- SHA-256. 96 -- 97 -- The 256-bit output digest is returned as a strict bytestring. 98 -- 99 -- >>> hash_lazy "lazy bytestring input" 100 -- "<strict 256-bit message digest>" 101 hash_lazy :: BL.ByteString -> BS.ByteString 102 hash_lazy bl = cat (go (iv ()) (pad_lazy bl)) where 103 go :: Registers -> BL.ByteString -> Registers 104 go !acc bs 105 | BL.null bs = acc 106 | otherwise = case splitAt64 bs of 107 SLPair c r -> go (update acc (parse c 0)) r 108 109 -- HMAC ----------------------------------------------------------------------- 110 -- https://datatracker.ietf.org/doc/html/rfc2104#section-2 111 112 -- | Produce a message authentication code for a lazy bytestring, based 113 -- on the provided (strict, bytestring) key, via SHA-256. 114 -- 115 -- The 256-bit MAC is returned as a strict bytestring. 116 -- 117 -- Per RFC 2104, the key /should/ be a minimum of 32 bytes long. Keys 118 -- exceeding 64 bytes in length will first be hashed (via SHA-256). 119 -- 120 -- >>> hmac_lazy "strict bytestring key" "lazy bytestring input" 121 -- "<strict 256-bit MAC>" 122 hmac_lazy 123 :: BS.ByteString -- ^ key 124 -> BL.ByteString -- ^ text 125 -> MAC 126 hmac_lazy mk@(BI.PS _ _ l) text = 127 let step1 = k <> BS.replicate (64 - lk) 0x00 128 step2 = BS.map (B.xor 0x36) step1 129 step3 = BL.fromStrict step2 <> text 130 step4 = hash_lazy step3 131 step5 = BS.map (B.xor 0x5C) step1 132 step6 = step5 <> step4 133 in MAC (Pure.hash step6) 134 where 135 !(k, lk) = if l > 64 then (Pure.hash mk, 32) else (mk, l)