Lazy.hs (5539B)
1 {-# OPTIONS_HADDOCK hide #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE ViewPatterns #-} 4 5 -- | 6 -- Module: Crypto.Hash.SHA512.Lazy 7 -- Copyright: (c) 2024 Jared Tobin 8 -- License: MIT 9 -- Maintainer: Jared Tobin <jared@ppad.tech> 10 -- 11 -- Pure SHA-512 and HMAC-SHA512 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.SHA512.Lazy ( 17 -- * SHA-512 message digest functions 18 hash_lazy 19 20 -- * SHA512-based MAC functions 21 , hmac_lazy 22 ) where 23 24 import Crypto.Hash.SHA512.Internal 25 import qualified Data.Bits as B 26 import qualified Data.ByteString as BS 27 import qualified Data.ByteString.Builder as BSB 28 import qualified Data.ByteString.Builder.Extra as BE 29 import qualified Data.ByteString.Internal as BI 30 import qualified Data.ByteString.Lazy as BL 31 import qualified Data.ByteString.Lazy.Internal as BLI 32 import Data.Word (Word64) 33 import Foreign.ForeignPtr (plusForeignPtr) 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 splitAt128 :: BL.ByteString -> SLPair 58 splitAt128 = splitAt' (128 :: 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 128 = 112 79 sol :: Word64 -> Word64 80 sol l = 81 let r = 112 - fi l `rem` 128 - 1 :: Integer -- fi prevents underflow 82 in fi (if r < 0 then r + 128 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 0x00 <> 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-512. 103 -- 104 -- The 512-bit output digest is returned as a strict bytestring. 105 -- 106 -- >>> hash_lazy "lazy bytestring input" 107 -- "<strict 512-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 splitAt128 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-512. 121 -- 122 -- The 512-bit MAC is returned as a strict bytestring. 123 -- 124 -- Per RFC 2104, the key /should/ be a minimum of 64 bytes long. Keys 125 -- exceeding 128 bytes in length will first be hashed (via SHA-512). 126 -- 127 -- >>> hmac_lazy "strict bytestring key" "lazy bytestring input" 128 -- "<strict 512-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 (128 - 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 128 b of 147 SSPair c r -> go (update acc (parse c 0)) r 148 149 pad m@(BI.PS _ _ (fi -> len)) 150 | len < 256 = 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 0x00 156 <> BSB.word64BE (len * 8) 157 158 to_strict_small = BL.toStrict . BE.toLazyByteStringWith 159 (BE.safeStrategy 256 BE.smallChunkSize) mempty 160 161 fill j !acc 162 | j `rem` 8 == 0 = loop64 j acc 163 | otherwise = loop8 j acc 164 165 loop64 j !acc 166 | j == 0 = acc 167 | otherwise = loop64 (j - 8) (acc <> BSB.word64BE 0x00) 168 169 loop8 j !acc 170 | j == 0 = acc 171 | otherwise = loop8 (pred j) (acc <> BSB.word8 0x00) 172 173 !(k, lk) = if l > 128 then (hash mk, 64) else (mk, l)