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