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