1 USING: crypto crypto-internals io kernel math namespaces sequences words ;
24 : initial-H-256 ( -- seq )
26 HEX: 6a09e667 HEX: bb67ae85 HEX: 3c6ef372 HEX: a54ff53a
27 HEX: 510e527f HEX: 9b05688c HEX: 1f83d9ab HEX: 5be0cd19
32 HEX: 428a2f98 HEX: 71374491 HEX: b5c0fbcf HEX: e9b5dba5
33 HEX: 3956c25b HEX: 59f111f1 HEX: 923f82a4 HEX: ab1c5ed5
34 HEX: d807aa98 HEX: 12835b01 HEX: 243185be HEX: 550c7dc3
35 HEX: 72be5d74 HEX: 80deb1fe HEX: 9bdc06a7 HEX: c19bf174
36 HEX: e49b69c1 HEX: efbe4786 HEX: 0fc19dc6 HEX: 240ca1cc
37 HEX: 2de92c6f HEX: 4a7484aa HEX: 5cb0a9dc HEX: 76f988da
38 HEX: 983e5152 HEX: a831c66d HEX: b00327c8 HEX: bf597fc7
39 HEX: c6e00bf3 HEX: d5a79147 HEX: 06ca6351 HEX: 14292967
40 HEX: 27b70a85 HEX: 2e1b2138 HEX: 4d2c6dfc HEX: 53380d13
41 HEX: 650a7354 HEX: 766a0abb HEX: 81c2c92e HEX: 92722c85
42 HEX: a2bfe8a1 HEX: a81a664b HEX: c24b8b70 HEX: c76c51a3
43 HEX: d192e819 HEX: d6990624 HEX: f40e3585 HEX: 106aa070
44 HEX: 19a4c116 HEX: 1e376c08 HEX: 2748774c HEX: 34b0bcb5
45 HEX: 391c0cb3 HEX: 4ed8aa4a HEX: 5b9cca4f HEX: 682e6ff3
46 HEX: 748f82ee HEX: 78a5636f HEX: 84c87814 HEX: 8cc70208
47 HEX: 90befffa HEX: a4506ceb HEX: bef9a3f7 HEX: c67178f2
51 [ -7 bitroll-32 ] keep
52 [ -18 bitroll-32 ] keep
53 -3 shift bitxor bitxor ; inline
56 [ -17 bitroll-32 ] keep
57 [ -19 bitroll-32 ] keep
58 -10 shift bitxor bitxor ; inline
60 : process-M-256 ( seq n -- )
61 [ 16 - swap nth ] 2keep
62 [ 15 - swap nth s0-256 ] 2keep
63 [ 7 - swap nth ] 2keep
64 [ 2 - swap nth s1-256 ] 2keep
65 >r >r + + w+ r> r> swap set-nth ; inline
67 : prepare-message-schedule ( seq -- w-seq )
68 word-size get group [ be> ] map block-size get 0 pad-right
69 dup 16 64 dup <slice> [
74 [ bitxor bitand ] keep bitxor ;
77 >r [ bitand ] 2keep bitor r> bitand bitor ;
80 [ -2 bitroll-32 ] keep
81 [ -13 bitroll-32 ] keep
82 -22 bitroll-32 bitxor bitxor ; inline
85 [ -6 bitroll-32 ] keep
86 [ -11 bitroll-32 ] keep
87 -25 bitroll-32 bitxor bitxor ; inline
92 e vars get slice3 ch +
93 e vars get nth S1-256 +
98 a vars get slice3 maj w+ ;
100 : update-vars ( T1 T2 -- )
105 pick d pick nth w+ e pick set-nth
111 : process-chunk ( M -- )
113 prepare-message-schedule block-size get [
115 ] each-with vars get H get [ w+ ] 2map H set ;
117 : seq>string ( n seq -- string )
118 [ [ swap >be % ] each-with ] "" make ;
120 : string>sha2 ( string -- string )
121 t preprocess-plaintext
122 block-size get group [ process-chunk ] each
126 : string>sha-256 ( string -- string )
136 : string>sha-256-string ( string -- hexstring )
137 string>sha-256 hex-string ;