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