SHA.hs (48103B)
1 -- NB (jtobin): this entire module is a modified copy-paste of 2 -- 3 -- https://hackage.haskell.org/package/SHA-1.6.4.4/docs/src/Data.Digest.Pure.SHA.html 4 5 {-# LANGUAGE CPP, FlexibleInstances #-} 6 -- |Pure implementations of the SHA suite of hash functions. The implementation 7 -- is basically an unoptimized translation of FIPS 180-2 into Haskell. If you're 8 -- looking for performance, you probably won't find it here. 9 module Cryptopals.Digest.Pure.SHA 10 ( -- * 'Digest' and related functions 11 Digest 12 , SHA1State(..), SHA256State, SHA512State 13 , showDigest 14 , integerDigest 15 , bytestringDigest 16 -- * Calculating hashes 17 , sha1 18 , sha1', sha1'' 19 , sha224 20 , sha256 21 , sha384 22 , sha512 23 , sha1Incremental 24 , completeSha1Incremental 25 , sha224Incremental 26 , completeSha224Incremental 27 , sha256Incremental 28 , completeSha256Incremental 29 , sha384Incremental 30 , completeSha384Incremental 31 , sha512Incremental 32 , completeSha512Incremental 33 -- * Calculating message authentication codes (MACs) 34 , hmacSha1 35 , hmacSha224 36 , hmacSha256 37 , hmacSha384 38 , hmacSha512 39 -- * Internal routines included for testing 40 , toBigEndianSBS, fromBigEndianSBS 41 , calc_k 42 , padSHA1, padSHA512 43 , padSHA1Chunks, padSHA512Chunks 44 -- etc (jtobin) 45 , getSHA1 46 ) 47 where 48 49 import Data.Binary 50 import Data.Binary.Get 51 import Data.Binary.Put 52 import Data.Bits 53 import Data.ByteString.Lazy(ByteString) 54 import qualified Data.ByteString.Lazy as BS 55 import qualified Data.ByteString as SBS 56 import Data.Char (intToDigit) 57 import Data.List (foldl') 58 59 -- | An abstract datatype for digests. 60 newtype Digest t = Digest ByteString deriving (Eq,Ord) 61 62 instance Show (Digest t) where 63 show = showDigest 64 65 instance Binary (Digest SHA1State) where 66 get = Digest `fmap` getLazyByteString 20 67 put (Digest bs) = putLazyByteString bs 68 69 instance Binary (Digest SHA256State) where 70 get = Digest `fmap` getLazyByteString 32 71 put (Digest bs) = putLazyByteString bs 72 73 instance Binary (Digest SHA512State) where 74 get = Digest `fmap` getLazyByteString 64 75 put (Digest bs) = putLazyByteString bs 76 77 -- -------------------------------------------------------------------------- 78 -- 79 -- State Definitions and Initial States 80 -- 81 -- -------------------------------------------------------------------------- 82 83 data SHA1State = SHA1S !Word32 !Word32 !Word32 !Word32 !Word32 84 deriving Show 85 86 initialSHA1State :: SHA1State 87 initialSHA1State = SHA1S 0x67452301 0xefcdab89 0x98badcfe 0x10325476 0xc3d2e1f0 88 89 data SHA256State = SHA256S !Word32 !Word32 !Word32 !Word32 90 !Word32 !Word32 !Word32 !Word32 91 92 initialSHA224State :: SHA256State 93 initialSHA224State = SHA256S 0xc1059ed8 0x367cd507 0x3070dd17 0xf70e5939 94 0xffc00b31 0x68581511 0x64f98fa7 0xbefa4fa4 95 96 initialSHA256State :: SHA256State 97 initialSHA256State = SHA256S 0x6a09e667 0xbb67ae85 0x3c6ef372 0xa54ff53a 98 0x510e527f 0x9b05688c 0x1f83d9ab 0x5be0cd19 99 100 data SHA512State = SHA512S !Word64 !Word64 !Word64 !Word64 101 !Word64 !Word64 !Word64 !Word64 102 103 initialSHA384State :: SHA512State 104 initialSHA384State = SHA512S 0xcbbb9d5dc1059ed8 0x629a292a367cd507 105 0x9159015a3070dd17 0x152fecd8f70e5939 106 0x67332667ffc00b31 0x8eb44a8768581511 107 0xdb0c2e0d64f98fa7 0x47b5481dbefa4fa4 108 109 initialSHA512State :: SHA512State 110 initialSHA512State = SHA512S 0x6a09e667f3bcc908 0xbb67ae8584caa73b 111 0x3c6ef372fe94f82b 0xa54ff53a5f1d36f1 112 0x510e527fade682d1 0x9b05688c2b3e6c1f 113 0x1f83d9abfb41bd6b 0x5be0cd19137e2179 114 115 -- -------------------------------------------------------------------------- 116 -- 117 -- Synthesize of states to and from ByteStrings 118 -- 119 -- -------------------------------------------------------------------------- 120 121 122 synthesizeSHA1 :: SHA1State -> Put 123 synthesizeSHA1 (SHA1S a b c d e) = do 124 putWord32be a 125 putWord32be b 126 putWord32be c 127 putWord32be d 128 putWord32be e 129 130 getSHA1 :: Get SHA1State 131 getSHA1 = do 132 a <- getWord32be 133 b <- getWord32be 134 c <- getWord32be 135 d <- getWord32be 136 e <- getWord32be 137 return $! SHA1S a b c d e 138 139 synthesizeSHA224 :: SHA256State -> Put 140 synthesizeSHA224 (SHA256S a b c d e f g _) = do 141 putWord32be a 142 putWord32be b 143 putWord32be c 144 putWord32be d 145 putWord32be e 146 putWord32be f 147 putWord32be g 148 149 synthesizeSHA256 :: SHA256State -> Put 150 synthesizeSHA256 (SHA256S a b c d e f g h) = do 151 putWord32be a 152 putWord32be b 153 putWord32be c 154 putWord32be d 155 putWord32be e 156 putWord32be f 157 putWord32be g 158 putWord32be h 159 160 getSHA256 :: Get SHA256State 161 getSHA256 = do 162 a <- getWord32be 163 b <- getWord32be 164 c <- getWord32be 165 d <- getWord32be 166 e <- getWord32be 167 f <- getWord32be 168 g <- getWord32be 169 h <- getWord32be 170 return $! SHA256S a b c d e f g h 171 172 synthesizeSHA384 :: SHA512State -> Put 173 synthesizeSHA384 (SHA512S a b c d e f _ _) = do 174 putWord64be a 175 putWord64be b 176 putWord64be c 177 putWord64be d 178 putWord64be e 179 putWord64be f 180 181 synthesizeSHA512 :: SHA512State -> Put 182 synthesizeSHA512 (SHA512S a b c d e f g h) = do 183 putWord64be a 184 putWord64be b 185 putWord64be c 186 putWord64be d 187 putWord64be e 188 putWord64be f 189 putWord64be g 190 putWord64be h 191 192 getSHA512 :: Get SHA512State 193 getSHA512 = do 194 a <- getWord64be 195 b <- getWord64be 196 c <- getWord64be 197 d <- getWord64be 198 e <- getWord64be 199 f <- getWord64be 200 g <- getWord64be 201 h <- getWord64be 202 return $! SHA512S a b c d e f g h 203 204 instance Binary SHA1State where 205 put = synthesizeSHA1 206 get = getSHA1 207 208 instance Binary SHA256State where 209 put = synthesizeSHA256 210 get = getSHA256 211 212 instance Binary SHA512State where 213 put = synthesizeSHA512 214 get = getSHA512 215 216 217 -- -------------------------------------------------------------------------- 218 -- 219 -- Padding 220 -- 221 -- -------------------------------------------------------------------------- 222 223 padSHA1 :: ByteString -> ByteString 224 padSHA1 = generic_pad 448 512 64 225 226 padSHA1Chunks :: Int -> [SBS.ByteString] 227 padSHA1Chunks = generic_pad_chunks 448 512 64 228 229 padSHA512 :: ByteString -> ByteString 230 padSHA512 = generic_pad 896 1024 128 231 232 padSHA512Chunks :: Int -> [SBS.ByteString] 233 padSHA512Chunks = generic_pad_chunks 896 1024 128 234 235 generic_pad :: Word64 -> Word64 -> Int -> ByteString -> ByteString 236 generic_pad a b lSize bs = 237 BS.fromChunks $! go 0 chunks 238 where 239 chunks = BS.toChunks bs 240 241 -- Generates the padded ByteString at the same time it computes the length 242 -- of input. If the length is computed before the computation of the hash, it 243 -- will break the lazy evaluation of the input and no longer run in constant 244 -- memory space. 245 go !len [] = generic_pad_chunks a b lSize len 246 go !len (c:cs) = c : go (len + SBS.length c) cs 247 248 generic_pad_chunks :: Word64 -> Word64 -> Int -> Int -> [SBS.ByteString] 249 generic_pad_chunks a b lSize len = 250 let lenBits = fromIntegral $ len * 8 251 k = calc_k a b lenBits 252 -- INVARIANT: k is necessarily > 0, and (k + 1) is a multiple of 8. 253 kBytes = (k + 1) `div` 8 254 nZeroBytes = fromIntegral $! kBytes - 1 255 padLength = toBigEndianSBS lSize lenBits 256 in [SBS.singleton 0x80, SBS.replicate nZeroBytes 0, padLength] 257 258 -- Given a, b, and l, calculate the smallest k such that (l + 1 + k) mod b = a. 259 calc_k :: Word64 -> Word64 -> Word64 -> Word64 260 calc_k a b l = 261 if r <= -1 262 then fromIntegral r + b 263 else fromIntegral r 264 where 265 r = toInteger a - toInteger l `mod` toInteger b - 1 266 267 toBigEndianSBS :: (Integral a, Bits a) => Int -> a -> SBS.ByteString 268 toBigEndianSBS s val = SBS.pack $ map getBits [s - 8, s - 16 .. 0] 269 where 270 getBits x = fromIntegral $ (val `shiftR` x) .&. 0xFF 271 272 fromBigEndianSBS :: (Integral a, Bits a) => SBS.ByteString -> a 273 fromBigEndianSBS = 274 SBS.foldl (\ acc x -> (acc `shiftL` 8) + fromIntegral x) 0 275 276 -- -------------------------------------------------------------------------- 277 -- 278 -- SHA Functions 279 -- 280 -- -------------------------------------------------------------------------- 281 282 {-# SPECIALIZE ch :: Word32 -> Word32 -> Word32 -> Word32 #-} 283 {-# SPECIALIZE ch :: Word64 -> Word64 -> Word64 -> Word64 #-} 284 ch :: Bits a => a -> a -> a -> a 285 ch x y z = (x .&. y) `xor` (complement x .&. z) 286 287 {-# SPECIALIZE maj :: Word32 -> Word32 -> Word32 -> Word32 #-} 288 {-# SPECIALIZE maj :: Word64 -> Word64 -> Word64 -> Word64 #-} 289 maj :: Bits a => a -> a -> a -> a 290 maj x y z = (x .&. (y .|. z)) .|. (y .&. z) 291 -- note: 292 -- the original functions is (x & y) ^ (x & z) ^ (y & z) 293 -- if you fire off truth tables, this is equivalent to 294 -- (x & y) | (x & z) | (y & z) 295 -- which you can the use distribution on: 296 -- (x & (y | z)) | (y & z) 297 -- which saves us one operation. 298 299 bsig256_0 :: Word32 -> Word32 300 bsig256_0 x = rotateR x 2 `xor` rotateR x 13 `xor` rotateR x 22 301 302 bsig256_1 :: Word32 -> Word32 303 bsig256_1 x = rotateR x 6 `xor` rotateR x 11 `xor` rotateR x 25 304 305 lsig256_0 :: Word32 -> Word32 306 lsig256_0 x = rotateR x 7 `xor` rotateR x 18 `xor` shiftR x 3 307 308 lsig256_1 :: Word32 -> Word32 309 lsig256_1 x = rotateR x 17 `xor` rotateR x 19 `xor` shiftR x 10 310 311 bsig512_0 :: Word64 -> Word64 312 bsig512_0 x = rotateR x 28 `xor` rotateR x 34 `xor` rotateR x 39 313 314 bsig512_1 :: Word64 -> Word64 315 bsig512_1 x = rotateR x 14 `xor` rotateR x 18 `xor` rotateR x 41 316 317 lsig512_0 :: Word64 -> Word64 318 lsig512_0 x = rotateR x 1 `xor` rotateR x 8 `xor` shiftR x 7 319 320 lsig512_1 :: Word64 -> Word64 321 lsig512_1 x = rotateR x 19 `xor` rotateR x 61 `xor` shiftR x 6 322 323 -- -------------------------------------------------------------------------- 324 -- 325 -- Message Schedules 326 -- 327 -- -------------------------------------------------------------------------- 328 329 data SHA1Sched = SHA1Sched !Word32 !Word32 !Word32 !Word32 !Word32 -- 0 - 4 330 !Word32 !Word32 !Word32 !Word32 !Word32 -- 5 - 9 331 !Word32 !Word32 !Word32 !Word32 !Word32 -- 10 - 14 332 !Word32 !Word32 !Word32 !Word32 !Word32 -- 15 - 19 333 !Word32 !Word32 !Word32 !Word32 !Word32 -- 20 - 24 334 !Word32 !Word32 !Word32 !Word32 !Word32 -- 25 - 29 335 !Word32 !Word32 !Word32 !Word32 !Word32 -- 30 - 34 336 !Word32 !Word32 !Word32 !Word32 !Word32 -- 35 - 39 337 !Word32 !Word32 !Word32 !Word32 !Word32 -- 40 - 44 338 !Word32 !Word32 !Word32 !Word32 !Word32 -- 45 - 49 339 !Word32 !Word32 !Word32 !Word32 !Word32 -- 50 - 54 340 !Word32 !Word32 !Word32 !Word32 !Word32 -- 55 - 59 341 !Word32 !Word32 !Word32 !Word32 !Word32 -- 60 - 64 342 !Word32 !Word32 !Word32 !Word32 !Word32 -- 65 - 69 343 !Word32 !Word32 !Word32 !Word32 !Word32 -- 70 - 74 344 !Word32 !Word32 !Word32 !Word32 !Word32 -- 75 - 79 345 346 getSHA1Sched :: Get SHA1Sched 347 getSHA1Sched = do 348 w00 <- getWord32be 349 w01 <- getWord32be 350 w02 <- getWord32be 351 w03 <- getWord32be 352 w04 <- getWord32be 353 w05 <- getWord32be 354 w06 <- getWord32be 355 w07 <- getWord32be 356 w08 <- getWord32be 357 w09 <- getWord32be 358 w10 <- getWord32be 359 w11 <- getWord32be 360 w12 <- getWord32be 361 w13 <- getWord32be 362 w14 <- getWord32be 363 w15 <- getWord32be 364 let w16 = rotateL (w13 `xor` w08 `xor` w02 `xor` w00) 1 365 w17 = rotateL (w14 `xor` w09 `xor` w03 `xor` w01) 1 366 w18 = rotateL (w15 `xor` w10 `xor` w04 `xor` w02) 1 367 w19 = rotateL (w16 `xor` w11 `xor` w05 `xor` w03) 1 368 w20 = rotateL (w17 `xor` w12 `xor` w06 `xor` w04) 1 369 w21 = rotateL (w18 `xor` w13 `xor` w07 `xor` w05) 1 370 w22 = rotateL (w19 `xor` w14 `xor` w08 `xor` w06) 1 371 w23 = rotateL (w20 `xor` w15 `xor` w09 `xor` w07) 1 372 w24 = rotateL (w21 `xor` w16 `xor` w10 `xor` w08) 1 373 w25 = rotateL (w22 `xor` w17 `xor` w11 `xor` w09) 1 374 w26 = rotateL (w23 `xor` w18 `xor` w12 `xor` w10) 1 375 w27 = rotateL (w24 `xor` w19 `xor` w13 `xor` w11) 1 376 w28 = rotateL (w25 `xor` w20 `xor` w14 `xor` w12) 1 377 w29 = rotateL (w26 `xor` w21 `xor` w15 `xor` w13) 1 378 w30 = rotateL (w27 `xor` w22 `xor` w16 `xor` w14) 1 379 w31 = rotateL (w28 `xor` w23 `xor` w17 `xor` w15) 1 380 w32 = rotateL (w29 `xor` w24 `xor` w18 `xor` w16) 1 381 w33 = rotateL (w30 `xor` w25 `xor` w19 `xor` w17) 1 382 w34 = rotateL (w31 `xor` w26 `xor` w20 `xor` w18) 1 383 w35 = rotateL (w32 `xor` w27 `xor` w21 `xor` w19) 1 384 w36 = rotateL (w33 `xor` w28 `xor` w22 `xor` w20) 1 385 w37 = rotateL (w34 `xor` w29 `xor` w23 `xor` w21) 1 386 w38 = rotateL (w35 `xor` w30 `xor` w24 `xor` w22) 1 387 w39 = rotateL (w36 `xor` w31 `xor` w25 `xor` w23) 1 388 w40 = rotateL (w37 `xor` w32 `xor` w26 `xor` w24) 1 389 w41 = rotateL (w38 `xor` w33 `xor` w27 `xor` w25) 1 390 w42 = rotateL (w39 `xor` w34 `xor` w28 `xor` w26) 1 391 w43 = rotateL (w40 `xor` w35 `xor` w29 `xor` w27) 1 392 w44 = rotateL (w41 `xor` w36 `xor` w30 `xor` w28) 1 393 w45 = rotateL (w42 `xor` w37 `xor` w31 `xor` w29) 1 394 w46 = rotateL (w43 `xor` w38 `xor` w32 `xor` w30) 1 395 w47 = rotateL (w44 `xor` w39 `xor` w33 `xor` w31) 1 396 w48 = rotateL (w45 `xor` w40 `xor` w34 `xor` w32) 1 397 w49 = rotateL (w46 `xor` w41 `xor` w35 `xor` w33) 1 398 w50 = rotateL (w47 `xor` w42 `xor` w36 `xor` w34) 1 399 w51 = rotateL (w48 `xor` w43 `xor` w37 `xor` w35) 1 400 w52 = rotateL (w49 `xor` w44 `xor` w38 `xor` w36) 1 401 w53 = rotateL (w50 `xor` w45 `xor` w39 `xor` w37) 1 402 w54 = rotateL (w51 `xor` w46 `xor` w40 `xor` w38) 1 403 w55 = rotateL (w52 `xor` w47 `xor` w41 `xor` w39) 1 404 w56 = rotateL (w53 `xor` w48 `xor` w42 `xor` w40) 1 405 w57 = rotateL (w54 `xor` w49 `xor` w43 `xor` w41) 1 406 w58 = rotateL (w55 `xor` w50 `xor` w44 `xor` w42) 1 407 w59 = rotateL (w56 `xor` w51 `xor` w45 `xor` w43) 1 408 w60 = rotateL (w57 `xor` w52 `xor` w46 `xor` w44) 1 409 w61 = rotateL (w58 `xor` w53 `xor` w47 `xor` w45) 1 410 w62 = rotateL (w59 `xor` w54 `xor` w48 `xor` w46) 1 411 w63 = rotateL (w60 `xor` w55 `xor` w49 `xor` w47) 1 412 w64 = rotateL (w61 `xor` w56 `xor` w50 `xor` w48) 1 413 w65 = rotateL (w62 `xor` w57 `xor` w51 `xor` w49) 1 414 w66 = rotateL (w63 `xor` w58 `xor` w52 `xor` w50) 1 415 w67 = rotateL (w64 `xor` w59 `xor` w53 `xor` w51) 1 416 w68 = rotateL (w65 `xor` w60 `xor` w54 `xor` w52) 1 417 w69 = rotateL (w66 `xor` w61 `xor` w55 `xor` w53) 1 418 w70 = rotateL (w67 `xor` w62 `xor` w56 `xor` w54) 1 419 w71 = rotateL (w68 `xor` w63 `xor` w57 `xor` w55) 1 420 w72 = rotateL (w69 `xor` w64 `xor` w58 `xor` w56) 1 421 w73 = rotateL (w70 `xor` w65 `xor` w59 `xor` w57) 1 422 w74 = rotateL (w71 `xor` w66 `xor` w60 `xor` w58) 1 423 w75 = rotateL (w72 `xor` w67 `xor` w61 `xor` w59) 1 424 w76 = rotateL (w73 `xor` w68 `xor` w62 `xor` w60) 1 425 w77 = rotateL (w74 `xor` w69 `xor` w63 `xor` w61) 1 426 w78 = rotateL (w75 `xor` w70 `xor` w64 `xor` w62) 1 427 w79 = rotateL (w76 `xor` w71 `xor` w65 `xor` w63) 1 428 return $! SHA1Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 429 w10 w11 w12 w13 w14 w15 w16 w17 w18 w19 430 w20 w21 w22 w23 w24 w25 w26 w27 w28 w29 431 w30 w31 w32 w33 w34 w35 w36 w37 w38 w39 432 w40 w41 w42 w43 w44 w45 w46 w47 w48 w49 433 w50 w51 w52 w53 w54 w55 w56 w57 w58 w59 434 w60 w61 w62 w63 w64 w65 w66 w67 w68 w69 435 w70 w71 w72 w73 w74 w75 w76 w77 w78 w79 436 437 data SHA256Sched = SHA256Sched !Word32 !Word32 !Word32 !Word32 !Word32 -- 00-04 438 !Word32 !Word32 !Word32 !Word32 !Word32 -- 05-09 439 !Word32 !Word32 !Word32 !Word32 !Word32 -- 10-04 440 !Word32 !Word32 !Word32 !Word32 !Word32 -- 15-09 441 !Word32 !Word32 !Word32 !Word32 !Word32 -- 20-04 442 !Word32 !Word32 !Word32 !Word32 !Word32 -- 25-09 443 !Word32 !Word32 !Word32 !Word32 !Word32 -- 30-04 444 !Word32 !Word32 !Word32 !Word32 !Word32 -- 35-09 445 !Word32 !Word32 !Word32 !Word32 !Word32 -- 40-04 446 !Word32 !Word32 !Word32 !Word32 !Word32 -- 45-09 447 !Word32 !Word32 !Word32 !Word32 !Word32 -- 50-04 448 !Word32 !Word32 !Word32 !Word32 !Word32 -- 55-09 449 !Word32 !Word32 !Word32 !Word32 -- 60-63 450 451 getSHA256Sched :: Get SHA256Sched 452 getSHA256Sched = do 453 w00 <- getWord32be 454 w01 <- getWord32be 455 w02 <- getWord32be 456 w03 <- getWord32be 457 w04 <- getWord32be 458 w05 <- getWord32be 459 w06 <- getWord32be 460 w07 <- getWord32be 461 w08 <- getWord32be 462 w09 <- getWord32be 463 w10 <- getWord32be 464 w11 <- getWord32be 465 w12 <- getWord32be 466 w13 <- getWord32be 467 w14 <- getWord32be 468 w15 <- getWord32be 469 let w16 = lsig256_1 w14 + w09 + lsig256_0 w01 + w00 470 w17 = lsig256_1 w15 + w10 + lsig256_0 w02 + w01 471 w18 = lsig256_1 w16 + w11 + lsig256_0 w03 + w02 472 w19 = lsig256_1 w17 + w12 + lsig256_0 w04 + w03 473 w20 = lsig256_1 w18 + w13 + lsig256_0 w05 + w04 474 w21 = lsig256_1 w19 + w14 + lsig256_0 w06 + w05 475 w22 = lsig256_1 w20 + w15 + lsig256_0 w07 + w06 476 w23 = lsig256_1 w21 + w16 + lsig256_0 w08 + w07 477 w24 = lsig256_1 w22 + w17 + lsig256_0 w09 + w08 478 w25 = lsig256_1 w23 + w18 + lsig256_0 w10 + w09 479 w26 = lsig256_1 w24 + w19 + lsig256_0 w11 + w10 480 w27 = lsig256_1 w25 + w20 + lsig256_0 w12 + w11 481 w28 = lsig256_1 w26 + w21 + lsig256_0 w13 + w12 482 w29 = lsig256_1 w27 + w22 + lsig256_0 w14 + w13 483 w30 = lsig256_1 w28 + w23 + lsig256_0 w15 + w14 484 w31 = lsig256_1 w29 + w24 + lsig256_0 w16 + w15 485 w32 = lsig256_1 w30 + w25 + lsig256_0 w17 + w16 486 w33 = lsig256_1 w31 + w26 + lsig256_0 w18 + w17 487 w34 = lsig256_1 w32 + w27 + lsig256_0 w19 + w18 488 w35 = lsig256_1 w33 + w28 + lsig256_0 w20 + w19 489 w36 = lsig256_1 w34 + w29 + lsig256_0 w21 + w20 490 w37 = lsig256_1 w35 + w30 + lsig256_0 w22 + w21 491 w38 = lsig256_1 w36 + w31 + lsig256_0 w23 + w22 492 w39 = lsig256_1 w37 + w32 + lsig256_0 w24 + w23 493 w40 = lsig256_1 w38 + w33 + lsig256_0 w25 + w24 494 w41 = lsig256_1 w39 + w34 + lsig256_0 w26 + w25 495 w42 = lsig256_1 w40 + w35 + lsig256_0 w27 + w26 496 w43 = lsig256_1 w41 + w36 + lsig256_0 w28 + w27 497 w44 = lsig256_1 w42 + w37 + lsig256_0 w29 + w28 498 w45 = lsig256_1 w43 + w38 + lsig256_0 w30 + w29 499 w46 = lsig256_1 w44 + w39 + lsig256_0 w31 + w30 500 w47 = lsig256_1 w45 + w40 + lsig256_0 w32 + w31 501 w48 = lsig256_1 w46 + w41 + lsig256_0 w33 + w32 502 w49 = lsig256_1 w47 + w42 + lsig256_0 w34 + w33 503 w50 = lsig256_1 w48 + w43 + lsig256_0 w35 + w34 504 w51 = lsig256_1 w49 + w44 + lsig256_0 w36 + w35 505 w52 = lsig256_1 w50 + w45 + lsig256_0 w37 + w36 506 w53 = lsig256_1 w51 + w46 + lsig256_0 w38 + w37 507 w54 = lsig256_1 w52 + w47 + lsig256_0 w39 + w38 508 w55 = lsig256_1 w53 + w48 + lsig256_0 w40 + w39 509 w56 = lsig256_1 w54 + w49 + lsig256_0 w41 + w40 510 w57 = lsig256_1 w55 + w50 + lsig256_0 w42 + w41 511 w58 = lsig256_1 w56 + w51 + lsig256_0 w43 + w42 512 w59 = lsig256_1 w57 + w52 + lsig256_0 w44 + w43 513 w60 = lsig256_1 w58 + w53 + lsig256_0 w45 + w44 514 w61 = lsig256_1 w59 + w54 + lsig256_0 w46 + w45 515 w62 = lsig256_1 w60 + w55 + lsig256_0 w47 + w46 516 w63 = lsig256_1 w61 + w56 + lsig256_0 w48 + w47 517 return $! SHA256Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 518 w10 w11 w12 w13 w14 w15 w16 w17 w18 w19 519 w20 w21 w22 w23 w24 w25 w26 w27 w28 w29 520 w30 w31 w32 w33 w34 w35 w36 w37 w38 w39 521 w40 w41 w42 w43 w44 w45 w46 w47 w48 w49 522 w50 w51 w52 w53 w54 w55 w56 w57 w58 w59 523 w60 w61 w62 w63 524 525 data SHA512Sched = SHA512Sched !Word64 !Word64 !Word64 !Word64 !Word64 -- 0- 4 526 !Word64 !Word64 !Word64 !Word64 !Word64 -- 5- 9 527 !Word64 !Word64 !Word64 !Word64 !Word64 -- 10-14 528 !Word64 !Word64 !Word64 !Word64 !Word64 -- 15-19 529 !Word64 !Word64 !Word64 !Word64 !Word64 -- 20-24 530 !Word64 !Word64 !Word64 !Word64 !Word64 -- 25-29 531 !Word64 !Word64 !Word64 !Word64 !Word64 -- 30-34 532 !Word64 !Word64 !Word64 !Word64 !Word64 -- 35-39 533 !Word64 !Word64 !Word64 !Word64 !Word64 -- 40-44 534 !Word64 !Word64 !Word64 !Word64 !Word64 -- 45-49 535 !Word64 !Word64 !Word64 !Word64 !Word64 -- 50-54 536 !Word64 !Word64 !Word64 !Word64 !Word64 -- 55-59 537 !Word64 !Word64 !Word64 !Word64 !Word64 -- 60-64 538 !Word64 !Word64 !Word64 !Word64 !Word64 -- 65-69 539 !Word64 !Word64 !Word64 !Word64 !Word64 -- 70-74 540 !Word64 !Word64 !Word64 !Word64 !Word64 -- 75-79 541 542 getSHA512Sched :: Get SHA512Sched 543 getSHA512Sched = do 544 w00 <- getWord64be 545 w01 <- getWord64be 546 w02 <- getWord64be 547 w03 <- getWord64be 548 w04 <- getWord64be 549 w05 <- getWord64be 550 w06 <- getWord64be 551 w07 <- getWord64be 552 w08 <- getWord64be 553 w09 <- getWord64be 554 w10 <- getWord64be 555 w11 <- getWord64be 556 w12 <- getWord64be 557 w13 <- getWord64be 558 w14 <- getWord64be 559 w15 <- getWord64be 560 let w16 = lsig512_1 w14 + w09 + lsig512_0 w01 + w00 561 w17 = lsig512_1 w15 + w10 + lsig512_0 w02 + w01 562 w18 = lsig512_1 w16 + w11 + lsig512_0 w03 + w02 563 w19 = lsig512_1 w17 + w12 + lsig512_0 w04 + w03 564 w20 = lsig512_1 w18 + w13 + lsig512_0 w05 + w04 565 w21 = lsig512_1 w19 + w14 + lsig512_0 w06 + w05 566 w22 = lsig512_1 w20 + w15 + lsig512_0 w07 + w06 567 w23 = lsig512_1 w21 + w16 + lsig512_0 w08 + w07 568 w24 = lsig512_1 w22 + w17 + lsig512_0 w09 + w08 569 w25 = lsig512_1 w23 + w18 + lsig512_0 w10 + w09 570 w26 = lsig512_1 w24 + w19 + lsig512_0 w11 + w10 571 w27 = lsig512_1 w25 + w20 + lsig512_0 w12 + w11 572 w28 = lsig512_1 w26 + w21 + lsig512_0 w13 + w12 573 w29 = lsig512_1 w27 + w22 + lsig512_0 w14 + w13 574 w30 = lsig512_1 w28 + w23 + lsig512_0 w15 + w14 575 w31 = lsig512_1 w29 + w24 + lsig512_0 w16 + w15 576 w32 = lsig512_1 w30 + w25 + lsig512_0 w17 + w16 577 w33 = lsig512_1 w31 + w26 + lsig512_0 w18 + w17 578 w34 = lsig512_1 w32 + w27 + lsig512_0 w19 + w18 579 w35 = lsig512_1 w33 + w28 + lsig512_0 w20 + w19 580 w36 = lsig512_1 w34 + w29 + lsig512_0 w21 + w20 581 w37 = lsig512_1 w35 + w30 + lsig512_0 w22 + w21 582 w38 = lsig512_1 w36 + w31 + lsig512_0 w23 + w22 583 w39 = lsig512_1 w37 + w32 + lsig512_0 w24 + w23 584 w40 = lsig512_1 w38 + w33 + lsig512_0 w25 + w24 585 w41 = lsig512_1 w39 + w34 + lsig512_0 w26 + w25 586 w42 = lsig512_1 w40 + w35 + lsig512_0 w27 + w26 587 w43 = lsig512_1 w41 + w36 + lsig512_0 w28 + w27 588 w44 = lsig512_1 w42 + w37 + lsig512_0 w29 + w28 589 w45 = lsig512_1 w43 + w38 + lsig512_0 w30 + w29 590 w46 = lsig512_1 w44 + w39 + lsig512_0 w31 + w30 591 w47 = lsig512_1 w45 + w40 + lsig512_0 w32 + w31 592 w48 = lsig512_1 w46 + w41 + lsig512_0 w33 + w32 593 w49 = lsig512_1 w47 + w42 + lsig512_0 w34 + w33 594 w50 = lsig512_1 w48 + w43 + lsig512_0 w35 + w34 595 w51 = lsig512_1 w49 + w44 + lsig512_0 w36 + w35 596 w52 = lsig512_1 w50 + w45 + lsig512_0 w37 + w36 597 w53 = lsig512_1 w51 + w46 + lsig512_0 w38 + w37 598 w54 = lsig512_1 w52 + w47 + lsig512_0 w39 + w38 599 w55 = lsig512_1 w53 + w48 + lsig512_0 w40 + w39 600 w56 = lsig512_1 w54 + w49 + lsig512_0 w41 + w40 601 w57 = lsig512_1 w55 + w50 + lsig512_0 w42 + w41 602 w58 = lsig512_1 w56 + w51 + lsig512_0 w43 + w42 603 w59 = lsig512_1 w57 + w52 + lsig512_0 w44 + w43 604 w60 = lsig512_1 w58 + w53 + lsig512_0 w45 + w44 605 w61 = lsig512_1 w59 + w54 + lsig512_0 w46 + w45 606 w62 = lsig512_1 w60 + w55 + lsig512_0 w47 + w46 607 w63 = lsig512_1 w61 + w56 + lsig512_0 w48 + w47 608 w64 = lsig512_1 w62 + w57 + lsig512_0 w49 + w48 609 w65 = lsig512_1 w63 + w58 + lsig512_0 w50 + w49 610 w66 = lsig512_1 w64 + w59 + lsig512_0 w51 + w50 611 w67 = lsig512_1 w65 + w60 + lsig512_0 w52 + w51 612 w68 = lsig512_1 w66 + w61 + lsig512_0 w53 + w52 613 w69 = lsig512_1 w67 + w62 + lsig512_0 w54 + w53 614 w70 = lsig512_1 w68 + w63 + lsig512_0 w55 + w54 615 w71 = lsig512_1 w69 + w64 + lsig512_0 w56 + w55 616 w72 = lsig512_1 w70 + w65 + lsig512_0 w57 + w56 617 w73 = lsig512_1 w71 + w66 + lsig512_0 w58 + w57 618 w74 = lsig512_1 w72 + w67 + lsig512_0 w59 + w58 619 w75 = lsig512_1 w73 + w68 + lsig512_0 w60 + w59 620 w76 = lsig512_1 w74 + w69 + lsig512_0 w61 + w60 621 w77 = lsig512_1 w75 + w70 + lsig512_0 w62 + w61 622 w78 = lsig512_1 w76 + w71 + lsig512_0 w63 + w62 623 w79 = lsig512_1 w77 + w72 + lsig512_0 w64 + w63 624 return $! SHA512Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 625 w10 w11 w12 w13 w14 w15 w16 w17 w18 w19 626 w20 w21 w22 w23 w24 w25 w26 w27 w28 w29 627 w30 w31 w32 w33 w34 w35 w36 w37 w38 w39 628 w40 w41 w42 w43 w44 w45 w46 w47 w48 w49 629 w50 w51 w52 w53 w54 w55 w56 w57 w58 w59 630 w60 w61 w62 w63 w64 w65 w66 w67 w68 w69 631 w70 w71 w72 w73 w74 w75 w76 w77 w78 w79 632 633 -- -------------------------------------------------------------------------- 634 -- 635 -- SHA Block Processors 636 -- 637 -- -------------------------------------------------------------------------- 638 639 processSHA1Block :: SHA1State -> Get SHA1State 640 processSHA1Block s00@(SHA1S a00 b00 c00 d00 e00) = do 641 (SHA1Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 642 w10 w11 w12 w13 w14 w15 w16 w17 w18 w19 643 w20 w21 w22 w23 w24 w25 w26 w27 w28 w29 644 w30 w31 w32 w33 w34 w35 w36 w37 w38 w39 645 w40 w41 w42 w43 w44 w45 w46 w47 w48 w49 646 w50 w51 w52 w53 w54 w55 w56 w57 w58 w59 647 w60 w61 w62 w63 w64 w65 w66 w67 w68 w69 648 w70 w71 w72 w73 w74 w75 w76 w77 w78 w79) <- getSHA1Sched 649 let s01 = step1_ch s00 0x5a827999 w00 650 s02 = step1_ch s01 0x5a827999 w01 651 s03 = step1_ch s02 0x5a827999 w02 652 s04 = step1_ch s03 0x5a827999 w03 653 s05 = step1_ch s04 0x5a827999 w04 654 s06 = step1_ch s05 0x5a827999 w05 655 s07 = step1_ch s06 0x5a827999 w06 656 s08 = step1_ch s07 0x5a827999 w07 657 s09 = step1_ch s08 0x5a827999 w08 658 s10 = step1_ch s09 0x5a827999 w09 659 s11 = step1_ch s10 0x5a827999 w10 660 s12 = step1_ch s11 0x5a827999 w11 661 s13 = step1_ch s12 0x5a827999 w12 662 s14 = step1_ch s13 0x5a827999 w13 663 s15 = step1_ch s14 0x5a827999 w14 664 s16 = step1_ch s15 0x5a827999 w15 665 s17 = step1_ch s16 0x5a827999 w16 666 s18 = step1_ch s17 0x5a827999 w17 667 s19 = step1_ch s18 0x5a827999 w18 668 s20 = step1_ch s19 0x5a827999 w19 669 s21 = step1_par s20 0x6ed9eba1 w20 670 s22 = step1_par s21 0x6ed9eba1 w21 671 s23 = step1_par s22 0x6ed9eba1 w22 672 s24 = step1_par s23 0x6ed9eba1 w23 673 s25 = step1_par s24 0x6ed9eba1 w24 674 s26 = step1_par s25 0x6ed9eba1 w25 675 s27 = step1_par s26 0x6ed9eba1 w26 676 s28 = step1_par s27 0x6ed9eba1 w27 677 s29 = step1_par s28 0x6ed9eba1 w28 678 s30 = step1_par s29 0x6ed9eba1 w29 679 s31 = step1_par s30 0x6ed9eba1 w30 680 s32 = step1_par s31 0x6ed9eba1 w31 681 s33 = step1_par s32 0x6ed9eba1 w32 682 s34 = step1_par s33 0x6ed9eba1 w33 683 s35 = step1_par s34 0x6ed9eba1 w34 684 s36 = step1_par s35 0x6ed9eba1 w35 685 s37 = step1_par s36 0x6ed9eba1 w36 686 s38 = step1_par s37 0x6ed9eba1 w37 687 s39 = step1_par s38 0x6ed9eba1 w38 688 s40 = step1_par s39 0x6ed9eba1 w39 689 s41 = step1_maj s40 0x8f1bbcdc w40 690 s42 = step1_maj s41 0x8f1bbcdc w41 691 s43 = step1_maj s42 0x8f1bbcdc w42 692 s44 = step1_maj s43 0x8f1bbcdc w43 693 s45 = step1_maj s44 0x8f1bbcdc w44 694 s46 = step1_maj s45 0x8f1bbcdc w45 695 s47 = step1_maj s46 0x8f1bbcdc w46 696 s48 = step1_maj s47 0x8f1bbcdc w47 697 s49 = step1_maj s48 0x8f1bbcdc w48 698 s50 = step1_maj s49 0x8f1bbcdc w49 699 s51 = step1_maj s50 0x8f1bbcdc w50 700 s52 = step1_maj s51 0x8f1bbcdc w51 701 s53 = step1_maj s52 0x8f1bbcdc w52 702 s54 = step1_maj s53 0x8f1bbcdc w53 703 s55 = step1_maj s54 0x8f1bbcdc w54 704 s56 = step1_maj s55 0x8f1bbcdc w55 705 s57 = step1_maj s56 0x8f1bbcdc w56 706 s58 = step1_maj s57 0x8f1bbcdc w57 707 s59 = step1_maj s58 0x8f1bbcdc w58 708 s60 = step1_maj s59 0x8f1bbcdc w59 709 s61 = step1_par s60 0xca62c1d6 w60 710 s62 = step1_par s61 0xca62c1d6 w61 711 s63 = step1_par s62 0xca62c1d6 w62 712 s64 = step1_par s63 0xca62c1d6 w63 713 s65 = step1_par s64 0xca62c1d6 w64 714 s66 = step1_par s65 0xca62c1d6 w65 715 s67 = step1_par s66 0xca62c1d6 w66 716 s68 = step1_par s67 0xca62c1d6 w67 717 s69 = step1_par s68 0xca62c1d6 w68 718 s70 = step1_par s69 0xca62c1d6 w69 719 s71 = step1_par s70 0xca62c1d6 w70 720 s72 = step1_par s71 0xca62c1d6 w71 721 s73 = step1_par s72 0xca62c1d6 w72 722 s74 = step1_par s73 0xca62c1d6 w73 723 s75 = step1_par s74 0xca62c1d6 w74 724 s76 = step1_par s75 0xca62c1d6 w75 725 s77 = step1_par s76 0xca62c1d6 w76 726 s78 = step1_par s77 0xca62c1d6 w77 727 s79 = step1_par s78 0xca62c1d6 w78 728 s80 = step1_par s79 0xca62c1d6 w79 729 SHA1S a80 b80 c80 d80 e80 = s80 730 return $! SHA1S (a00 + a80) (b00 + b80) (c00 + c80) (d00 + d80) (e00 + e80) 731 732 {-# INLINE step1_ch #-} 733 step1_ch :: SHA1State -> Word32 -> Word32 -> SHA1State 734 step1_ch !(SHA1S a b c d e) k w = SHA1S a' b' c' d' e' 735 where a' = rotateL a 5 + ((b .&. c) `xor` (complement b .&. d)) + e + k + w 736 b' = a 737 c' = rotateL b 30 738 d' = c 739 e' = d 740 741 {-# INLINE step1_par #-} 742 step1_par :: SHA1State -> Word32 -> Word32 -> SHA1State 743 step1_par !(SHA1S a b c d e) k w = SHA1S a' b' c' d' e' 744 where a' = rotateL a 5 + (b `xor` c `xor` d) + e + k + w 745 b' = a 746 c' = rotateL b 30 747 d' = c 748 e' = d 749 750 {-# INLINE step1_maj #-} 751 step1_maj :: SHA1State -> Word32 -> Word32 -> SHA1State 752 step1_maj !(SHA1S a b c d e) k w = SHA1S a' b' c' d' e' 753 where a' = rotateL a 5 + ((b .&. (c .|. d)) .|. (c .&. d)) + e + k + w 754 b' = a 755 c' = rotateL b 30 756 d' = c 757 e' = d 758 -- See the note on maj, above 759 760 processSHA256Block :: SHA256State -> Get SHA256State 761 processSHA256Block !s00@(SHA256S a00 b00 c00 d00 e00 f00 g00 h00) = do 762 (SHA256Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 763 w10 w11 w12 w13 w14 w15 w16 w17 w18 w19 764 w20 w21 w22 w23 w24 w25 w26 w27 w28 w29 765 w30 w31 w32 w33 w34 w35 w36 w37 w38 w39 766 w40 w41 w42 w43 w44 w45 w46 w47 w48 w49 767 w50 w51 w52 w53 w54 w55 w56 w57 w58 w59 768 w60 w61 w62 w63) <- getSHA256Sched 769 let s01 = step256 s00 0x428a2f98 w00 770 s02 = step256 s01 0x71374491 w01 771 s03 = step256 s02 0xb5c0fbcf w02 772 s04 = step256 s03 0xe9b5dba5 w03 773 s05 = step256 s04 0x3956c25b w04 774 s06 = step256 s05 0x59f111f1 w05 775 s07 = step256 s06 0x923f82a4 w06 776 s08 = step256 s07 0xab1c5ed5 w07 777 s09 = step256 s08 0xd807aa98 w08 778 s10 = step256 s09 0x12835b01 w09 779 s11 = step256 s10 0x243185be w10 780 s12 = step256 s11 0x550c7dc3 w11 781 s13 = step256 s12 0x72be5d74 w12 782 s14 = step256 s13 0x80deb1fe w13 783 s15 = step256 s14 0x9bdc06a7 w14 784 s16 = step256 s15 0xc19bf174 w15 785 s17 = step256 s16 0xe49b69c1 w16 786 s18 = step256 s17 0xefbe4786 w17 787 s19 = step256 s18 0x0fc19dc6 w18 788 s20 = step256 s19 0x240ca1cc w19 789 s21 = step256 s20 0x2de92c6f w20 790 s22 = step256 s21 0x4a7484aa w21 791 s23 = step256 s22 0x5cb0a9dc w22 792 s24 = step256 s23 0x76f988da w23 793 s25 = step256 s24 0x983e5152 w24 794 s26 = step256 s25 0xa831c66d w25 795 s27 = step256 s26 0xb00327c8 w26 796 s28 = step256 s27 0xbf597fc7 w27 797 s29 = step256 s28 0xc6e00bf3 w28 798 s30 = step256 s29 0xd5a79147 w29 799 s31 = step256 s30 0x06ca6351 w30 800 s32 = step256 s31 0x14292967 w31 801 s33 = step256 s32 0x27b70a85 w32 802 s34 = step256 s33 0x2e1b2138 w33 803 s35 = step256 s34 0x4d2c6dfc w34 804 s36 = step256 s35 0x53380d13 w35 805 s37 = step256 s36 0x650a7354 w36 806 s38 = step256 s37 0x766a0abb w37 807 s39 = step256 s38 0x81c2c92e w38 808 s40 = step256 s39 0x92722c85 w39 809 s41 = step256 s40 0xa2bfe8a1 w40 810 s42 = step256 s41 0xa81a664b w41 811 s43 = step256 s42 0xc24b8b70 w42 812 s44 = step256 s43 0xc76c51a3 w43 813 s45 = step256 s44 0xd192e819 w44 814 s46 = step256 s45 0xd6990624 w45 815 s47 = step256 s46 0xf40e3585 w46 816 s48 = step256 s47 0x106aa070 w47 817 s49 = step256 s48 0x19a4c116 w48 818 s50 = step256 s49 0x1e376c08 w49 819 s51 = step256 s50 0x2748774c w50 820 s52 = step256 s51 0x34b0bcb5 w51 821 s53 = step256 s52 0x391c0cb3 w52 822 s54 = step256 s53 0x4ed8aa4a w53 823 s55 = step256 s54 0x5b9cca4f w54 824 s56 = step256 s55 0x682e6ff3 w55 825 s57 = step256 s56 0x748f82ee w56 826 s58 = step256 s57 0x78a5636f w57 827 s59 = step256 s58 0x84c87814 w58 828 s60 = step256 s59 0x8cc70208 w59 829 s61 = step256 s60 0x90befffa w60 830 s62 = step256 s61 0xa4506ceb w61 831 s63 = step256 s62 0xbef9a3f7 w62 832 s64 = step256 s63 0xc67178f2 w63 833 SHA256S a64 b64 c64 d64 e64 f64 g64 h64 = s64 834 return $! SHA256S (a00 + a64) (b00 + b64) (c00 + c64) (d00 + d64) 835 (e00 + e64) (f00 + f64) (g00 + g64) (h00 + h64) 836 837 {-# INLINE step256 #-} 838 step256 :: SHA256State -> Word32 -> Word32 -> SHA256State 839 step256 !(SHA256S a b c d e f g h) k w = SHA256S a' b' c' d' e' f' g' h' 840 where 841 t1 = h + bsig256_1 e + ch e f g + k + w 842 t2 = bsig256_0 a + maj a b c 843 h' = g 844 g' = f 845 f' = e 846 e' = d + t1 847 d' = c 848 c' = b 849 b' = a 850 a' = t1 + t2 851 852 processSHA512Block :: SHA512State -> Get SHA512State 853 processSHA512Block !s00@(SHA512S a00 b00 c00 d00 e00 f00 g00 h00) = do 854 (SHA512Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09 855 w10 w11 w12 w13 w14 w15 w16 w17 w18 w19 856 w20 w21 w22 w23 w24 w25 w26 w27 w28 w29 857 w30 w31 w32 w33 w34 w35 w36 w37 w38 w39 858 w40 w41 w42 w43 w44 w45 w46 w47 w48 w49 859 w50 w51 w52 w53 w54 w55 w56 w57 w58 w59 860 w60 w61 w62 w63 w64 w65 w66 w67 w68 w69 861 w70 w71 w72 w73 w74 w75 w76 w77 w78 w79) <- getSHA512Sched 862 let s01 = step512 s00 0x428a2f98d728ae22 w00 863 s02 = step512 s01 0x7137449123ef65cd w01 864 s03 = step512 s02 0xb5c0fbcfec4d3b2f w02 865 s04 = step512 s03 0xe9b5dba58189dbbc w03 866 s05 = step512 s04 0x3956c25bf348b538 w04 867 s06 = step512 s05 0x59f111f1b605d019 w05 868 s07 = step512 s06 0x923f82a4af194f9b w06 869 s08 = step512 s07 0xab1c5ed5da6d8118 w07 870 s09 = step512 s08 0xd807aa98a3030242 w08 871 s10 = step512 s09 0x12835b0145706fbe w09 872 s11 = step512 s10 0x243185be4ee4b28c w10 873 s12 = step512 s11 0x550c7dc3d5ffb4e2 w11 874 s13 = step512 s12 0x72be5d74f27b896f w12 875 s14 = step512 s13 0x80deb1fe3b1696b1 w13 876 s15 = step512 s14 0x9bdc06a725c71235 w14 877 s16 = step512 s15 0xc19bf174cf692694 w15 878 s17 = step512 s16 0xe49b69c19ef14ad2 w16 879 s18 = step512 s17 0xefbe4786384f25e3 w17 880 s19 = step512 s18 0x0fc19dc68b8cd5b5 w18 881 s20 = step512 s19 0x240ca1cc77ac9c65 w19 882 s21 = step512 s20 0x2de92c6f592b0275 w20 883 s22 = step512 s21 0x4a7484aa6ea6e483 w21 884 s23 = step512 s22 0x5cb0a9dcbd41fbd4 w22 885 s24 = step512 s23 0x76f988da831153b5 w23 886 s25 = step512 s24 0x983e5152ee66dfab w24 887 s26 = step512 s25 0xa831c66d2db43210 w25 888 s27 = step512 s26 0xb00327c898fb213f w26 889 s28 = step512 s27 0xbf597fc7beef0ee4 w27 890 s29 = step512 s28 0xc6e00bf33da88fc2 w28 891 s30 = step512 s29 0xd5a79147930aa725 w29 892 s31 = step512 s30 0x06ca6351e003826f w30 893 s32 = step512 s31 0x142929670a0e6e70 w31 894 s33 = step512 s32 0x27b70a8546d22ffc w32 895 s34 = step512 s33 0x2e1b21385c26c926 w33 896 s35 = step512 s34 0x4d2c6dfc5ac42aed w34 897 s36 = step512 s35 0x53380d139d95b3df w35 898 s37 = step512 s36 0x650a73548baf63de w36 899 s38 = step512 s37 0x766a0abb3c77b2a8 w37 900 s39 = step512 s38 0x81c2c92e47edaee6 w38 901 s40 = step512 s39 0x92722c851482353b w39 902 s41 = step512 s40 0xa2bfe8a14cf10364 w40 903 s42 = step512 s41 0xa81a664bbc423001 w41 904 s43 = step512 s42 0xc24b8b70d0f89791 w42 905 s44 = step512 s43 0xc76c51a30654be30 w43 906 s45 = step512 s44 0xd192e819d6ef5218 w44 907 s46 = step512 s45 0xd69906245565a910 w45 908 s47 = step512 s46 0xf40e35855771202a w46 909 s48 = step512 s47 0x106aa07032bbd1b8 w47 910 s49 = step512 s48 0x19a4c116b8d2d0c8 w48 911 s50 = step512 s49 0x1e376c085141ab53 w49 912 s51 = step512 s50 0x2748774cdf8eeb99 w50 913 s52 = step512 s51 0x34b0bcb5e19b48a8 w51 914 s53 = step512 s52 0x391c0cb3c5c95a63 w52 915 s54 = step512 s53 0x4ed8aa4ae3418acb w53 916 s55 = step512 s54 0x5b9cca4f7763e373 w54 917 s56 = step512 s55 0x682e6ff3d6b2b8a3 w55 918 s57 = step512 s56 0x748f82ee5defb2fc w56 919 s58 = step512 s57 0x78a5636f43172f60 w57 920 s59 = step512 s58 0x84c87814a1f0ab72 w58 921 s60 = step512 s59 0x8cc702081a6439ec w59 922 s61 = step512 s60 0x90befffa23631e28 w60 923 s62 = step512 s61 0xa4506cebde82bde9 w61 924 s63 = step512 s62 0xbef9a3f7b2c67915 w62 925 s64 = step512 s63 0xc67178f2e372532b w63 926 s65 = step512 s64 0xca273eceea26619c w64 927 s66 = step512 s65 0xd186b8c721c0c207 w65 928 s67 = step512 s66 0xeada7dd6cde0eb1e w66 929 s68 = step512 s67 0xf57d4f7fee6ed178 w67 930 s69 = step512 s68 0x06f067aa72176fba w68 931 s70 = step512 s69 0x0a637dc5a2c898a6 w69 932 s71 = step512 s70 0x113f9804bef90dae w70 933 s72 = step512 s71 0x1b710b35131c471b w71 934 s73 = step512 s72 0x28db77f523047d84 w72 935 s74 = step512 s73 0x32caab7b40c72493 w73 936 s75 = step512 s74 0x3c9ebe0a15c9bebc w74 937 s76 = step512 s75 0x431d67c49c100d4c w75 938 s77 = step512 s76 0x4cc5d4becb3e42b6 w76 939 s78 = step512 s77 0x597f299cfc657e2a w77 940 s79 = step512 s78 0x5fcb6fab3ad6faec w78 941 s80 = step512 s79 0x6c44198c4a475817 w79 942 SHA512S a80 b80 c80 d80 e80 f80 g80 h80 = s80 943 return $! SHA512S (a00 + a80) (b00 + b80) (c00 + c80) (d00 + d80) 944 (e00 + e80) (f00 + f80) (g00 + g80) (h00 + h80) 945 946 {-# INLINE step512 #-} 947 step512 :: SHA512State -> Word64 -> Word64 -> SHA512State 948 step512 !(SHA512S a b c d e f g h) k w = SHA512S a' b' c' d' e' f' g' h' 949 where 950 t1 = h + bsig512_1 e + ch e f g + k + w 951 t2 = bsig512_0 a + maj a b c 952 h' = g 953 g' = f 954 f' = e 955 e' = d + t1 956 d' = c 957 c' = b 958 b' = a 959 a' = t1 + t2 960 961 -- -------------------------------------------------------------------------- 962 -- 963 -- Run the routines 964 -- 965 -- -------------------------------------------------------------------------- 966 967 runSHA :: a -> (a -> Get a) -> ByteString -> a 968 runSHA s nextChunk input = runGet (getAll s) input 969 where 970 getAll s_in = do 971 done <- isEmpty 972 if done 973 then return s_in 974 else nextChunk s_in >>= getAll 975 976 runSHAIncremental :: a -> (a -> Get a) -> Decoder a 977 runSHAIncremental s nextChunk = runGetIncremental (getAll s) 978 where 979 getAll s_in = do 980 done <- isEmpty 981 if done 982 then return s_in 983 else nextChunk s_in >>= getAll 984 985 generic_complete :: (t -> [SBS.ByteString]) -> (a -> Put) -> Decoder a -> t 986 -> Digest a 987 generic_complete pad synthesize decoder len = 988 let decoder' = pushEndOfInput $ foldl' pushChunk decoder $ pad len 989 in case decoder' of 990 Fail _ _ _ -> error "Decoder is in Fail state." 991 Partial _ -> error "Decoder is in Partial state." 992 Done _ _ x -> Digest $ runPut $! synthesize x 993 994 -- |Compute the SHA-1 hash of the given ByteString. The output is guaranteed 995 -- to be exactly 160 bits, or 20 bytes, long. This is a good default for 996 -- programs that need a good, but not necessarily hyper-secure, hash function. 997 sha1 :: ByteString -> Digest SHA1State 998 sha1 bs_in = Digest bs_out 999 where 1000 bs_pad = padSHA1 bs_in 1001 fstate = runSHA initialSHA1State processSHA1Block bs_pad 1002 bs_out = runPut $! synthesizeSHA1 fstate 1003 1004 -- required padding bytes 1005 pbytes :: Integral a => a -> a 1006 pbytes ((\k -> 64 - k `mod` 64) -> l) 1007 | l == 0 = l + 56 1008 | otherwise = l - 8 1009 1010 -- padding for a supplied message, using arbitrary bytelength n 1011 evilpadding :: Word64 -> BS.ByteString -> BS.ByteString 1012 evilpadding n bs = runPut $ do 1013 putWord8 128 1014 loop (pred (pbytes (BS.length bs))) 1015 where 1016 loop l 1017 | l == 0 = putWord64be (n * 8) 1018 | otherwise = do 1019 putWord8 0 1020 loop (pred l) 1021 1022 -- sha1 with specified internal state and manual padding 1023 sha1' 1024 :: Word32 1025 -> Word32 1026 -> Word32 1027 -> Word32 1028 -> Word32 1029 -> Word64 1030 -> ByteString 1031 -> Digest SHA1State 1032 sha1' a b c d e n bs_in = Digest bs_out 1033 where 1034 bs_pad = bs_in <> evilpadding n bs_in 1035 fstate = runSHA init processSHA1Block bs_pad 1036 bs_out = runPut $! synthesizeSHA1 fstate 1037 init :: SHA1State 1038 init = SHA1S a b c d e 1039 1040 -- sha1 with manual padding 1041 sha1'' :: Word64 -> ByteString -> Digest SHA1State 1042 sha1'' n bs_in = Digest bs_out 1043 where 1044 bs_pad = bs_in <> evilpadding n bs_in 1045 fstate = runSHA initialSHA1State processSHA1Block bs_pad 1046 bs_out = runPut $! synthesizeSHA1 fstate 1047 1048 -- |Similar to `sha1` but use an incremental interface. When the decoder has 1049 -- been completely fed, `completeSha1Incremental` must be used so it can 1050 -- finish successfully. 1051 sha1Incremental :: Decoder SHA1State 1052 sha1Incremental = runSHAIncremental initialSHA1State processSHA1Block 1053 1054 completeSha1Incremental :: Decoder SHA1State -> Int -> Digest SHA1State 1055 completeSha1Incremental = generic_complete padSHA1Chunks synthesizeSHA1 1056 1057 -- |Compute the SHA-224 hash of the given ByteString. Note that SHA-224 and 1058 -- SHA-384 differ only slightly from SHA-256 and SHA-512, and use truncated 1059 -- versions of the resulting hashes. So using 224/384 may not, in fact, save 1060 -- you very much ... 1061 sha224 :: ByteString -> Digest SHA256State 1062 sha224 bs_in = Digest bs_out 1063 where 1064 bs_pad = padSHA1 bs_in 1065 fstate = runSHA initialSHA224State processSHA256Block bs_pad 1066 bs_out = runPut $! synthesizeSHA224 fstate 1067 1068 -- |Similar to `sha224` but use an incremental interface. When the decoder has 1069 -- been completely fed, `completeSha224Incremental` must be used so it can 1070 -- finish successfully. 1071 sha224Incremental :: Decoder SHA256State 1072 sha224Incremental = runSHAIncremental initialSHA224State processSHA256Block 1073 1074 completeSha224Incremental :: Decoder SHA256State -> Int -> Digest SHA256State 1075 completeSha224Incremental = generic_complete padSHA1Chunks synthesizeSHA224 1076 1077 -- |Compute the SHA-256 hash of the given ByteString. The output is guaranteed 1078 -- to be exactly 256 bits, or 32 bytes, long. If your security requirements 1079 -- are pretty serious, this is a good choice. For truly significant security 1080 -- concerns, however, you might try one of the bigger options. 1081 sha256 :: ByteString -> Digest SHA256State 1082 sha256 bs_in = Digest bs_out 1083 where 1084 bs_pad = padSHA1 bs_in 1085 fstate = runSHA initialSHA256State processSHA256Block bs_pad 1086 bs_out = runPut $! synthesizeSHA256 fstate 1087 1088 -- |Similar to `sha256` but use an incremental interface. When the decoder has 1089 -- been completely fed, `completeSha256Incremental` must be used so it can 1090 -- finish successfully. 1091 sha256Incremental :: Decoder SHA256State 1092 sha256Incremental = runSHAIncremental initialSHA256State processSHA256Block 1093 1094 completeSha256Incremental :: Decoder SHA256State -> Int -> Digest SHA256State 1095 completeSha256Incremental = generic_complete padSHA1Chunks synthesizeSHA256 1096 1097 -- |Compute the SHA-384 hash of the given ByteString. Yup, you guessed it, 1098 -- the output will be exactly 384 bits, or 48 bytes, long. 1099 sha384 :: ByteString -> Digest SHA512State 1100 sha384 bs_in = Digest bs_out 1101 where 1102 bs_pad = padSHA512 bs_in 1103 fstate = runSHA initialSHA384State processSHA512Block bs_pad 1104 bs_out = runPut $! synthesizeSHA384 fstate 1105 1106 -- |Similar to `sha384` but use an incremental interface. When the decoder has 1107 -- been completely fed, `completeSha384Incremental` must be used so it can 1108 -- finish successfully. 1109 sha384Incremental :: Decoder SHA512State 1110 sha384Incremental = runSHAIncremental initialSHA384State processSHA512Block 1111 1112 completeSha384Incremental :: Decoder SHA512State -> Int -> Digest SHA512State 1113 completeSha384Incremental = generic_complete padSHA512Chunks synthesizeSHA384 1114 1115 -- |For those for whom only the biggest hashes will do, this computes the 1116 -- SHA-512 hash of the given ByteString. The output will be 64 bytes, or 1117 -- 512 bits, long. 1118 sha512 :: ByteString -> Digest SHA512State 1119 sha512 bs_in = Digest bs_out 1120 where 1121 bs_pad = padSHA512 bs_in 1122 fstate = runSHA initialSHA512State processSHA512Block bs_pad 1123 bs_out = runPut $! synthesizeSHA512 fstate 1124 1125 -- |Similar to `sha512` but use an incremental interface. When the decoder has 1126 -- been completely fed, `completeSha512Incremental` must be used so it can 1127 -- finish successfully. 1128 sha512Incremental :: Decoder SHA512State 1129 sha512Incremental = runSHAIncremental initialSHA512State processSHA512Block 1130 1131 completeSha512Incremental :: Decoder SHA512State -> Int -> Digest SHA512State 1132 completeSha512Incremental = generic_complete padSHA512Chunks synthesizeSHA512 1133 1134 -- -------------------------------------------------------------------------- 1135 1136 -- | Compute an HMAC using SHA-1. 1137 hmacSha1 1138 :: ByteString -- ^ secret key 1139 -> ByteString -- ^ message 1140 -> Digest SHA1State -- ^ SHA-1 MAC 1141 hmacSha1 = hmac sha1 64 1142 1143 -- | Compute an HMAC using SHA-224. 1144 hmacSha224 1145 :: ByteString -- ^ secret key 1146 -> ByteString -- ^ message 1147 -> Digest SHA256State -- ^ SHA-224 MAC 1148 hmacSha224 = hmac sha224 64 1149 1150 -- | Compute an HMAC using SHA-256. 1151 hmacSha256 1152 :: ByteString -- ^ secret key 1153 -> ByteString -- ^ message 1154 -> Digest SHA256State -- ^ SHA-256 MAC 1155 hmacSha256 = hmac sha256 64 1156 1157 -- | Compute an HMAC using SHA-384. 1158 hmacSha384 1159 :: ByteString -- ^ secret key 1160 -> ByteString -- ^ message 1161 -> Digest SHA512State -- ^ SHA-384 MAC 1162 hmacSha384 = hmac sha384 128 1163 1164 -- | Compute an HMAC using SHA-512. 1165 hmacSha512 1166 :: ByteString -- ^ secret key 1167 -> ByteString -- ^ message 1168 -> Digest SHA512State -- ^ SHA-512 MAC 1169 hmacSha512 = hmac sha512 128 1170 1171 -- -------------------------------------------------------------------------- 1172 1173 hmac :: (ByteString -> Digest t) -> Int -> ByteString -> ByteString -> Digest t 1174 hmac f bl k m = f (BS.append opad (bytestringDigest (f (BS.append ipad m)))) 1175 where 1176 opad = BS.map (xor ov) k' 1177 ipad = BS.map (xor iv) k' 1178 ov = 0x5c :: Word8 1179 iv = 0x36 :: Word8 1180 1181 k' = BS.append kt pad 1182 where 1183 kt = if kn > bn then bytestringDigest (f k) else k 1184 pad = BS.replicate (bn - ktn) 0 1185 kn = fromIntegral (BS.length k) 1186 ktn = fromIntegral (BS.length kt) 1187 bn = fromIntegral bl 1188 1189 -- -------------------------------------------------------------------------- 1190 -- 1191 -- OTHER 1192 -- 1193 -- -------------------------------------------------------------------------- 1194 1195 1196 -- | Convert a digest to a string. 1197 -- The digest is rendered as fixed with hexadecimal number. 1198 showDigest :: Digest t -> String 1199 showDigest (Digest bs) = showDigestBS bs 1200 1201 -- |Prints out a bytestring in hexadecimal. Just for convenience. 1202 showDigestBS :: ByteString -> String 1203 showDigestBS bs = foldr paddedShowHex [] (BS.unpack bs) 1204 where 1205 paddedShowHex x xs = intToDigit (fromIntegral (x `shiftR` 4)) 1206 : intToDigit (fromIntegral (x .&. 0xf)) 1207 : xs 1208 1209 -- | Convert a digest to an Integer. 1210 integerDigest :: Digest t -> Integer 1211 integerDigest (Digest bs) = BS.foldl' addShift 0 bs 1212 where addShift n y = (n `shiftL` 8) .|. fromIntegral y 1213 1214 -- | Convert a digest to a ByteString. 1215 bytestringDigest :: Digest t -> ByteString 1216 bytestringDigest (Digest bs) = bs 1217