Internal.hs (20819B)
1 {-# OPTIONS_HADDOCK hide #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE DerivingStrategies #-} 4 {-# LANGUAGE GeneralizedNewtypeDeriving #-} 5 {-# LANGUAGE MagicHash #-} 6 {-# LANGUAGE PatternSynonyms #-} 7 {-# LANGUAGE UnboxedTuples #-} 8 {-# LANGUAGE UnliftedNewtypes #-} 9 10 -- | 11 -- Module: Crypto.Hash.SHA256.Internal 12 -- Copyright: (c) 2024 Jared Tobin 13 -- License: MIT 14 -- Maintainer: Jared Tobin <jared@ppad.tech> 15 -- 16 -- SHA-256 internals. 17 18 module Crypto.Hash.SHA256.Internal ( 19 Block(..) 20 , pattern B 21 , Registers(..) 22 , pattern R 23 24 , MAC(..) 25 26 , iv 27 , block_hash 28 , cat 29 30 , word32be 31 , parse_block 32 , unsafe_hash_alg 33 , unsafe_padding 34 ) where 35 36 import qualified Data.Bits as B 37 import qualified Data.ByteString as BS 38 import qualified Data.ByteString.Internal as BI 39 import qualified Data.ByteString.Unsafe as BU 40 import Data.Word (Word8, Word64) 41 import Foreign.Marshal.Utils (copyBytes, fillBytes) 42 import Foreign.Ptr (Ptr, plusPtr) 43 import Foreign.Storable (poke) 44 import GHC.Exts (Int#) 45 import qualified GHC.Exts as Exts 46 import qualified GHC.Word (Word8(..)) 47 48 -- | A message authentication code. 49 -- 50 -- Note that you should compare MACs for equality using the 'Eq' 51 -- instance, which performs the comparison in constant time, instead 52 -- of unwrapping and comparing the underlying 'ByteStrings'. 53 -- 54 -- >>> let foo@(MAC bs0) = hmac key "hi" 55 -- >>> let bar@(MAC bs1) = hmac key "there" 56 -- >>> foo == bar -- do this 57 -- False 58 -- >>> bs0 == bs1 -- don't do this 59 -- False 60 newtype MAC = MAC BS.ByteString 61 deriving newtype Show 62 63 instance Eq MAC where 64 -- | A constant-time equality check for message authentication codes. 65 -- 66 -- Runs in variable-time only for invalid inputs. 67 (MAC a@(BI.PS _ _ la)) == (MAC b@(BI.PS _ _ lb)) 68 | la /= lb = False 69 | otherwise = BS.foldl' (B..|.) 0 (BS.packZipWith B.xor a b) == 0 70 71 -- https://datatracker.ietf.org/doc/html/rfc6234 72 73 newtype Block = Block 74 (# Exts.Word32#, Exts.Word32#, Exts.Word32#, Exts.Word32# 75 , Exts.Word32#, Exts.Word32#, Exts.Word32#, Exts.Word32# 76 , Exts.Word32#, Exts.Word32#, Exts.Word32#, Exts.Word32# 77 , Exts.Word32#, Exts.Word32#, Exts.Word32#, Exts.Word32# 78 #) 79 80 pattern B 81 :: Exts.Word32# -> Exts.Word32# -> Exts.Word32# -> Exts.Word32# 82 -> Exts.Word32# -> Exts.Word32# -> Exts.Word32# -> Exts.Word32# 83 -> Exts.Word32# -> Exts.Word32# -> Exts.Word32# -> Exts.Word32# 84 -> Exts.Word32# -> Exts.Word32# -> Exts.Word32# -> Exts.Word32# 85 -> Block 86 pattern B w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 w10 w11 w12 w13 w14 w15 = 87 Block 88 (# w00, w01, w02, w03 89 , w04, w05, w06, w07 90 , w08, w09, w10, w11 91 , w12, w13, w14, w15 92 #) 93 {-# COMPLETE B #-} 94 95 newtype Registers = Registers 96 (# Exts.Word32#, Exts.Word32#, Exts.Word32#, Exts.Word32# 97 , Exts.Word32#, Exts.Word32#, Exts.Word32#, Exts.Word32# 98 #) 99 100 pattern R 101 :: Exts.Word32# -> Exts.Word32# -> Exts.Word32# -> Exts.Word32# 102 -> Exts.Word32# -> Exts.Word32# -> Exts.Word32# -> Exts.Word32# 103 -> Registers 104 pattern R w00 w01 w02 w03 w04 w05 w06 w07 = 105 Registers 106 (# w00, w01, w02, w03 107 , w04, w05, w06, w07 108 #) 109 {-# COMPLETE R #-} 110 111 -- given a bytestring and offset, parse word32. length not checked. 112 word32be :: BS.ByteString -> Int -> Exts.Word32# 113 word32be bs m = 114 let !(GHC.Word.W8# ra) = BU.unsafeIndex bs m 115 !(GHC.Word.W8# rb) = BU.unsafeIndex bs (m + 1) 116 !(GHC.Word.W8# rc) = BU.unsafeIndex bs (m + 2) 117 !(GHC.Word.W8# rd) = BU.unsafeIndex bs (m + 3) 118 !a = Exts.wordToWord32# (Exts.word8ToWord# ra) 119 !b = Exts.wordToWord32# (Exts.word8ToWord# rb) 120 !c = Exts.wordToWord32# (Exts.word8ToWord# rc) 121 !d = Exts.wordToWord32# (Exts.word8ToWord# rd) 122 !sa = Exts.uncheckedShiftLWord32# a 24# 123 !sb = Exts.uncheckedShiftLWord32# b 16# 124 !sc = Exts.uncheckedShiftLWord32# c 08# 125 in sa `Exts.orWord32#` sb `Exts.orWord32#` sc `Exts.orWord32#` d 126 {-# INLINE word32be #-} 127 128 parse_block :: BS.ByteString -> Int -> Block 129 parse_block bs m = B 130 (word32be bs m) 131 (word32be bs (m + 04)) 132 (word32be bs (m + 08)) 133 (word32be bs (m + 12)) 134 (word32be bs (m + 16)) 135 (word32be bs (m + 20)) 136 (word32be bs (m + 24)) 137 (word32be bs (m + 28)) 138 (word32be bs (m + 32)) 139 (word32be bs (m + 36)) 140 (word32be bs (m + 40)) 141 (word32be bs (m + 44)) 142 (word32be bs (m + 48)) 143 (word32be bs (m + 52)) 144 (word32be bs (m + 56)) 145 (word32be bs (m + 60)) 146 {-# INLINE parse_block #-} 147 148 -- rotate right 149 rotr# :: Exts.Word32# -> Int# -> Exts.Word32# 150 rotr# x n = 151 Exts.uncheckedShiftRLWord32# x n `Exts.orWord32#` 152 Exts.uncheckedShiftLWord32# x (32# Exts.-# n) 153 {-# INLINE rotr# #-} 154 155 -- logical right shift 156 shr# :: Exts.Word32# -> Int# -> Exts.Word32# 157 shr# = Exts.uncheckedShiftRLWord32# 158 {-# INLINE shr# #-} 159 160 -- ch(x, y, z) = (x & y) ^ (~x & z) 161 ch# :: Exts.Word32# -> Exts.Word32# -> Exts.Word32# -> Exts.Word32# 162 ch# x y z = 163 (x `Exts.andWord32#` y) `Exts.xorWord32#` 164 (Exts.notWord32# x `Exts.andWord32#` z) 165 {-# INLINE ch# #-} 166 167 -- maj(x, y, z) = (x & (y | z)) | (y & z) 168 maj# :: Exts.Word32# -> Exts.Word32# -> Exts.Word32# -> Exts.Word32# 169 maj# x y z = 170 (x `Exts.andWord32#` (y `Exts.orWord32#` z)) `Exts.orWord32#` 171 (y `Exts.andWord32#` z) 172 {-# INLINE maj# #-} 173 174 -- big sigma 0: rotr2 ^ rotr13 ^ rotr22 175 bsig0# :: Exts.Word32# -> Exts.Word32# 176 bsig0# x = 177 rotr# x 2# `Exts.xorWord32#` rotr# x 13# `Exts.xorWord32#` rotr# x 22# 178 {-# INLINE bsig0# #-} 179 180 -- big sigma 1: rotr6 ^ rotr11 ^ rotr25 181 bsig1# :: Exts.Word32# -> Exts.Word32# 182 bsig1# x = 183 rotr# x 6# `Exts.xorWord32#` rotr# x 11# `Exts.xorWord32#` rotr# x 25# 184 {-# INLINE bsig1# #-} 185 186 -- small sigma 0: rotr7 ^ rotr18 ^ shr3 187 ssig0# :: Exts.Word32# -> Exts.Word32# 188 ssig0# x = 189 rotr# x 7# `Exts.xorWord32#` rotr# x 18# `Exts.xorWord32#` shr# x 3# 190 {-# INLINE ssig0# #-} 191 192 -- small sigma 1: rotr17 ^ rotr19 ^ shr10 193 ssig1# :: Exts.Word32# -> Exts.Word32# 194 ssig1# x = 195 rotr# x 17# `Exts.xorWord32#` rotr# x 19# `Exts.xorWord32#` shr# x 10# 196 {-# INLINE ssig1# #-} 197 198 -- round step 199 step# 200 :: Exts.Word32# -> Exts.Word32# -> Exts.Word32# -> Exts.Word32# 201 -> Exts.Word32# -> Exts.Word32# -> Exts.Word32# -> Exts.Word32# 202 -> Exts.Word32# -> Exts.Word32# 203 -> Registers 204 step# a b c d e f g h k w = 205 let !t1 = h 206 `Exts.plusWord32#` bsig1# e 207 `Exts.plusWord32#` ch# e f g 208 `Exts.plusWord32#` k 209 `Exts.plusWord32#` w 210 !t2 = bsig0# a `Exts.plusWord32#` maj# a b c 211 in R (t1 `Exts.plusWord32#` t2) a b c (d `Exts.plusWord32#` t1) e f g 212 {-# INLINE step# #-} 213 214 -- first 32 bits of the fractional parts of the square roots of the 215 -- first eight primes 216 iv :: () -> Registers 217 iv _ = R (Exts.wordToWord32# 0x6a09e667##) 218 (Exts.wordToWord32# 0xbb67ae85##) 219 (Exts.wordToWord32# 0x3c6ef372##) 220 (Exts.wordToWord32# 0xa54ff53a##) 221 (Exts.wordToWord32# 0x510e527f##) 222 (Exts.wordToWord32# 0x9b05688c##) 223 (Exts.wordToWord32# 0x1f83d9ab##) 224 (Exts.wordToWord32# 0x5be0cd19##) 225 226 block_hash :: Registers -> Block -> Registers 227 block_hash 228 (R h0 h1 h2 h3 h4 h5 h6 h7) 229 (B b00 b01 b02 b03 b04 b05 b06 b07 b08 b09 b10 b11 b12 b13 b14 b15) 230 = 231 let -- message schedule 232 !w00 = b00; !w01 = b01; !w02 = b02; !w03 = b03 233 !w04 = b04; !w05 = b05; !w06 = b06; !w07 = b07 234 !w08 = b08; !w09 = b09; !w10 = b10; !w11 = b11 235 !w12 = b12; !w13 = b13; !w14 = b14; !w15 = b15 236 !w16 = ssig1# w14 `p` w09 `p` ssig0# w01 `p` w00 237 !w17 = ssig1# w15 `p` w10 `p` ssig0# w02 `p` w01 238 !w18 = ssig1# w16 `p` w11 `p` ssig0# w03 `p` w02 239 !w19 = ssig1# w17 `p` w12 `p` ssig0# w04 `p` w03 240 !w20 = ssig1# w18 `p` w13 `p` ssig0# w05 `p` w04 241 !w21 = ssig1# w19 `p` w14 `p` ssig0# w06 `p` w05 242 !w22 = ssig1# w20 `p` w15 `p` ssig0# w07 `p` w06 243 !w23 = ssig1# w21 `p` w16 `p` ssig0# w08 `p` w07 244 !w24 = ssig1# w22 `p` w17 `p` ssig0# w09 `p` w08 245 !w25 = ssig1# w23 `p` w18 `p` ssig0# w10 `p` w09 246 !w26 = ssig1# w24 `p` w19 `p` ssig0# w11 `p` w10 247 !w27 = ssig1# w25 `p` w20 `p` ssig0# w12 `p` w11 248 !w28 = ssig1# w26 `p` w21 `p` ssig0# w13 `p` w12 249 !w29 = ssig1# w27 `p` w22 `p` ssig0# w14 `p` w13 250 !w30 = ssig1# w28 `p` w23 `p` ssig0# w15 `p` w14 251 !w31 = ssig1# w29 `p` w24 `p` ssig0# w16 `p` w15 252 !w32 = ssig1# w30 `p` w25 `p` ssig0# w17 `p` w16 253 !w33 = ssig1# w31 `p` w26 `p` ssig0# w18 `p` w17 254 !w34 = ssig1# w32 `p` w27 `p` ssig0# w19 `p` w18 255 !w35 = ssig1# w33 `p` w28 `p` ssig0# w20 `p` w19 256 !w36 = ssig1# w34 `p` w29 `p` ssig0# w21 `p` w20 257 !w37 = ssig1# w35 `p` w30 `p` ssig0# w22 `p` w21 258 !w38 = ssig1# w36 `p` w31 `p` ssig0# w23 `p` w22 259 !w39 = ssig1# w37 `p` w32 `p` ssig0# w24 `p` w23 260 !w40 = ssig1# w38 `p` w33 `p` ssig0# w25 `p` w24 261 !w41 = ssig1# w39 `p` w34 `p` ssig0# w26 `p` w25 262 !w42 = ssig1# w40 `p` w35 `p` ssig0# w27 `p` w26 263 !w43 = ssig1# w41 `p` w36 `p` ssig0# w28 `p` w27 264 !w44 = ssig1# w42 `p` w37 `p` ssig0# w29 `p` w28 265 !w45 = ssig1# w43 `p` w38 `p` ssig0# w30 `p` w29 266 !w46 = ssig1# w44 `p` w39 `p` ssig0# w31 `p` w30 267 !w47 = ssig1# w45 `p` w40 `p` ssig0# w32 `p` w31 268 !w48 = ssig1# w46 `p` w41 `p` ssig0# w33 `p` w32 269 !w49 = ssig1# w47 `p` w42 `p` ssig0# w34 `p` w33 270 !w50 = ssig1# w48 `p` w43 `p` ssig0# w35 `p` w34 271 !w51 = ssig1# w49 `p` w44 `p` ssig0# w36 `p` w35 272 !w52 = ssig1# w50 `p` w45 `p` ssig0# w37 `p` w36 273 !w53 = ssig1# w51 `p` w46 `p` ssig0# w38 `p` w37 274 !w54 = ssig1# w52 `p` w47 `p` ssig0# w39 `p` w38 275 !w55 = ssig1# w53 `p` w48 `p` ssig0# w40 `p` w39 276 !w56 = ssig1# w54 `p` w49 `p` ssig0# w41 `p` w40 277 !w57 = ssig1# w55 `p` w50 `p` ssig0# w42 `p` w41 278 !w58 = ssig1# w56 `p` w51 `p` ssig0# w43 `p` w42 279 !w59 = ssig1# w57 `p` w52 `p` ssig0# w44 `p` w43 280 !w60 = ssig1# w58 `p` w53 `p` ssig0# w45 `p` w44 281 !w61 = ssig1# w59 `p` w54 `p` ssig0# w46 `p` w45 282 !w62 = ssig1# w60 `p` w55 `p` ssig0# w47 `p` w46 283 !w63 = ssig1# w61 `p` w56 `p` ssig0# w48 `p` w47 284 285 -- rounds (cube roots of first 64 primes) 286 !(R s00a s00b s00c s00d s00e s00f s00g s00h) = 287 step# h0 h1 h2 h3 h4 h5 h6 h7 (k 0x428a2f98##) w00 288 !(R s01a s01b s01c s01d s01e s01f s01g s01h) = 289 step# s00a s00b s00c s00d s00e s00f s00g s00h (k 0x71374491##) w01 290 !(R s02a s02b s02c s02d s02e s02f s02g s02h) = 291 step# s01a s01b s01c s01d s01e s01f s01g s01h (k 0xb5c0fbcf##) w02 292 !(R s03a s03b s03c s03d s03e s03f s03g s03h) = 293 step# s02a s02b s02c s02d s02e s02f s02g s02h (k 0xe9b5dba5##) w03 294 !(R s04a s04b s04c s04d s04e s04f s04g s04h) = 295 step# s03a s03b s03c s03d s03e s03f s03g s03h (k 0x3956c25b##) w04 296 !(R s05a s05b s05c s05d s05e s05f s05g s05h) = 297 step# s04a s04b s04c s04d s04e s04f s04g s04h (k 0x59f111f1##) w05 298 !(R s06a s06b s06c s06d s06e s06f s06g s06h) = 299 step# s05a s05b s05c s05d s05e s05f s05g s05h (k 0x923f82a4##) w06 300 !(R s07a s07b s07c s07d s07e s07f s07g s07h) = 301 step# s06a s06b s06c s06d s06e s06f s06g s06h (k 0xab1c5ed5##) w07 302 !(R s08a s08b s08c s08d s08e s08f s08g s08h) = 303 step# s07a s07b s07c s07d s07e s07f s07g s07h (k 0xd807aa98##) w08 304 !(R s09a s09b s09c s09d s09e s09f s09g s09h) = 305 step# s08a s08b s08c s08d s08e s08f s08g s08h (k 0x12835b01##) w09 306 !(R s10a s10b s10c s10d s10e s10f s10g s10h) = 307 step# s09a s09b s09c s09d s09e s09f s09g s09h (k 0x243185be##) w10 308 !(R s11a s11b s11c s11d s11e s11f s11g s11h) = 309 step# s10a s10b s10c s10d s10e s10f s10g s10h (k 0x550c7dc3##) w11 310 !(R s12a s12b s12c s12d s12e s12f s12g s12h) = 311 step# s11a s11b s11c s11d s11e s11f s11g s11h (k 0x72be5d74##) w12 312 !(R s13a s13b s13c s13d s13e s13f s13g s13h) = 313 step# s12a s12b s12c s12d s12e s12f s12g s12h (k 0x80deb1fe##) w13 314 !(R s14a s14b s14c s14d s14e s14f s14g s14h) = 315 step# s13a s13b s13c s13d s13e s13f s13g s13h (k 0x9bdc06a7##) w14 316 !(R s15a s15b s15c s15d s15e s15f s15g s15h) = 317 step# s14a s14b s14c s14d s14e s14f s14g s14h (k 0xc19bf174##) w15 318 !(R s16a s16b s16c s16d s16e s16f s16g s16h) = 319 step# s15a s15b s15c s15d s15e s15f s15g s15h (k 0xe49b69c1##) w16 320 !(R s17a s17b s17c s17d s17e s17f s17g s17h) = 321 step# s16a s16b s16c s16d s16e s16f s16g s16h (k 0xefbe4786##) w17 322 !(R s18a s18b s18c s18d s18e s18f s18g s18h) = 323 step# s17a s17b s17c s17d s17e s17f s17g s17h (k 0x0fc19dc6##) w18 324 !(R s19a s19b s19c s19d s19e s19f s19g s19h) = 325 step# s18a s18b s18c s18d s18e s18f s18g s18h (k 0x240ca1cc##) w19 326 !(R s20a s20b s20c s20d s20e s20f s20g s20h) = 327 step# s19a s19b s19c s19d s19e s19f s19g s19h (k 0x2de92c6f##) w20 328 !(R s21a s21b s21c s21d s21e s21f s21g s21h) = 329 step# s20a s20b s20c s20d s20e s20f s20g s20h (k 0x4a7484aa##) w21 330 !(R s22a s22b s22c s22d s22e s22f s22g s22h) = 331 step# s21a s21b s21c s21d s21e s21f s21g s21h (k 0x5cb0a9dc##) w22 332 !(R s23a s23b s23c s23d s23e s23f s23g s23h) = 333 step# s22a s22b s22c s22d s22e s22f s22g s22h (k 0x76f988da##) w23 334 !(R s24a s24b s24c s24d s24e s24f s24g s24h) = 335 step# s23a s23b s23c s23d s23e s23f s23g s23h (k 0x983e5152##) w24 336 !(R s25a s25b s25c s25d s25e s25f s25g s25h) = 337 step# s24a s24b s24c s24d s24e s24f s24g s24h (k 0xa831c66d##) w25 338 !(R s26a s26b s26c s26d s26e s26f s26g s26h) = 339 step# s25a s25b s25c s25d s25e s25f s25g s25h (k 0xb00327c8##) w26 340 !(R s27a s27b s27c s27d s27e s27f s27g s27h) = 341 step# s26a s26b s26c s26d s26e s26f s26g s26h (k 0xbf597fc7##) w27 342 !(R s28a s28b s28c s28d s28e s28f s28g s28h) = 343 step# s27a s27b s27c s27d s27e s27f s27g s27h (k 0xc6e00bf3##) w28 344 !(R s29a s29b s29c s29d s29e s29f s29g s29h) = 345 step# s28a s28b s28c s28d s28e s28f s28g s28h (k 0xd5a79147##) w29 346 !(R s30a s30b s30c s30d s30e s30f s30g s30h) = 347 step# s29a s29b s29c s29d s29e s29f s29g s29h (k 0x06ca6351##) w30 348 !(R s31a s31b s31c s31d s31e s31f s31g s31h) = 349 step# s30a s30b s30c s30d s30e s30f s30g s30h (k 0x14292967##) w31 350 !(R s32a s32b s32c s32d s32e s32f s32g s32h) = 351 step# s31a s31b s31c s31d s31e s31f s31g s31h (k 0x27b70a85##) w32 352 !(R s33a s33b s33c s33d s33e s33f s33g s33h) = 353 step# s32a s32b s32c s32d s32e s32f s32g s32h (k 0x2e1b2138##) w33 354 !(R s34a s34b s34c s34d s34e s34f s34g s34h) = 355 step# s33a s33b s33c s33d s33e s33f s33g s33h (k 0x4d2c6dfc##) w34 356 !(R s35a s35b s35c s35d s35e s35f s35g s35h) = 357 step# s34a s34b s34c s34d s34e s34f s34g s34h (k 0x53380d13##) w35 358 !(R s36a s36b s36c s36d s36e s36f s36g s36h) = 359 step# s35a s35b s35c s35d s35e s35f s35g s35h (k 0x650a7354##) w36 360 !(R s37a s37b s37c s37d s37e s37f s37g s37h) = 361 step# s36a s36b s36c s36d s36e s36f s36g s36h (k 0x766a0abb##) w37 362 !(R s38a s38b s38c s38d s38e s38f s38g s38h) = 363 step# s37a s37b s37c s37d s37e s37f s37g s37h (k 0x81c2c92e##) w38 364 !(R s39a s39b s39c s39d s39e s39f s39g s39h) = 365 step# s38a s38b s38c s38d s38e s38f s38g s38h (k 0x92722c85##) w39 366 !(R s40a s40b s40c s40d s40e s40f s40g s40h) = 367 step# s39a s39b s39c s39d s39e s39f s39g s39h (k 0xa2bfe8a1##) w40 368 !(R s41a s41b s41c s41d s41e s41f s41g s41h) = 369 step# s40a s40b s40c s40d s40e s40f s40g s40h (k 0xa81a664b##) w41 370 !(R s42a s42b s42c s42d s42e s42f s42g s42h) = 371 step# s41a s41b s41c s41d s41e s41f s41g s41h (k 0xc24b8b70##) w42 372 !(R s43a s43b s43c s43d s43e s43f s43g s43h) = 373 step# s42a s42b s42c s42d s42e s42f s42g s42h (k 0xc76c51a3##) w43 374 !(R s44a s44b s44c s44d s44e s44f s44g s44h) = 375 step# s43a s43b s43c s43d s43e s43f s43g s43h (k 0xd192e819##) w44 376 !(R s45a s45b s45c s45d s45e s45f s45g s45h) = 377 step# s44a s44b s44c s44d s44e s44f s44g s44h (k 0xd6990624##) w45 378 !(R s46a s46b s46c s46d s46e s46f s46g s46h) = 379 step# s45a s45b s45c s45d s45e s45f s45g s45h (k 0xf40e3585##) w46 380 !(R s47a s47b s47c s47d s47e s47f s47g s47h) = 381 step# s46a s46b s46c s46d s46e s46f s46g s46h (k 0x106aa070##) w47 382 !(R s48a s48b s48c s48d s48e s48f s48g s48h) = 383 step# s47a s47b s47c s47d s47e s47f s47g s47h (k 0x19a4c116##) w48 384 !(R s49a s49b s49c s49d s49e s49f s49g s49h) = 385 step# s48a s48b s48c s48d s48e s48f s48g s48h (k 0x1e376c08##) w49 386 !(R s50a s50b s50c s50d s50e s50f s50g s50h) = 387 step# s49a s49b s49c s49d s49e s49f s49g s49h (k 0x2748774c##) w50 388 !(R s51a s51b s51c s51d s51e s51f s51g s51h) = 389 step# s50a s50b s50c s50d s50e s50f s50g s50h (k 0x34b0bcb5##) w51 390 !(R s52a s52b s52c s52d s52e s52f s52g s52h) = 391 step# s51a s51b s51c s51d s51e s51f s51g s51h (k 0x391c0cb3##) w52 392 !(R s53a s53b s53c s53d s53e s53f s53g s53h) = 393 step# s52a s52b s52c s52d s52e s52f s52g s52h (k 0x4ed8aa4a##) w53 394 !(R s54a s54b s54c s54d s54e s54f s54g s54h) = 395 step# s53a s53b s53c s53d s53e s53f s53g s53h (k 0x5b9cca4f##) w54 396 !(R s55a s55b s55c s55d s55e s55f s55g s55h) = 397 step# s54a s54b s54c s54d s54e s54f s54g s54h (k 0x682e6ff3##) w55 398 !(R s56a s56b s56c s56d s56e s56f s56g s56h) = 399 step# s55a s55b s55c s55d s55e s55f s55g s55h (k 0x748f82ee##) w56 400 !(R s57a s57b s57c s57d s57e s57f s57g s57h) = 401 step# s56a s56b s56c s56d s56e s56f s56g s56h (k 0x78a5636f##) w57 402 !(R s58a s58b s58c s58d s58e s58f s58g s58h) = 403 step# s57a s57b s57c s57d s57e s57f s57g s57h (k 0x84c87814##) w58 404 !(R s59a s59b s59c s59d s59e s59f s59g s59h) = 405 step# s58a s58b s58c s58d s58e s58f s58g s58h (k 0x8cc70208##) w59 406 !(R s60a s60b s60c s60d s60e s60f s60g s60h) = 407 step# s59a s59b s59c s59d s59e s59f s59g s59h (k 0x90befffa##) w60 408 !(R s61a s61b s61c s61d s61e s61f s61g s61h) = 409 step# s60a s60b s60c s60d s60e s60f s60g s60h (k 0xa4506ceb##) w61 410 !(R s62a s62b s62c s62d s62e s62f s62g s62h) = 411 step# s61a s61b s61c s61d s61e s61f s61g s61h (k 0xbef9a3f7##) w62 412 !(R s63a s63b s63c s63d s63e s63f s63g s63h) = 413 step# s62a s62b s62c s62d s62e s62f s62g s62h (k 0xc67178f2##) w63 414 in R (h0 `p` s63a) (h1 `p` s63b) (h2 `p` s63c) (h3 `p` s63d) 415 (h4 `p` s63e) (h5 `p` s63f) (h6 `p` s63g) (h7 `p` s63h) 416 where 417 p = Exts.plusWord32# 418 {-# INLINE p #-} 419 k :: Exts.Word# -> Exts.Word32# 420 k = Exts.wordToWord32# 421 {-# INLINE k #-} 422 423 -- RFC 6234 6.2 block pipeline 424 -- 425 -- invariant: 426 -- the input bytestring is exactly 512 bits in length 427 unsafe_hash_alg :: Registers -> BS.ByteString -> Registers 428 unsafe_hash_alg rs bs = block_hash rs (parse_block bs 0) 429 430 -- register concatenation 431 cat :: Registers -> BS.ByteString 432 cat (R h0 h1 h2 h3 h4 h5 h6 h7) = BI.unsafeCreate 32 $ \ptr -> do 433 poke32be ptr 0 h0 434 poke32be ptr 4 h1 435 poke32be ptr 8 h2 436 poke32be ptr 12 h3 437 poke32be ptr 16 h4 438 poke32be ptr 20 h5 439 poke32be ptr 24 h6 440 poke32be ptr 28 h7 441 where 442 poke32be :: Ptr Word8 -> Int -> Exts.Word32# -> IO () 443 poke32be p off w = do 444 poke (p `plusPtr` off) (byte w 24#) 445 poke (p `plusPtr` (off + 1)) (byte w 16#) 446 poke (p `plusPtr` (off + 2)) (byte w 8#) 447 poke (p `plusPtr` (off + 3)) (byte w 0#) 448 449 byte :: Exts.Word32# -> Int# -> Word8 450 byte w n = GHC.Word.W8# (Exts.wordToWord8# 451 (Exts.word32ToWord# (Exts.uncheckedShiftRLWord32# w n))) 452 453 -- keystroke saver 454 fi :: (Integral a, Num b) => a -> b 455 fi = fromIntegral 456 {-# INLINE fi #-} 457 458 -- RFC 6234 4.1 message padding 459 unsafe_padding :: BS.ByteString -> Word64 -> BS.ByteString 460 unsafe_padding (BI.PS fp off r) len 461 | r < 56 = BI.unsafeCreate 64 $ \p -> do 462 BI.unsafeWithForeignPtr fp $ \src -> 463 copyBytes p (src `plusPtr` off) r 464 poke (p `plusPtr` r) (0x80 :: Word8) 465 fillBytes (p `plusPtr` (r + 1)) 0 (55 - r) 466 poke_word64be (p `plusPtr` 56) (len * 8) 467 | otherwise = BI.unsafeCreate 128 $ \p -> do 468 BI.unsafeWithForeignPtr fp $ \src -> 469 copyBytes p (src `plusPtr` off) r 470 poke (p `plusPtr` r) (0x80 :: Word8) 471 fillBytes (p `plusPtr` (r + 1)) 0 (63 - r) 472 fillBytes (p `plusPtr` 64) 0 56 473 poke_word64be (p `plusPtr` 120) (len * 8) 474 where 475 poke_word64be :: Ptr Word8 -> Word64 -> IO () 476 poke_word64be p w = do 477 poke p (fi (w `B.unsafeShiftR` 56) :: Word8) 478 poke (p `plusPtr` 1) (fi (w `B.unsafeShiftR` 48) :: Word8) 479 poke (p `plusPtr` 2) (fi (w `B.unsafeShiftR` 40) :: Word8) 480 poke (p `plusPtr` 3) (fi (w `B.unsafeShiftR` 32) :: Word8) 481 poke (p `plusPtr` 4) (fi (w `B.unsafeShiftR` 24) :: Word8) 482 poke (p `plusPtr` 5) (fi (w `B.unsafeShiftR` 16) :: Word8) 483 poke (p `plusPtr` 6) (fi (w `B.unsafeShiftR` 8) :: Word8) 484 poke (p `plusPtr` 7) (fi w :: Word8)