1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
|
-- Derived from SHA-1.5.0.0
-- This previously uncovered cases left unhandled in the AArch64 NCG (#22798).
{-# LANGUAGE BangPatterns, CPP, FlexibleInstances #-}
module Main (main) where
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import Data.Bits
import Data.ByteString.Lazy(ByteString)
import Data.ByteString.Lazy.Char8 as BSC (pack)
import qualified Data.ByteString.Lazy as BS
import Data.Char (intToDigit)
import Control.Monad
newtype Digest t = Digest ByteString
data SHA512State = SHA512S !Word64 !Word64 !Word64 !Word64
!Word64 !Word64 !Word64 !Word64
initialSHA512State :: SHA512State
initialSHA512State = SHA512S 0x6a09e667f3bcc908 0xbb67ae8584caa73b
0x3c6ef372fe94f82b 0xa54ff53a5f1d36f1
0x510e527fade682d1 0x9b05688c2b3e6c1f
0x1f83d9abfb41bd6b 0x5be0cd19137e2179
synthesizeSHA512 :: SHA512State -> Put
synthesizeSHA512 (SHA512S a b c d e f g h) = do
putWord64be a
putWord64be b
putWord64be c
putWord64be d
putWord64be e
putWord64be f
putWord64be g
putWord64be h
getSHA512 :: Get SHA512State
getSHA512 = do
a <- getWord64be
b <- getWord64be
c <- getWord64be
d <- getWord64be
e <- getWord64be
f <- getWord64be
g <- getWord64be
h <- getWord64be
return $ SHA512S a b c d e f g h
instance Binary SHA512State where
put = synthesizeSHA512
get = getSHA512
padSHA512 :: ByteString -> ByteString
padSHA512 = generic_pad 896 1024 128
generic_pad :: Word64 -> Word64 -> Int -> ByteString -> ByteString
generic_pad a b lSize bs = BS.concat [bs, pad_bytes, pad_length]
where
l = fromIntegral $ BS.length bs * 8
k = calc_k a b l
-- INVARIANT: k is necessarily > 0, and (k + 1) is a multiple of 8.
k_bytes = (k + 1) `div` 8
pad_bytes = BS.singleton 0x80 `BS.append` BS.replicate nZeroBytes 0
nZeroBytes = fromIntegral $ k_bytes - 1
pad_length = toBigEndianBS lSize l
-- Given a, b, and l, calculate the smallest k such that (l + 1 + k) mod b = a.
calc_k :: Word64 -> Word64 -> Word64 -> Word64
calc_k a b l =
if r <= -1
then fromIntegral r + b
else fromIntegral r
where
r = toInteger a - toInteger l `mod` toInteger b - 1
toBigEndianBS :: (Integral a, Bits a) => Int -> a -> ByteString
toBigEndianBS s val = BS.pack $ map getBits [s - 8, s - 16 .. 0]
where
getBits x = fromIntegral $ (val `shiftR` x) .&. 0xFF
{-# SPECIALIZE ch :: Word64 -> Word64 -> Word64 -> Word64 #-}
ch :: Bits a => a -> a -> a -> a
ch x y z = (x .&. y) `xor` (complement x .&. z)
{-# SPECIALIZE maj :: Word64 -> Word64 -> Word64 -> Word64 #-}
maj :: Bits a => a -> a -> a -> a
maj x y z = (x .&. (y .|. z)) .|. (y .&. z)
-- note:
-- the original functions is (x & y) ^ (x & z) ^ (y & z)
-- if you fire off truth tables, this is equivalent to
-- (x & y) | (x & z) | (y & z)
-- which you can the use distribution on:
-- (x & (y | z)) | (y & z)
-- which saves us one operation.
bsig512_0 :: Word64 -> Word64
bsig512_0 x = rotate x (-28) `xor` rotate x (-34) `xor` rotate x (-39)
bsig512_1 :: Word64 -> Word64
bsig512_1 x = rotate x (-14) `xor` rotate x (-18) `xor` rotate x (-41)
lsig512_0 :: Word64 -> Word64
lsig512_0 x = rotate x (-1) `xor` rotate x (-8) `xor` shiftR x 7
lsig512_1 :: Word64 -> Word64
lsig512_1 x = rotate x (-19) `xor` rotate x (-61) `xor` shiftR x 6
data SHA512Sched = SHA512Sched !Word64 !Word64 !Word64 !Word64 !Word64 -- 0- 4
!Word64 !Word64 !Word64 !Word64 !Word64 -- 5- 9
!Word64 !Word64 !Word64 !Word64 !Word64 -- 10-14
!Word64 !Word64 !Word64 !Word64 !Word64 -- 15-19
!Word64 !Word64 !Word64 !Word64 !Word64 -- 20-24
!Word64 !Word64 !Word64 !Word64 !Word64 -- 25-29
!Word64 !Word64 !Word64 !Word64 !Word64 -- 30-34
!Word64 !Word64 !Word64 !Word64 !Word64 -- 35-39
!Word64 !Word64 !Word64 !Word64 !Word64 -- 40-44
!Word64 !Word64 !Word64 !Word64 !Word64 -- 45-49
!Word64 !Word64 !Word64 !Word64 !Word64 -- 50-54
!Word64 !Word64 !Word64 !Word64 !Word64 -- 55-59
!Word64 !Word64 !Word64 !Word64 !Word64 -- 60-64
!Word64 !Word64 !Word64 !Word64 !Word64 -- 65-69
!Word64 !Word64 !Word64 !Word64 !Word64 -- 70-74
!Word64 !Word64 !Word64 !Word64 !Word64 -- 75-79
getSHA512Sched :: Get SHA512Sched
getSHA512Sched = do
w00 <- getWord64be
w01 <- getWord64be
w02 <- getWord64be
w03 <- getWord64be
w04 <- getWord64be
w05 <- getWord64be
w06 <- getWord64be
w07 <- getWord64be
w08 <- getWord64be
w09 <- getWord64be
w10 <- getWord64be
w11 <- getWord64be
w12 <- getWord64be
w13 <- getWord64be
w14 <- getWord64be
w15 <- getWord64be
let w16 = lsig512_1 w14 + w09 + lsig512_0 w01 + w00
w17 = lsig512_1 w15 + w10 + lsig512_0 w02 + w01
w18 = lsig512_1 w16 + w11 + lsig512_0 w03 + w02
w19 = lsig512_1 w17 + w12 + lsig512_0 w04 + w03
w20 = lsig512_1 w18 + w13 + lsig512_0 w05 + w04
w21 = lsig512_1 w19 + w14 + lsig512_0 w06 + w05
w22 = lsig512_1 w20 + w15 + lsig512_0 w07 + w06
w23 = lsig512_1 w21 + w16 + lsig512_0 w08 + w07
w24 = lsig512_1 w22 + w17 + lsig512_0 w09 + w08
w25 = lsig512_1 w23 + w18 + lsig512_0 w10 + w09
w26 = lsig512_1 w24 + w19 + lsig512_0 w11 + w10
w27 = lsig512_1 w25 + w20 + lsig512_0 w12 + w11
w28 = lsig512_1 w26 + w21 + lsig512_0 w13 + w12
w29 = lsig512_1 w27 + w22 + lsig512_0 w14 + w13
w30 = lsig512_1 w28 + w23 + lsig512_0 w15 + w14
w31 = lsig512_1 w29 + w24 + lsig512_0 w16 + w15
w32 = lsig512_1 w30 + w25 + lsig512_0 w17 + w16
w33 = lsig512_1 w31 + w26 + lsig512_0 w18 + w17
w34 = lsig512_1 w32 + w27 + lsig512_0 w19 + w18
w35 = lsig512_1 w33 + w28 + lsig512_0 w20 + w19
w36 = lsig512_1 w34 + w29 + lsig512_0 w21 + w20
w37 = lsig512_1 w35 + w30 + lsig512_0 w22 + w21
w38 = lsig512_1 w36 + w31 + lsig512_0 w23 + w22
w39 = lsig512_1 w37 + w32 + lsig512_0 w24 + w23
w40 = lsig512_1 w38 + w33 + lsig512_0 w25 + w24
w41 = lsig512_1 w39 + w34 + lsig512_0 w26 + w25
w42 = lsig512_1 w40 + w35 + lsig512_0 w27 + w26
w43 = lsig512_1 w41 + w36 + lsig512_0 w28 + w27
w44 = lsig512_1 w42 + w37 + lsig512_0 w29 + w28
w45 = lsig512_1 w43 + w38 + lsig512_0 w30 + w29
w46 = lsig512_1 w44 + w39 + lsig512_0 w31 + w30
w47 = lsig512_1 w45 + w40 + lsig512_0 w32 + w31
w48 = lsig512_1 w46 + w41 + lsig512_0 w33 + w32
w49 = lsig512_1 w47 + w42 + lsig512_0 w34 + w33
w50 = lsig512_1 w48 + w43 + lsig512_0 w35 + w34
w51 = lsig512_1 w49 + w44 + lsig512_0 w36 + w35
w52 = lsig512_1 w50 + w45 + lsig512_0 w37 + w36
w53 = lsig512_1 w51 + w46 + lsig512_0 w38 + w37
w54 = lsig512_1 w52 + w47 + lsig512_0 w39 + w38
w55 = lsig512_1 w53 + w48 + lsig512_0 w40 + w39
w56 = lsig512_1 w54 + w49 + lsig512_0 w41 + w40
w57 = lsig512_1 w55 + w50 + lsig512_0 w42 + w41
w58 = lsig512_1 w56 + w51 + lsig512_0 w43 + w42
w59 = lsig512_1 w57 + w52 + lsig512_0 w44 + w43
w60 = lsig512_1 w58 + w53 + lsig512_0 w45 + w44
w61 = lsig512_1 w59 + w54 + lsig512_0 w46 + w45
w62 = lsig512_1 w60 + w55 + lsig512_0 w47 + w46
w63 = lsig512_1 w61 + w56 + lsig512_0 w48 + w47
w64 = lsig512_1 w62 + w57 + lsig512_0 w49 + w48
w65 = lsig512_1 w63 + w58 + lsig512_0 w50 + w49
w66 = lsig512_1 w64 + w59 + lsig512_0 w51 + w50
w67 = lsig512_1 w65 + w60 + lsig512_0 w52 + w51
w68 = lsig512_1 w66 + w61 + lsig512_0 w53 + w52
w69 = lsig512_1 w67 + w62 + lsig512_0 w54 + w53
w70 = lsig512_1 w68 + w63 + lsig512_0 w55 + w54
w71 = lsig512_1 w69 + w64 + lsig512_0 w56 + w55
w72 = lsig512_1 w70 + w65 + lsig512_0 w57 + w56
w73 = lsig512_1 w71 + w66 + lsig512_0 w58 + w57
w74 = lsig512_1 w72 + w67 + lsig512_0 w59 + w58
w75 = lsig512_1 w73 + w68 + lsig512_0 w60 + w59
w76 = lsig512_1 w74 + w69 + lsig512_0 w61 + w60
w77 = lsig512_1 w75 + w70 + lsig512_0 w62 + w61
w78 = lsig512_1 w76 + w71 + lsig512_0 w63 + w62
w79 = lsig512_1 w77 + w72 + lsig512_0 w64 + w63
return $ SHA512Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09
w10 w11 w12 w13 w14 w15 w16 w17 w18 w19
w20 w21 w22 w23 w24 w25 w26 w27 w28 w29
w30 w31 w32 w33 w34 w35 w36 w37 w38 w39
w40 w41 w42 w43 w44 w45 w46 w47 w48 w49
w50 w51 w52 w53 w54 w55 w56 w57 w58 w59
w60 w61 w62 w63 w64 w65 w66 w67 w68 w69
w70 w71 w72 w73 w74 w75 w76 w77 w78 w79
processSHA512Block :: SHA512State -> Get SHA512State
processSHA512Block !s00@(SHA512S a00 b00 c00 d00 e00 f00 g00 h00) = do
(SHA512Sched w00 w01 w02 w03 w04 w05 w06 w07 w08 w09
w10 w11 w12 w13 w14 w15 w16 w17 w18 w19
w20 w21 w22 w23 w24 w25 w26 w27 w28 w29
w30 w31 w32 w33 w34 w35 w36 w37 w38 w39
w40 w41 w42 w43 w44 w45 w46 w47 w48 w49
w50 w51 w52 w53 w54 w55 w56 w57 w58 w59
w60 w61 w62 w63 w64 w65 w66 w67 w68 w69
w70 w71 w72 w73 w74 w75 w76 w77 w78 w79) <- getSHA512Sched
let s01 = step512 s00 0x428a2f98d728ae22 w00
s02 = step512 s01 0x7137449123ef65cd w01
s03 = step512 s02 0xb5c0fbcfec4d3b2f w02
s04 = step512 s03 0xe9b5dba58189dbbc w03
s05 = step512 s04 0x3956c25bf348b538 w04
s06 = step512 s05 0x59f111f1b605d019 w05
s07 = step512 s06 0x923f82a4af194f9b w06
s08 = step512 s07 0xab1c5ed5da6d8118 w07
s09 = step512 s08 0xd807aa98a3030242 w08
s10 = step512 s09 0x12835b0145706fbe w09
s11 = step512 s10 0x243185be4ee4b28c w10
s12 = step512 s11 0x550c7dc3d5ffb4e2 w11
s13 = step512 s12 0x72be5d74f27b896f w12
s14 = step512 s13 0x80deb1fe3b1696b1 w13
s15 = step512 s14 0x9bdc06a725c71235 w14
s16 = step512 s15 0xc19bf174cf692694 w15
s17 = step512 s16 0xe49b69c19ef14ad2 w16
s18 = step512 s17 0xefbe4786384f25e3 w17
s19 = step512 s18 0x0fc19dc68b8cd5b5 w18
s20 = step512 s19 0x240ca1cc77ac9c65 w19
s21 = step512 s20 0x2de92c6f592b0275 w20
s22 = step512 s21 0x4a7484aa6ea6e483 w21
s23 = step512 s22 0x5cb0a9dcbd41fbd4 w22
s24 = step512 s23 0x76f988da831153b5 w23
s25 = step512 s24 0x983e5152ee66dfab w24
s26 = step512 s25 0xa831c66d2db43210 w25
s27 = step512 s26 0xb00327c898fb213f w26
s28 = step512 s27 0xbf597fc7beef0ee4 w27
s29 = step512 s28 0xc6e00bf33da88fc2 w28
s30 = step512 s29 0xd5a79147930aa725 w29
s31 = step512 s30 0x06ca6351e003826f w30
s32 = step512 s31 0x142929670a0e6e70 w31
s33 = step512 s32 0x27b70a8546d22ffc w32
s34 = step512 s33 0x2e1b21385c26c926 w33
s35 = step512 s34 0x4d2c6dfc5ac42aed w34
s36 = step512 s35 0x53380d139d95b3df w35
s37 = step512 s36 0x650a73548baf63de w36
s38 = step512 s37 0x766a0abb3c77b2a8 w37
s39 = step512 s38 0x81c2c92e47edaee6 w38
s40 = step512 s39 0x92722c851482353b w39
s41 = step512 s40 0xa2bfe8a14cf10364 w40
s42 = step512 s41 0xa81a664bbc423001 w41
s43 = step512 s42 0xc24b8b70d0f89791 w42
s44 = step512 s43 0xc76c51a30654be30 w43
s45 = step512 s44 0xd192e819d6ef5218 w44
s46 = step512 s45 0xd69906245565a910 w45
s47 = step512 s46 0xf40e35855771202a w46
s48 = step512 s47 0x106aa07032bbd1b8 w47
s49 = step512 s48 0x19a4c116b8d2d0c8 w48
s50 = step512 s49 0x1e376c085141ab53 w49
s51 = step512 s50 0x2748774cdf8eeb99 w50
s52 = step512 s51 0x34b0bcb5e19b48a8 w51
s53 = step512 s52 0x391c0cb3c5c95a63 w52
s54 = step512 s53 0x4ed8aa4ae3418acb w53
s55 = step512 s54 0x5b9cca4f7763e373 w54
s56 = step512 s55 0x682e6ff3d6b2b8a3 w55
s57 = step512 s56 0x748f82ee5defb2fc w56
s58 = step512 s57 0x78a5636f43172f60 w57
s59 = step512 s58 0x84c87814a1f0ab72 w58
s60 = step512 s59 0x8cc702081a6439ec w59
s61 = step512 s60 0x90befffa23631e28 w60
s62 = step512 s61 0xa4506cebde82bde9 w61
s63 = step512 s62 0xbef9a3f7b2c67915 w62
s64 = step512 s63 0xc67178f2e372532b w63
s65 = step512 s64 0xca273eceea26619c w64
s66 = step512 s65 0xd186b8c721c0c207 w65
s67 = step512 s66 0xeada7dd6cde0eb1e w66
s68 = step512 s67 0xf57d4f7fee6ed178 w67
s69 = step512 s68 0x06f067aa72176fba w68
s70 = step512 s69 0x0a637dc5a2c898a6 w69
s71 = step512 s70 0x113f9804bef90dae w70
s72 = step512 s71 0x1b710b35131c471b w71
s73 = step512 s72 0x28db77f523047d84 w72
s74 = step512 s73 0x32caab7b40c72493 w73
s75 = step512 s74 0x3c9ebe0a15c9bebc w74
s76 = step512 s75 0x431d67c49c100d4c w75
s77 = step512 s76 0x4cc5d4becb3e42b6 w76
s78 = step512 s77 0x597f299cfc657e2a w77
s79 = step512 s78 0x5fcb6fab3ad6faec w78
s80 = step512 s79 0x6c44198c4a475817 w79
SHA512S a80 b80 c80 d80 e80 f80 g80 h80 = s80
return $ SHA512S (a00 + a80) (b00 + b80) (c00 + c80) (d00 + d80)
(e00 + e80) (f00 + f80) (g00 + g80) (h00 + h80)
{-# INLINE step512 #-}
step512 :: SHA512State -> Word64 -> Word64 -> SHA512State
step512 !(SHA512S a b c d e f g h) k w = SHA512S a' b' c' d' e' f' g' h'
where
t1 = h + bsig512_1 e + ch e f g + k + w
t2 = bsig512_0 a + maj a b c
h' = g
g' = f
f' = e
e' = d + t1
d' = c
c' = b
b' = a
a' = t1 + t2
runSHA :: a -> (a -> Get a) -> ByteString -> a
runSHA s nextChunk input = runGet (getAll s) input
where
getAll s_in = do
done <- isEmpty
if done
then return s_in
else nextChunk s_in >>= getAll
sha512 :: ByteString -> Digest SHA512State
sha512 bs_in = Digest bs_out
where
bs_pad = padSHA512 bs_in
fstate = runSHA initialSHA512State processSHA512Block bs_pad
bs_out = runPut $ synthesizeSHA512 fstate
sha512_spec_tests :: [(String, String)]
sha512_spec_tests =
[("abc",
"ddaf35a193617abacc417349ae20413112e6fa4e89a97ea20a9eeee64b55d39a" ++
"2192992a274fc1a836ba3c23a3feebbd454d4423643ce80e2a9ac94fa54ca49f"),
("abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn" ++
"hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu",
"8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018" ++
"501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909"),
(replicate 1000000 'a',
"e718483d0ce769644e2e42c7bc15b4638e1f98b13b2044285632a803afa973eb" ++
"de0ff244877ea60a4cb0432ce577c31beb009c5c2c49aa2e4eadb217ad8cc09b")]
showDigest :: Digest t -> String
showDigest (Digest bs) = showDigestBS bs
-- |Prints out a bytestring in hexadecimal. Just for convenience.
showDigestBS :: ByteString -> String
showDigestBS bs = foldr paddedShowHex [] (BS.unpack bs)
where
paddedShowHex x xs = intToDigit (fromIntegral (x `shiftR` 4))
: intToDigit (fromIntegral (x .&. 0xf))
: xs
main :: IO ()
main = do
sequence_
[ unless (digest == expected)
$ fail $ "failed: " ++ expected ++ " /= " ++ digest
| (str, expected) <- sha512_spec_tests
, let digest = showDigest (sha512 $ BSC.pack str)
]
|