Internal.hs (36810B)
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 {-# LANGUAGE ViewPatterns #-} 10 11 -- | 12 -- Module: Crypto.Hash.SHA512.Internal 13 -- Copyright: (c) 2024 Jared Tobin 14 -- License: MIT 15 -- Maintainer: Jared Tobin <jared@ppad.tech> 16 -- 17 -- SHA-512 internals. 18 19 module Crypto.Hash.SHA512.Internal ( 20 -- * Types 21 Block(B, ..) 22 , Registers(R, ..) 23 , MAC(..) 24 25 -- * Parsing 26 , parse 27 , parse_pad1 28 , parse_pad2 29 30 -- * Serializing 31 , cat 32 , cat_into 33 34 -- * Hash function internals 35 , update 36 , iv 37 38 -- * HMAC utilities 39 , pad_registers 40 , pad_registers_with_length 41 , xor 42 , parse_key 43 44 -- * HMAC-DRBG utilities 45 , parse_vsb 46 , parse_pad1_vsb 47 , parse_pad2_vsb 48 49 -- * Pointer-based IO utilities 50 , poke_registers 51 ) where 52 53 import qualified Data.Bits as B 54 import qualified Data.ByteString as BS 55 import qualified Data.ByteString.Internal as BI 56 import qualified Data.ByteString.Unsafe as BU 57 import Data.Word (Word8, Word64) 58 import qualified GHC.IO (IO(..)) 59 import GHC.Ptr (Ptr(..)) 60 import GHC.Exts (Int#) 61 import qualified GHC.Exts as Exts 62 import qualified GHC.Word (Word64(..), Word8(..)) 63 64 -- types ---------------------------------------------------------------------- 65 66 -- | A message authentication code. 67 -- 68 -- Note that you should compare MACs for equality using the 'Eq' 69 -- instance, which performs the comparison in constant time, instead 70 -- of unwrapping and comparing the underlying 'ByteStrings'. 71 -- 72 -- >>> let foo@(MAC bs0) = hmac key "hi" 73 -- >>> let bar@(MAC bs1) = hmac key "there" 74 -- >>> foo == bar -- do this 75 -- False 76 -- >>> bs0 == bs1 -- don't do this 77 -- False 78 newtype MAC = MAC BS.ByteString 79 deriving newtype Show 80 81 instance Eq MAC where 82 -- | A constant-time equality check for message authentication codes. 83 -- 84 -- Runs in variable-time only for invalid inputs. 85 (MAC a@(BI.PS _ _ la)) == (MAC b@(BI.PS _ _ lb)) 86 | la /= lb = False 87 | otherwise = go 0 0 88 where 89 -- fused fold: OR the bytewise XORs into an accumulator 90 -- directly, rather than via packZipWith, so no intermediate 91 -- ByteString holding the (secret-derived) difference bytes 92 -- is ever materialised on the heap. 93 go :: Word8 -> Int -> Bool 94 go !acc !i 95 | i == la = acc == 0 96 | otherwise = 97 let !x = BU.unsafeIndex a i 98 !y = BU.unsafeIndex b i 99 in go (acc B..|. B.xor x y) (i + 1) 100 101 -- | SHA512 block. 102 newtype Block = Block 103 (# Exts.Word64#, Exts.Word64#, Exts.Word64#, Exts.Word64# 104 , Exts.Word64#, Exts.Word64#, Exts.Word64#, Exts.Word64# 105 , Exts.Word64#, Exts.Word64#, Exts.Word64#, Exts.Word64# 106 , Exts.Word64#, Exts.Word64#, Exts.Word64#, Exts.Word64# 107 #) 108 109 pattern B 110 :: Exts.Word64# -> Exts.Word64# -> Exts.Word64# -> Exts.Word64# 111 -> Exts.Word64# -> Exts.Word64# -> Exts.Word64# -> Exts.Word64# 112 -> Exts.Word64# -> Exts.Word64# -> Exts.Word64# -> Exts.Word64# 113 -> Exts.Word64# -> Exts.Word64# -> Exts.Word64# -> Exts.Word64# 114 -> Block 115 pattern B w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 w10 w11 w12 w13 w14 w15 = 116 Block 117 (# w00, w01, w02, w03, w04, w05, w06, w07 118 , w08, w09, w10, w11, w12, w13, w14, w15 119 #) 120 {-# COMPLETE B #-} 121 122 -- | SHA512 state. 123 newtype Registers = Registers 124 (# Exts.Word64#, Exts.Word64#, Exts.Word64#, Exts.Word64# 125 , Exts.Word64#, Exts.Word64#, Exts.Word64#, Exts.Word64# 126 #) 127 128 pattern R 129 :: Exts.Word64# -> Exts.Word64# -> Exts.Word64# -> Exts.Word64# 130 -> Exts.Word64# -> Exts.Word64# -> Exts.Word64# -> Exts.Word64# 131 -> Registers 132 pattern R w00 w01 w02 w03 w04 w05 w06 w07 = Registers 133 (# w00, w01, w02, w03 134 , w04, w05, w06, w07 135 #) 136 {-# COMPLETE R #-} 137 138 -- parsing (nonfinal input) --------------------------------------------------- 139 140 -- | Given a bytestring and offset, parse a full block. 141 -- 142 -- The length of the input is not checked. 143 parse :: BS.ByteString -> Int -> Block 144 parse bs m = B 145 (word64be bs m) 146 (word64be bs (m + 08)) 147 (word64be bs (m + 16)) 148 (word64be bs (m + 24)) 149 (word64be bs (m + 32)) 150 (word64be bs (m + 40)) 151 (word64be bs (m + 48)) 152 (word64be bs (m + 56)) 153 (word64be bs (m + 64)) 154 (word64be bs (m + 72)) 155 (word64be bs (m + 80)) 156 (word64be bs (m + 88)) 157 (word64be bs (m + 96)) 158 (word64be bs (m + 104)) 159 (word64be bs (m + 112)) 160 (word64be bs (m + 120)) 161 {-# INLINE parse #-} 162 163 -- | Parse the 64-bit word encoded at the given offset. 164 -- 165 -- The length of the input is not checked. 166 word64be :: BS.ByteString -> Int -> Exts.Word64# 167 word64be bs m = 168 let !(GHC.Word.W8# r0) = BU.unsafeIndex bs m 169 !(GHC.Word.W8# r1) = BU.unsafeIndex bs (m + 1) 170 !(GHC.Word.W8# r2) = BU.unsafeIndex bs (m + 2) 171 !(GHC.Word.W8# r3) = BU.unsafeIndex bs (m + 3) 172 !(GHC.Word.W8# r4) = BU.unsafeIndex bs (m + 4) 173 !(GHC.Word.W8# r5) = BU.unsafeIndex bs (m + 5) 174 !(GHC.Word.W8# r6) = BU.unsafeIndex bs (m + 6) 175 !(GHC.Word.W8# r7) = BU.unsafeIndex bs (m + 7) 176 !w0 = Exts.word8ToWord# r0 177 !w1 = Exts.word8ToWord# r1 178 !w2 = Exts.word8ToWord# r2 179 !w3 = Exts.word8ToWord# r3 180 !w4 = Exts.word8ToWord# r4 181 !w5 = Exts.word8ToWord# r5 182 !w6 = Exts.word8ToWord# r6 183 !w7 = Exts.word8ToWord# r7 184 !s0 = Exts.uncheckedShiftL# w0 56# 185 !s1 = Exts.uncheckedShiftL# w1 48# 186 !s2 = Exts.uncheckedShiftL# w2 40# 187 !s3 = Exts.uncheckedShiftL# w3 32# 188 !s4 = Exts.uncheckedShiftL# w4 24# 189 !s5 = Exts.uncheckedShiftL# w5 16# 190 !s6 = Exts.uncheckedShiftL# w6 8# 191 in Exts.wordToWord64# 192 (s0 `Exts.or#` s1 `Exts.or#` s2 `Exts.or#` s3 `Exts.or#` 193 s4 `Exts.or#` s5 `Exts.or#` s6 `Exts.or#` w7) 194 {-# INLINE word64be #-} 195 196 -- parsing (final input) ------------------------------------------------------ 197 198 -- | Parse the final chunk of an input message, assuming it is less than 199 -- 112 bytes in length (unchecked!). 200 -- 201 -- Returns one block consisting of the chunk and padding. 202 parse_pad1 203 :: BS.ByteString -- ^ final input chunk (< 112 bytes) 204 -> Word64 -- ^ length of all input 205 -> Block -- ^ resulting block 206 parse_pad1 bs l = 207 let !bits = l * 8 208 !(GHC.Word.W64# llo) = bits 209 in B (w64_at bs 000) (w64_at bs 008) (w64_at bs 016) (w64_at bs 024) 210 (w64_at bs 032) (w64_at bs 040) (w64_at bs 048) (w64_at bs 056) 211 (w64_at bs 064) (w64_at bs 072) (w64_at bs 080) (w64_at bs 088) 212 (w64_at bs 096) (w64_at bs 104) (Exts.wordToWord64# 0##) llo 213 {-# INLINABLE parse_pad1 #-} 214 215 -- | Parse the final chunk of an input message, assuming it is at least 112 216 -- bytes in length (unchecked!). 217 -- 218 -- Returns two blocks consisting of the chunk and padding. 219 parse_pad2 220 :: BS.ByteString -- ^ final input chunk (>= 112 bytes) 221 -> Word64 -- ^ length of all input 222 -> (# Block, Block #) -- ^ resulting blocks 223 parse_pad2 bs l = 224 let !bits = l * 8 225 !z = Exts.wordToWord64# 0## 226 !(GHC.Word.W64# llo) = bits 227 !block0 = B 228 (w64_at bs 000) (w64_at bs 008) (w64_at bs 016) (w64_at bs 024) 229 (w64_at bs 032) (w64_at bs 040) (w64_at bs 048) (w64_at bs 056) 230 (w64_at bs 064) (w64_at bs 072) (w64_at bs 080) (w64_at bs 088) 231 (w64_at bs 096) (w64_at bs 104) (w64_at bs 112) (w64_at bs 120) 232 !block1 = B z z z z z z z z z z z z z z z llo 233 in (# block0, block1 #) 234 {-# INLINABLE parse_pad2 #-} 235 236 -- | Return the byte at offset 'i', or a padding separator or zero byte 237 -- beyond the input bounds, as an unboxed word. 238 w8_as_w64_at 239 :: BS.ByteString -- ^ input chunk 240 -> Int -- ^ offset 241 -> Exts.Word# 242 w8_as_w64_at bs@(BI.PS _ _ l) i = case compare i l of 243 LT -> let !(GHC.Word.W8# w) = BU.unsafeIndex bs i 244 in Exts.word8ToWord# w 245 EQ -> 0x80## 246 _ -> 0x00## 247 {-# INLINE w8_as_w64_at #-} 248 249 -- | Return the 64-bit word encoded by eight consecutive bytes at the 250 -- provided offset. 251 w64_at 252 :: BS.ByteString 253 -> Int 254 -> Exts.Word64# 255 w64_at bs i = 256 let !w0 = w8_as_w64_at bs i `Exts.uncheckedShiftL#` 56# 257 !w1 = w8_as_w64_at bs (i + 1) `Exts.uncheckedShiftL#` 48# 258 !w2 = w8_as_w64_at bs (i + 2) `Exts.uncheckedShiftL#` 40# 259 !w3 = w8_as_w64_at bs (i + 3) `Exts.uncheckedShiftL#` 32# 260 !w4 = w8_as_w64_at bs (i + 4) `Exts.uncheckedShiftL#` 24# 261 !w5 = w8_as_w64_at bs (i + 5) `Exts.uncheckedShiftL#` 16# 262 !w6 = w8_as_w64_at bs (i + 6) `Exts.uncheckedShiftL#` 08# 263 !w7 = w8_as_w64_at bs (i + 7) 264 in Exts.wordToWord64# 265 (w0 `Exts.or#` w1 `Exts.or#` w2 `Exts.or#` w3 `Exts.or#` 266 w4 `Exts.or#` w5 `Exts.or#` w6 `Exts.or#` w7) 267 {-# INLINE w64_at #-} 268 269 -- update --------------------------------------------------------------------- 270 271 -- | Update register state, given new input block. 272 update :: Registers -> Block -> Registers 273 update 274 (R h0 h1 h2 h3 h4 h5 h6 h7) 275 (B b00 b01 b02 b03 b04 b05 b06 b07 b08 b09 b10 b11 b12 b13 b14 b15) 276 = 277 let -- message schedule 278 !w00 = b00; !w01 = b01; !w02 = b02; !w03 = b03 279 !w04 = b04; !w05 = b05; !w06 = b06; !w07 = b07 280 !w08 = b08; !w09 = b09; !w10 = b10; !w11 = b11 281 !w12 = b12; !w13 = b13; !w14 = b14; !w15 = b15 282 !w16 = ssig1# w14 `p` w09 `p` ssig0# w01 `p` w00 283 !w17 = ssig1# w15 `p` w10 `p` ssig0# w02 `p` w01 284 !w18 = ssig1# w16 `p` w11 `p` ssig0# w03 `p` w02 285 !w19 = ssig1# w17 `p` w12 `p` ssig0# w04 `p` w03 286 !w20 = ssig1# w18 `p` w13 `p` ssig0# w05 `p` w04 287 !w21 = ssig1# w19 `p` w14 `p` ssig0# w06 `p` w05 288 !w22 = ssig1# w20 `p` w15 `p` ssig0# w07 `p` w06 289 !w23 = ssig1# w21 `p` w16 `p` ssig0# w08 `p` w07 290 !w24 = ssig1# w22 `p` w17 `p` ssig0# w09 `p` w08 291 !w25 = ssig1# w23 `p` w18 `p` ssig0# w10 `p` w09 292 !w26 = ssig1# w24 `p` w19 `p` ssig0# w11 `p` w10 293 !w27 = ssig1# w25 `p` w20 `p` ssig0# w12 `p` w11 294 !w28 = ssig1# w26 `p` w21 `p` ssig0# w13 `p` w12 295 !w29 = ssig1# w27 `p` w22 `p` ssig0# w14 `p` w13 296 !w30 = ssig1# w28 `p` w23 `p` ssig0# w15 `p` w14 297 !w31 = ssig1# w29 `p` w24 `p` ssig0# w16 `p` w15 298 !w32 = ssig1# w30 `p` w25 `p` ssig0# w17 `p` w16 299 !w33 = ssig1# w31 `p` w26 `p` ssig0# w18 `p` w17 300 !w34 = ssig1# w32 `p` w27 `p` ssig0# w19 `p` w18 301 !w35 = ssig1# w33 `p` w28 `p` ssig0# w20 `p` w19 302 !w36 = ssig1# w34 `p` w29 `p` ssig0# w21 `p` w20 303 !w37 = ssig1# w35 `p` w30 `p` ssig0# w22 `p` w21 304 !w38 = ssig1# w36 `p` w31 `p` ssig0# w23 `p` w22 305 !w39 = ssig1# w37 `p` w32 `p` ssig0# w24 `p` w23 306 !w40 = ssig1# w38 `p` w33 `p` ssig0# w25 `p` w24 307 !w41 = ssig1# w39 `p` w34 `p` ssig0# w26 `p` w25 308 !w42 = ssig1# w40 `p` w35 `p` ssig0# w27 `p` w26 309 !w43 = ssig1# w41 `p` w36 `p` ssig0# w28 `p` w27 310 !w44 = ssig1# w42 `p` w37 `p` ssig0# w29 `p` w28 311 !w45 = ssig1# w43 `p` w38 `p` ssig0# w30 `p` w29 312 !w46 = ssig1# w44 `p` w39 `p` ssig0# w31 `p` w30 313 !w47 = ssig1# w45 `p` w40 `p` ssig0# w32 `p` w31 314 !w48 = ssig1# w46 `p` w41 `p` ssig0# w33 `p` w32 315 !w49 = ssig1# w47 `p` w42 `p` ssig0# w34 `p` w33 316 !w50 = ssig1# w48 `p` w43 `p` ssig0# w35 `p` w34 317 !w51 = ssig1# w49 `p` w44 `p` ssig0# w36 `p` w35 318 !w52 = ssig1# w50 `p` w45 `p` ssig0# w37 `p` w36 319 !w53 = ssig1# w51 `p` w46 `p` ssig0# w38 `p` w37 320 !w54 = ssig1# w52 `p` w47 `p` ssig0# w39 `p` w38 321 !w55 = ssig1# w53 `p` w48 `p` ssig0# w40 `p` w39 322 !w56 = ssig1# w54 `p` w49 `p` ssig0# w41 `p` w40 323 !w57 = ssig1# w55 `p` w50 `p` ssig0# w42 `p` w41 324 !w58 = ssig1# w56 `p` w51 `p` ssig0# w43 `p` w42 325 !w59 = ssig1# w57 `p` w52 `p` ssig0# w44 `p` w43 326 !w60 = ssig1# w58 `p` w53 `p` ssig0# w45 `p` w44 327 !w61 = ssig1# w59 `p` w54 `p` ssig0# w46 `p` w45 328 !w62 = ssig1# w60 `p` w55 `p` ssig0# w47 `p` w46 329 !w63 = ssig1# w61 `p` w56 `p` ssig0# w48 `p` w47 330 !w64 = ssig1# w62 `p` w57 `p` ssig0# w49 `p` w48 331 !w65 = ssig1# w63 `p` w58 `p` ssig0# w50 `p` w49 332 !w66 = ssig1# w64 `p` w59 `p` ssig0# w51 `p` w50 333 !w67 = ssig1# w65 `p` w60 `p` ssig0# w52 `p` w51 334 !w68 = ssig1# w66 `p` w61 `p` ssig0# w53 `p` w52 335 !w69 = ssig1# w67 `p` w62 `p` ssig0# w54 `p` w53 336 !w70 = ssig1# w68 `p` w63 `p` ssig0# w55 `p` w54 337 !w71 = ssig1# w69 `p` w64 `p` ssig0# w56 `p` w55 338 !w72 = ssig1# w70 `p` w65 `p` ssig0# w57 `p` w56 339 !w73 = ssig1# w71 `p` w66 `p` ssig0# w58 `p` w57 340 !w74 = ssig1# w72 `p` w67 `p` ssig0# w59 `p` w58 341 !w75 = ssig1# w73 `p` w68 `p` ssig0# w60 `p` w59 342 !w76 = ssig1# w74 `p` w69 `p` ssig0# w61 `p` w60 343 !w77 = ssig1# w75 `p` w70 `p` ssig0# w62 `p` w61 344 !w78 = ssig1# w76 `p` w71 `p` ssig0# w63 `p` w62 345 !w79 = ssig1# w77 `p` w72 `p` ssig0# w64 `p` w63 346 347 -- rounds (constants are cube roots of first 80 primes) 348 !(R s00a s00b s00c s00d s00e s00f s00g s00h) = 349 step# h0 h1 h2 h3 h4 h5 h6 h7 (k 0x428a2f98d728ae22##) w00 350 !(R s01a s01b s01c s01d s01e s01f s01g s01h) = 351 step# s00a s00b s00c s00d s00e s00f s00g s00h 352 (k 0x7137449123ef65cd##) w01 353 !(R s02a s02b s02c s02d s02e s02f s02g s02h) = 354 step# s01a s01b s01c s01d s01e s01f s01g s01h 355 (k 0xb5c0fbcfec4d3b2f##) w02 356 !(R s03a s03b s03c s03d s03e s03f s03g s03h) = 357 step# s02a s02b s02c s02d s02e s02f s02g s02h 358 (k 0xe9b5dba58189dbbc##) w03 359 !(R s04a s04b s04c s04d s04e s04f s04g s04h) = 360 step# s03a s03b s03c s03d s03e s03f s03g s03h 361 (k 0x3956c25bf348b538##) w04 362 !(R s05a s05b s05c s05d s05e s05f s05g s05h) = 363 step# s04a s04b s04c s04d s04e s04f s04g s04h 364 (k 0x59f111f1b605d019##) w05 365 !(R s06a s06b s06c s06d s06e s06f s06g s06h) = 366 step# s05a s05b s05c s05d s05e s05f s05g s05h 367 (k 0x923f82a4af194f9b##) w06 368 !(R s07a s07b s07c s07d s07e s07f s07g s07h) = 369 step# s06a s06b s06c s06d s06e s06f s06g s06h 370 (k 0xab1c5ed5da6d8118##) w07 371 !(R s08a s08b s08c s08d s08e s08f s08g s08h) = 372 step# s07a s07b s07c s07d s07e s07f s07g s07h 373 (k 0xd807aa98a3030242##) w08 374 !(R s09a s09b s09c s09d s09e s09f s09g s09h) = 375 step# s08a s08b s08c s08d s08e s08f s08g s08h 376 (k 0x12835b0145706fbe##) w09 377 !(R s10a s10b s10c s10d s10e s10f s10g s10h) = 378 step# s09a s09b s09c s09d s09e s09f s09g s09h 379 (k 0x243185be4ee4b28c##) w10 380 !(R s11a s11b s11c s11d s11e s11f s11g s11h) = 381 step# s10a s10b s10c s10d s10e s10f s10g s10h 382 (k 0x550c7dc3d5ffb4e2##) w11 383 !(R s12a s12b s12c s12d s12e s12f s12g s12h) = 384 step# s11a s11b s11c s11d s11e s11f s11g s11h 385 (k 0x72be5d74f27b896f##) w12 386 !(R s13a s13b s13c s13d s13e s13f s13g s13h) = 387 step# s12a s12b s12c s12d s12e s12f s12g s12h 388 (k 0x80deb1fe3b1696b1##) w13 389 !(R s14a s14b s14c s14d s14e s14f s14g s14h) = 390 step# s13a s13b s13c s13d s13e s13f s13g s13h 391 (k 0x9bdc06a725c71235##) w14 392 !(R s15a s15b s15c s15d s15e s15f s15g s15h) = 393 step# s14a s14b s14c s14d s14e s14f s14g s14h 394 (k 0xc19bf174cf692694##) w15 395 !(R s16a s16b s16c s16d s16e s16f s16g s16h) = 396 step# s15a s15b s15c s15d s15e s15f s15g s15h 397 (k 0xe49b69c19ef14ad2##) w16 398 !(R s17a s17b s17c s17d s17e s17f s17g s17h) = 399 step# s16a s16b s16c s16d s16e s16f s16g s16h 400 (k 0xefbe4786384f25e3##) w17 401 !(R s18a s18b s18c s18d s18e s18f s18g s18h) = 402 step# s17a s17b s17c s17d s17e s17f s17g s17h 403 (k 0x0fc19dc68b8cd5b5##) w18 404 !(R s19a s19b s19c s19d s19e s19f s19g s19h) = 405 step# s18a s18b s18c s18d s18e s18f s18g s18h 406 (k 0x240ca1cc77ac9c65##) w19 407 !(R s20a s20b s20c s20d s20e s20f s20g s20h) = 408 step# s19a s19b s19c s19d s19e s19f s19g s19h 409 (k 0x2de92c6f592b0275##) w20 410 !(R s21a s21b s21c s21d s21e s21f s21g s21h) = 411 step# s20a s20b s20c s20d s20e s20f s20g s20h 412 (k 0x4a7484aa6ea6e483##) w21 413 !(R s22a s22b s22c s22d s22e s22f s22g s22h) = 414 step# s21a s21b s21c s21d s21e s21f s21g s21h 415 (k 0x5cb0a9dcbd41fbd4##) w22 416 !(R s23a s23b s23c s23d s23e s23f s23g s23h) = 417 step# s22a s22b s22c s22d s22e s22f s22g s22h 418 (k 0x76f988da831153b5##) w23 419 !(R s24a s24b s24c s24d s24e s24f s24g s24h) = 420 step# s23a s23b s23c s23d s23e s23f s23g s23h 421 (k 0x983e5152ee66dfab##) w24 422 !(R s25a s25b s25c s25d s25e s25f s25g s25h) = 423 step# s24a s24b s24c s24d s24e s24f s24g s24h 424 (k 0xa831c66d2db43210##) w25 425 !(R s26a s26b s26c s26d s26e s26f s26g s26h) = 426 step# s25a s25b s25c s25d s25e s25f s25g s25h 427 (k 0xb00327c898fb213f##) w26 428 !(R s27a s27b s27c s27d s27e s27f s27g s27h) = 429 step# s26a s26b s26c s26d s26e s26f s26g s26h 430 (k 0xbf597fc7beef0ee4##) w27 431 !(R s28a s28b s28c s28d s28e s28f s28g s28h) = 432 step# s27a s27b s27c s27d s27e s27f s27g s27h 433 (k 0xc6e00bf33da88fc2##) w28 434 !(R s29a s29b s29c s29d s29e s29f s29g s29h) = 435 step# s28a s28b s28c s28d s28e s28f s28g s28h 436 (k 0xd5a79147930aa725##) w29 437 !(R s30a s30b s30c s30d s30e s30f s30g s30h) = 438 step# s29a s29b s29c s29d s29e s29f s29g s29h 439 (k 0x06ca6351e003826f##) w30 440 !(R s31a s31b s31c s31d s31e s31f s31g s31h) = 441 step# s30a s30b s30c s30d s30e s30f s30g s30h 442 (k 0x142929670a0e6e70##) w31 443 !(R s32a s32b s32c s32d s32e s32f s32g s32h) = 444 step# s31a s31b s31c s31d s31e s31f s31g s31h 445 (k 0x27b70a8546d22ffc##) w32 446 !(R s33a s33b s33c s33d s33e s33f s33g s33h) = 447 step# s32a s32b s32c s32d s32e s32f s32g s32h 448 (k 0x2e1b21385c26c926##) w33 449 !(R s34a s34b s34c s34d s34e s34f s34g s34h) = 450 step# s33a s33b s33c s33d s33e s33f s33g s33h 451 (k 0x4d2c6dfc5ac42aed##) w34 452 !(R s35a s35b s35c s35d s35e s35f s35g s35h) = 453 step# s34a s34b s34c s34d s34e s34f s34g s34h 454 (k 0x53380d139d95b3df##) w35 455 !(R s36a s36b s36c s36d s36e s36f s36g s36h) = 456 step# s35a s35b s35c s35d s35e s35f s35g s35h 457 (k 0x650a73548baf63de##) w36 458 !(R s37a s37b s37c s37d s37e s37f s37g s37h) = 459 step# s36a s36b s36c s36d s36e s36f s36g s36h 460 (k 0x766a0abb3c77b2a8##) w37 461 !(R s38a s38b s38c s38d s38e s38f s38g s38h) = 462 step# s37a s37b s37c s37d s37e s37f s37g s37h 463 (k 0x81c2c92e47edaee6##) w38 464 !(R s39a s39b s39c s39d s39e s39f s39g s39h) = 465 step# s38a s38b s38c s38d s38e s38f s38g s38h 466 (k 0x92722c851482353b##) w39 467 !(R s40a s40b s40c s40d s40e s40f s40g s40h) = 468 step# s39a s39b s39c s39d s39e s39f s39g s39h 469 (k 0xa2bfe8a14cf10364##) w40 470 !(R s41a s41b s41c s41d s41e s41f s41g s41h) = 471 step# s40a s40b s40c s40d s40e s40f s40g s40h 472 (k 0xa81a664bbc423001##) w41 473 !(R s42a s42b s42c s42d s42e s42f s42g s42h) = 474 step# s41a s41b s41c s41d s41e s41f s41g s41h 475 (k 0xc24b8b70d0f89791##) w42 476 !(R s43a s43b s43c s43d s43e s43f s43g s43h) = 477 step# s42a s42b s42c s42d s42e s42f s42g s42h 478 (k 0xc76c51a30654be30##) w43 479 !(R s44a s44b s44c s44d s44e s44f s44g s44h) = 480 step# s43a s43b s43c s43d s43e s43f s43g s43h 481 (k 0xd192e819d6ef5218##) w44 482 !(R s45a s45b s45c s45d s45e s45f s45g s45h) = 483 step# s44a s44b s44c s44d s44e s44f s44g s44h 484 (k 0xd69906245565a910##) w45 485 !(R s46a s46b s46c s46d s46e s46f s46g s46h) = 486 step# s45a s45b s45c s45d s45e s45f s45g s45h 487 (k 0xf40e35855771202a##) w46 488 !(R s47a s47b s47c s47d s47e s47f s47g s47h) = 489 step# s46a s46b s46c s46d s46e s46f s46g s46h 490 (k 0x106aa07032bbd1b8##) w47 491 !(R s48a s48b s48c s48d s48e s48f s48g s48h) = 492 step# s47a s47b s47c s47d s47e s47f s47g s47h 493 (k 0x19a4c116b8d2d0c8##) w48 494 !(R s49a s49b s49c s49d s49e s49f s49g s49h) = 495 step# s48a s48b s48c s48d s48e s48f s48g s48h 496 (k 0x1e376c085141ab53##) w49 497 !(R s50a s50b s50c s50d s50e s50f s50g s50h) = 498 step# s49a s49b s49c s49d s49e s49f s49g s49h 499 (k 0x2748774cdf8eeb99##) w50 500 !(R s51a s51b s51c s51d s51e s51f s51g s51h) = 501 step# s50a s50b s50c s50d s50e s50f s50g s50h 502 (k 0x34b0bcb5e19b48a8##) w51 503 !(R s52a s52b s52c s52d s52e s52f s52g s52h) = 504 step# s51a s51b s51c s51d s51e s51f s51g s51h 505 (k 0x391c0cb3c5c95a63##) w52 506 !(R s53a s53b s53c s53d s53e s53f s53g s53h) = 507 step# s52a s52b s52c s52d s52e s52f s52g s52h 508 (k 0x4ed8aa4ae3418acb##) w53 509 !(R s54a s54b s54c s54d s54e s54f s54g s54h) = 510 step# s53a s53b s53c s53d s53e s53f s53g s53h 511 (k 0x5b9cca4f7763e373##) w54 512 !(R s55a s55b s55c s55d s55e s55f s55g s55h) = 513 step# s54a s54b s54c s54d s54e s54f s54g s54h 514 (k 0x682e6ff3d6b2b8a3##) w55 515 !(R s56a s56b s56c s56d s56e s56f s56g s56h) = 516 step# s55a s55b s55c s55d s55e s55f s55g s55h 517 (k 0x748f82ee5defb2fc##) w56 518 !(R s57a s57b s57c s57d s57e s57f s57g s57h) = 519 step# s56a s56b s56c s56d s56e s56f s56g s56h 520 (k 0x78a5636f43172f60##) w57 521 !(R s58a s58b s58c s58d s58e s58f s58g s58h) = 522 step# s57a s57b s57c s57d s57e s57f s57g s57h 523 (k 0x84c87814a1f0ab72##) w58 524 !(R s59a s59b s59c s59d s59e s59f s59g s59h) = 525 step# s58a s58b s58c s58d s58e s58f s58g s58h 526 (k 0x8cc702081a6439ec##) w59 527 !(R s60a s60b s60c s60d s60e s60f s60g s60h) = 528 step# s59a s59b s59c s59d s59e s59f s59g s59h 529 (k 0x90befffa23631e28##) w60 530 !(R s61a s61b s61c s61d s61e s61f s61g s61h) = 531 step# s60a s60b s60c s60d s60e s60f s60g s60h 532 (k 0xa4506cebde82bde9##) w61 533 !(R s62a s62b s62c s62d s62e s62f s62g s62h) = 534 step# s61a s61b s61c s61d s61e s61f s61g s61h 535 (k 0xbef9a3f7b2c67915##) w62 536 !(R s63a s63b s63c s63d s63e s63f s63g s63h) = 537 step# s62a s62b s62c s62d s62e s62f s62g s62h 538 (k 0xc67178f2e372532b##) w63 539 !(R s64a s64b s64c s64d s64e s64f s64g s64h) = 540 step# s63a s63b s63c s63d s63e s63f s63g s63h 541 (k 0xca273eceea26619c##) w64 542 !(R s65a s65b s65c s65d s65e s65f s65g s65h) = 543 step# s64a s64b s64c s64d s64e s64f s64g s64h 544 (k 0xd186b8c721c0c207##) w65 545 !(R s66a s66b s66c s66d s66e s66f s66g s66h) = 546 step# s65a s65b s65c s65d s65e s65f s65g s65h 547 (k 0xeada7dd6cde0eb1e##) w66 548 !(R s67a s67b s67c s67d s67e s67f s67g s67h) = 549 step# s66a s66b s66c s66d s66e s66f s66g s66h 550 (k 0xf57d4f7fee6ed178##) w67 551 !(R s68a s68b s68c s68d s68e s68f s68g s68h) = 552 step# s67a s67b s67c s67d s67e s67f s67g s67h 553 (k 0x06f067aa72176fba##) w68 554 !(R s69a s69b s69c s69d s69e s69f s69g s69h) = 555 step# s68a s68b s68c s68d s68e s68f s68g s68h 556 (k 0x0a637dc5a2c898a6##) w69 557 !(R s70a s70b s70c s70d s70e s70f s70g s70h) = 558 step# s69a s69b s69c s69d s69e s69f s69g s69h 559 (k 0x113f9804bef90dae##) w70 560 !(R s71a s71b s71c s71d s71e s71f s71g s71h) = 561 step# s70a s70b s70c s70d s70e s70f s70g s70h 562 (k 0x1b710b35131c471b##) w71 563 !(R s72a s72b s72c s72d s72e s72f s72g s72h) = 564 step# s71a s71b s71c s71d s71e s71f s71g s71h 565 (k 0x28db77f523047d84##) w72 566 !(R s73a s73b s73c s73d s73e s73f s73g s73h) = 567 step# s72a s72b s72c s72d s72e s72f s72g s72h 568 (k 0x32caab7b40c72493##) w73 569 !(R s74a s74b s74c s74d s74e s74f s74g s74h) = 570 step# s73a s73b s73c s73d s73e s73f s73g s73h 571 (k 0x3c9ebe0a15c9bebc##) w74 572 !(R s75a s75b s75c s75d s75e s75f s75g s75h) = 573 step# s74a s74b s74c s74d s74e s74f s74g s74h 574 (k 0x431d67c49c100d4c##) w75 575 !(R s76a s76b s76c s76d s76e s76f s76g s76h) = 576 step# s75a s75b s75c s75d s75e s75f s75g s75h 577 (k 0x4cc5d4becb3e42b6##) w76 578 !(R s77a s77b s77c s77d s77e s77f s77g s77h) = 579 step# s76a s76b s76c s76d s76e s76f s76g s76h 580 (k 0x597f299cfc657e2a##) w77 581 !(R s78a s78b s78c s78d s78e s78f s78g s78h) = 582 step# s77a s77b s77c s77d s77e s77f s77g s77h 583 (k 0x5fcb6fab3ad6faec##) w78 584 !(R s79a s79b s79c s79d s79e s79f s79g s79h) = 585 step# s78a s78b s78c s78d s78e s78f s78g s78h 586 (k 0x6c44198c4a475817##) w79 587 in R (h0 `p` s79a) (h1 `p` s79b) (h2 `p` s79c) (h3 `p` s79d) 588 (h4 `p` s79e) (h5 `p` s79f) (h6 `p` s79g) (h7 `p` s79h) 589 where 590 p = Exts.plusWord64# 591 {-# INLINE p #-} 592 k :: Exts.Word# -> Exts.Word64# 593 k = Exts.wordToWord64# 594 {-# INLINE k #-} 595 596 -- rotate right 597 rotr# :: Exts.Word64# -> Int# -> Exts.Word64# 598 rotr# x n = 599 Exts.uncheckedShiftRL64# x n `Exts.or64#` 600 Exts.uncheckedShiftL64# x (64# Exts.-# n) 601 {-# INLINE rotr# #-} 602 603 -- logical right shift 604 shr# :: Exts.Word64# -> Int# -> Exts.Word64# 605 shr# = Exts.uncheckedShiftRL64# 606 {-# INLINE shr# #-} 607 608 -- ch(x, y, z) = (x & y) ^ (~x & z) 609 ch# :: Exts.Word64# -> Exts.Word64# -> Exts.Word64# -> Exts.Word64# 610 ch# x y z = 611 (x `Exts.and64#` y) `Exts.xor64#` 612 (Exts.not64# x `Exts.and64#` z) 613 {-# INLINE ch# #-} 614 615 -- maj(x, y, z) = (x & (y | z)) | (y & z) 616 maj# :: Exts.Word64# -> Exts.Word64# -> Exts.Word64# -> Exts.Word64# 617 maj# x y z = 618 (x `Exts.and64#` (y `Exts.or64#` z)) `Exts.or64#` 619 (y `Exts.and64#` z) 620 {-# INLINE maj# #-} 621 622 -- big sigma 0: rotr28 ^ rotr34 ^ rotr39 623 bsig0# :: Exts.Word64# -> Exts.Word64# 624 bsig0# x = 625 rotr# x 28# `Exts.xor64#` rotr# x 34# `Exts.xor64#` rotr# x 39# 626 {-# INLINE bsig0# #-} 627 628 -- big sigma 1: rotr14 ^ rotr18 ^ rotr41 629 bsig1# :: Exts.Word64# -> Exts.Word64# 630 bsig1# x = 631 rotr# x 14# `Exts.xor64#` rotr# x 18# `Exts.xor64#` rotr# x 41# 632 {-# INLINE bsig1# #-} 633 634 -- small sigma 0: rotr1 ^ rotr8 ^ shr7 635 ssig0# :: Exts.Word64# -> Exts.Word64# 636 ssig0# x = 637 rotr# x 1# `Exts.xor64#` rotr# x 8# `Exts.xor64#` shr# x 7# 638 {-# INLINE ssig0# #-} 639 640 -- small sigma 1: rotr19 ^ rotr61 ^ shr6 641 ssig1# :: Exts.Word64# -> Exts.Word64# 642 ssig1# x = 643 rotr# x 19# `Exts.xor64#` rotr# x 61# `Exts.xor64#` shr# x 6# 644 {-# INLINE ssig1# #-} 645 646 -- round step 647 step# 648 :: Exts.Word64# -> Exts.Word64# -> Exts.Word64# -> Exts.Word64# 649 -> Exts.Word64# -> Exts.Word64# -> Exts.Word64# -> Exts.Word64# 650 -> Exts.Word64# -> Exts.Word64# 651 -> Registers 652 step# a b c d e f g h k w = 653 let !t1 = h 654 `Exts.plusWord64#` bsig1# e 655 `Exts.plusWord64#` ch# e f g 656 `Exts.plusWord64#` k 657 `Exts.plusWord64#` w 658 !t2 = bsig0# a `Exts.plusWord64#` maj# a b c 659 in R (t1 `Exts.plusWord64#` t2) a b c (d `Exts.plusWord64#` t1) e f g 660 {-# INLINE step# #-} 661 662 -- initial register state; first 64 bits of the fractional parts of the 663 -- square roots of the first eight primes 664 iv :: () -> Registers 665 iv _ = R 666 (Exts.wordToWord64# 0x6a09e667f3bcc908##) 667 (Exts.wordToWord64# 0xbb67ae8584caa73b##) 668 (Exts.wordToWord64# 0x3c6ef372fe94f82b##) 669 (Exts.wordToWord64# 0xa54ff53a5f1d36f1##) 670 (Exts.wordToWord64# 0x510e527fade682d1##) 671 (Exts.wordToWord64# 0x9b05688c2b3e6c1f##) 672 (Exts.wordToWord64# 0x1f83d9abfb41bd6b##) 673 (Exts.wordToWord64# 0x5be0cd19137e2179##) 674 675 -- serializing ---------------------------------------------------------------- 676 677 -- | Concat SHA512 state into a ByteString. 678 cat :: Registers -> BS.ByteString 679 cat rs = BI.unsafeCreate 64 (cat_into rs) 680 {-# INLINABLE cat #-} 681 682 -- | Serialize SHA512 state to a pointer (big-endian). 683 cat_into :: Registers -> Ptr Word8 -> IO () 684 cat_into (R h0 h1 h2 h3 h4 h5 h6 h7) (Ptr addr) = GHC.IO.IO $ \s0 -> 685 case poke64be addr 00# h0 s0 of { s1 -> 686 case poke64be addr 08# h1 s1 of { s2 -> 687 case poke64be addr 16# h2 s2 of { s3 -> 688 case poke64be addr 24# h3 s3 of { s4 -> 689 case poke64be addr 32# h4 s4 of { s5 -> 690 case poke64be addr 40# h5 s5 of { s6 -> 691 case poke64be addr 48# h6 s6 of { s7 -> 692 case poke64be addr 56# h7 s7 of { s8 -> 693 (# s8, () #) 694 }}}}}}}} 695 {-# INLINE cat_into #-} 696 697 poke64be 698 :: Exts.Addr# 699 -> Int# 700 -> Exts.Word64# 701 -> Exts.State# Exts.RealWorld 702 -> Exts.State# Exts.RealWorld 703 poke64be a off w s0 = 704 case Exts.writeWord8OffAddr# a off (byte# w 56#) s0 of { s1 -> 705 case Exts.writeWord8OffAddr# a (off Exts.+# 1#) (byte# w 48#) s1 of { s2 -> 706 case Exts.writeWord8OffAddr# a (off Exts.+# 2#) (byte# w 40#) s2 of { s3 -> 707 case Exts.writeWord8OffAddr# a (off Exts.+# 3#) (byte# w 32#) s3 of { s4 -> 708 case Exts.writeWord8OffAddr# a (off Exts.+# 4#) (byte# w 24#) s4 of { s5 -> 709 case Exts.writeWord8OffAddr# a (off Exts.+# 5#) (byte# w 16#) s5 of { s6 -> 710 case Exts.writeWord8OffAddr# a (off Exts.+# 6#) (byte# w 8#) s6 of { s7 -> 711 Exts.writeWord8OffAddr# a (off Exts.+# 7#) (byte# w 0#) s7 712 }}}}}}} 713 {-# INLINE poke64be #-} 714 715 byte# :: Exts.Word64# -> Int# -> Exts.Word8# 716 byte# w n = Exts.wordToWord8# 717 (Exts.word64ToWord# (Exts.uncheckedShiftRL64# w n)) 718 {-# INLINE byte# #-} 719 720 -- | Write register state to a pointer (native endian Word64s). 721 poke_registers :: Ptr Word64 -> Registers -> IO () 722 poke_registers (Ptr addr) (R w0 w1 w2 w3 w4 w5 w6 w7) = GHC.IO.IO $ \s0 -> 723 case Exts.writeWord64OffAddr# addr 0# w0 s0 of { s1 -> 724 case Exts.writeWord64OffAddr# addr 1# w1 s1 of { s2 -> 725 case Exts.writeWord64OffAddr# addr 2# w2 s2 of { s3 -> 726 case Exts.writeWord64OffAddr# addr 3# w3 s3 of { s4 -> 727 case Exts.writeWord64OffAddr# addr 4# w4 s4 of { s5 -> 728 case Exts.writeWord64OffAddr# addr 5# w5 s5 of { s6 -> 729 case Exts.writeWord64OffAddr# addr 6# w6 s6 of { s7 -> 730 case Exts.writeWord64OffAddr# addr 7# w7 s7 of { s8 -> 731 (# s8, () #) }}}}}}}} 732 {-# INLINE poke_registers #-} 733 734 -- hmac utilities ------------------------------------------------------------- 735 736 -- pad registers to block 737 pad_registers :: Registers -> Block 738 pad_registers (R w0 w1 w2 w3 w4 w5 w6 w7) = B 739 w0 w1 w2 w3 w4 w5 w6 w7 740 (Exts.wordToWord64# 0##) (Exts.wordToWord64# 0##) (Exts.wordToWord64# 0##) 741 (Exts.wordToWord64# 0##) (Exts.wordToWord64# 0##) (Exts.wordToWord64# 0##) 742 (Exts.wordToWord64# 0##) (Exts.wordToWord64# 0##) 743 {-# INLINE pad_registers #-} 744 745 -- pad registers to block, using padding separator and augmented length 746 -- (assumes existence of a leading block) 747 -- length = (128 + 64) * 8 = 1536 = 0x600 748 pad_registers_with_length :: Registers -> Block 749 pad_registers_with_length (R h0 h1 h2 h3 h4 h5 h6 h7) = B 750 h0 h1 h2 h3 h4 h5 h6 h7 -- inner hash 751 (Exts.wordToWord64# 0x8000000000000000##) -- padding separator 752 (Exts.wordToWord64# 0x0000000000000000##) 753 (Exts.wordToWord64# 0x0000000000000000##) 754 (Exts.wordToWord64# 0x0000000000000000##) 755 (Exts.wordToWord64# 0x0000000000000000##) 756 (Exts.wordToWord64# 0x0000000000000000##) 757 (Exts.wordToWord64# 0x0000000000000000##) -- high 64 bits of length 758 (Exts.wordToWord64# 0x0000000000000600##) -- low 64 bits of length 759 {-# INLINABLE pad_registers_with_length #-} 760 761 xor :: Block -> Exts.Word64# -> Block 762 xor (B w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 w10 w11 w12 w13 w14 w15) b = B 763 (Exts.xor64# w00 b) 764 (Exts.xor64# w01 b) 765 (Exts.xor64# w02 b) 766 (Exts.xor64# w03 b) 767 (Exts.xor64# w04 b) 768 (Exts.xor64# w05 b) 769 (Exts.xor64# w06 b) 770 (Exts.xor64# w07 b) 771 (Exts.xor64# w08 b) 772 (Exts.xor64# w09 b) 773 (Exts.xor64# w10 b) 774 (Exts.xor64# w11 b) 775 (Exts.xor64# w12 b) 776 (Exts.xor64# w13 b) 777 (Exts.xor64# w14 b) 778 (Exts.xor64# w15 b) 779 {-# INLINE xor #-} 780 781 parse_key :: BS.ByteString -> Block 782 parse_key bs = B 783 (w64_zero bs 000) (w64_zero bs 008) (w64_zero bs 016) (w64_zero bs 024) 784 (w64_zero bs 032) (w64_zero bs 040) (w64_zero bs 048) (w64_zero bs 056) 785 (w64_zero bs 064) (w64_zero bs 072) (w64_zero bs 080) (w64_zero bs 088) 786 (w64_zero bs 096) (w64_zero bs 104) (w64_zero bs 112) (w64_zero bs 120) 787 {-# INLINE parse_key #-} 788 789 -- read big-endian Word64#, zero-padding beyond input length 790 w64_zero :: BS.ByteString -> Int -> Exts.Word64# 791 w64_zero bs i = 792 let !w0 = w8_zero bs i `Exts.uncheckedShiftL#` 56# 793 !w1 = w8_zero bs (i + 1) `Exts.uncheckedShiftL#` 48# 794 !w2 = w8_zero bs (i + 2) `Exts.uncheckedShiftL#` 40# 795 !w3 = w8_zero bs (i + 3) `Exts.uncheckedShiftL#` 32# 796 !w4 = w8_zero bs (i + 4) `Exts.uncheckedShiftL#` 24# 797 !w5 = w8_zero bs (i + 5) `Exts.uncheckedShiftL#` 16# 798 !w6 = w8_zero bs (i + 6) `Exts.uncheckedShiftL#` 08# 799 !w7 = w8_zero bs (i + 7) 800 in Exts.wordToWord64# 801 (w0 `Exts.or#` w1 `Exts.or#` w2 `Exts.or#` w3 `Exts.or#` 802 w4 `Exts.or#` w5 `Exts.or#` w6 `Exts.or#` w7) 803 {-# INLINE w64_zero #-} 804 805 -- read byte as Word#, returning zero beyond input length 806 w8_zero :: BS.ByteString -> Int -> Exts.Word# 807 w8_zero bs@(BI.PS _ _ l) i 808 | i < l = let !(GHC.Word.W8# w) = BU.unsafeIndex bs i 809 in Exts.word8ToWord# w 810 | otherwise = 0## 811 {-# INLINE w8_zero #-} 812 813 -- hmac-drbg utilities -------------------------------------------------------- 814 815 -- | Parse first complete block from v || sep || dat[0:63]. 816 -- 817 -- Requires len(dat) >= 63. 818 parse_vsb :: Registers -> Word8 -> BS.ByteString -> Block 819 parse_vsb (R v0 v1 v2 v3 v4 v5 v6 v7) (GHC.Word.W8# sep) dat = 820 let !(GHC.Word.W8# b0) = BU.unsafeIndex dat 0 821 !(GHC.Word.W8# b1) = BU.unsafeIndex dat 1 822 !(GHC.Word.W8# b2) = BU.unsafeIndex dat 2 823 !(GHC.Word.W8# b3) = BU.unsafeIndex dat 3 824 !(GHC.Word.W8# b4) = BU.unsafeIndex dat 4 825 !(GHC.Word.W8# b5) = BU.unsafeIndex dat 5 826 !(GHC.Word.W8# b6) = BU.unsafeIndex dat 6 827 !w08 = Exts.uncheckedShiftL# (Exts.word8ToWord# sep) 56# 828 `Exts.or#` Exts.uncheckedShiftL# (Exts.word8ToWord# b0) 48# 829 `Exts.or#` Exts.uncheckedShiftL# (Exts.word8ToWord# b1) 40# 830 `Exts.or#` Exts.uncheckedShiftL# (Exts.word8ToWord# b2) 32# 831 `Exts.or#` Exts.uncheckedShiftL# (Exts.word8ToWord# b3) 24# 832 `Exts.or#` Exts.uncheckedShiftL# (Exts.word8ToWord# b4) 16# 833 `Exts.or#` Exts.uncheckedShiftL# (Exts.word8ToWord# b5) 08# 834 `Exts.or#` Exts.word8ToWord# b6 835 in B v0 v1 v2 v3 v4 v5 v6 v7 836 (Exts.wordToWord64# w08) 837 (word64be dat 07) (word64be dat 15) (word64be dat 23) 838 (word64be dat 31) (word64be dat 39) (word64be dat 47) (word64be dat 55) 839 {-# INLINE parse_vsb #-} 840 841 -- | Parse single padding block from v || sep || dat. 842 -- 843 -- Requires (65 + len(dat)) < 112. 844 parse_pad1_vsb :: Registers -> Word8 -> BS.ByteString -> Word64 -> Block 845 parse_pad1_vsb (R v0 v1 v2 v3 v4 v5 v6 v7) sep dat total = 846 let !bits = total * 8 847 !(GHC.Word.W64# llo) = bits 848 in B v0 v1 v2 v3 v4 v5 v6 v7 849 (w64_sdp sep dat 064) (w64_sdp sep dat 072) 850 (w64_sdp sep dat 080) (w64_sdp sep dat 088) 851 (w64_sdp sep dat 096) (w64_sdp sep dat 104) 852 (Exts.wordToWord64# 0##) llo 853 {-# INLINABLE parse_pad1_vsb #-} 854 855 -- | Parse two padding blocks from v || sep || dat. 856 -- 857 -- Requires 112 <= (65 + len(dat)) < 128. 858 parse_pad2_vsb 859 :: Registers -> Word8 -> BS.ByteString -> Word64 -> (# Block, Block #) 860 parse_pad2_vsb (R v0 v1 v2 v3 v4 v5 v6 v7) sep dat total = 861 let !bits = total * 8 862 !z = Exts.wordToWord64# 0## 863 !(GHC.Word.W64# llo) = bits 864 !b0 = B v0 v1 v2 v3 v4 v5 v6 v7 865 (w64_sdp sep dat 064) (w64_sdp sep dat 072) 866 (w64_sdp sep dat 080) (w64_sdp sep dat 088) 867 (w64_sdp sep dat 096) (w64_sdp sep dat 104) 868 (w64_sdp sep dat 112) (w64_sdp sep dat 120) 869 !b1 = B z z z z z z z z z z z z z z z llo 870 in (# b0, b1 #) 871 {-# INLINABLE parse_pad2_vsb #-} 872 873 -- Read Word64 at offset i (>= 64) from (sep || dat || 0x80 || zeros). 874 w64_sdp :: Word8 -> BS.ByteString -> Int -> Exts.Word64# 875 w64_sdp sep dat i = 876 let !(GHC.Word.W8# a) = byte_sdp sep dat i 877 !(GHC.Word.W8# b) = byte_sdp sep dat (i + 1) 878 !(GHC.Word.W8# c) = byte_sdp sep dat (i + 2) 879 !(GHC.Word.W8# d) = byte_sdp sep dat (i + 3) 880 !(GHC.Word.W8# e) = byte_sdp sep dat (i + 4) 881 !(GHC.Word.W8# f) = byte_sdp sep dat (i + 5) 882 !(GHC.Word.W8# g) = byte_sdp sep dat (i + 6) 883 !(GHC.Word.W8# h) = byte_sdp sep dat (i + 7) 884 in Exts.wordToWord64# 885 (Exts.uncheckedShiftL# (Exts.word8ToWord# a) 56# 886 `Exts.or#` 887 Exts.uncheckedShiftL# (Exts.word8ToWord# b) 48# 888 `Exts.or#` 889 Exts.uncheckedShiftL# (Exts.word8ToWord# c) 40# 890 `Exts.or#` 891 Exts.uncheckedShiftL# (Exts.word8ToWord# d) 32# 892 `Exts.or#` 893 Exts.uncheckedShiftL# (Exts.word8ToWord# e) 24# 894 `Exts.or#` 895 Exts.uncheckedShiftL# (Exts.word8ToWord# f) 16# 896 `Exts.or#` 897 Exts.uncheckedShiftL# (Exts.word8ToWord# g) 8# 898 `Exts.or#` 899 Exts.word8ToWord# h) 900 {-# INLINE w64_sdp #-} 901 902 -- Read byte at offset i (>= 64) from (sep || dat || 0x80 || zeros). 903 byte_sdp :: Word8 -> BS.ByteString -> Int -> Word8 904 byte_sdp sep dat@(BI.PS _ _ l) i 905 | i == 64 = sep 906 | i < 65 + l = BU.unsafeIndex dat (i - 65) 907 | i == 65 + l = 0x80 908 | otherwise = 0x00 909 {-# INLINE byte_sdp #-} 910