Lazy.hs (5692B)
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 -- 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 splitAt128 :: BL.ByteString -> SLPair 61 splitAt128 = splitAt' (128 :: 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 128 = 112 82 sol :: Word64 -> Word64 83 sol l = 84 let r = 112 - fi l `rem` 128 - 1 :: Integer -- fi prevents underflow 85 in fi (if r < 0 then r + 128 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 0x00 <> 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-512. 106 -- 107 -- The 512-bit output digest is returned as a strict bytestring. 108 -- 109 -- >>> hash_lazy "lazy bytestring input" 110 -- "<strict 512-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 splitAt128 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-512. 128 -- 129 -- The 512-bit MAC is returned as a strict bytestring. 130 -- 131 -- Per RFC 2104, the key /should/ be a minimum of 64 bytes long. Keys 132 -- exceeding 128 bytes in length will first be hashed (via SHA-512). 133 -- 134 -- >>> hmac_lazy "strict bytestring key" "lazy bytestring input" 135 -- "<strict 512-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 (128 - 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 128 b of 154 SSPair c r -> go (unsafe_hash_alg acc c) r 155 156 pad m@(BI.PS _ _ (fi -> len)) 157 | len < 256 = 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 0x00 163 <> BSB.word64BE (len * 8) 164 165 to_strict_small = BL.toStrict . BE.toLazyByteStringWith 166 (BE.safeStrategy 256 BE.smallChunkSize) mempty 167 168 fill j !acc 169 | j `rem` 8 == 0 = loop64 j acc 170 | otherwise = loop8 j acc 171 172 loop64 j !acc 173 | j == 0 = acc 174 | otherwise = loop64 (j - 8) (acc <> BSB.word64BE 0x00) 175 176 loop8 j !acc 177 | j == 0 = acc 178 | otherwise = loop8 (pred j) (acc <> BSB.word8 0x00) 179 180 !(KeyAndLen k lk) 181 | l > 128 = KeyAndLen (hash mk) 64 182 | otherwise = KeyAndLen mk l