Projects : gbw-signer : gbw-signer_usrbin
1 | ;;;; ecdsa.scm: Elliptic Curve Digital Signature Algorithm based on bignum.scm |
2 | ;;; J. Welsh, October 2017 - March 2020 |
3 | |
4 | (lambda (bn) |
5 | (define bytes->bn (bn 'bytes->bn)) |
6 | (define unshift (bn 'bn-unshift)) |
7 | (define nbits (bn 'bn-bits)) |
8 | (define /2 (bn 'bn/2)) |
9 | (define bn-1 (bn 'bn-1)) |
10 | (define bn0 (bn 'bn0)) |
11 | (define bn1 (bn 'bn1)) |
12 | (define bn->hex (bn 'bn->hex)) |
13 | (define hex->bn (bn 'hex->bn)) |
14 | (define rand-bn (bn 'rand-bn)) |
15 | (define fix- -) |
16 | (define fix-zero? zero?) |
17 | |
18 | ;; Convert the leftmost max-bits bits of big-endian byte sequence b to bignum |
19 | (define (left-bytes->bn b max-bits) |
20 | ; Equivalent to [SEC1] section 4.1.3 step 5 |
21 | (let ((e (bytes->bn b)) |
22 | (bits (* 8 (vector-length b)))) |
23 | (if (<= bits max-bits) e |
24 | (unshift e (- bits max-bits))))) |
25 | |
26 | ;; Operations on a Weierstrass elliptic curve, over the prime field of order p, defined by: |
27 | ;; |
28 | ;; y^2 == x^3 + ax + b mod p |
29 | ;; |
30 | ;; ("a == b mod m" means modular congruence: a-b is a multiple of m.) |
31 | ;; |
32 | ;; g -- base point (generator) (cons gx gy) |
33 | ;; n -- order of g |
34 | ;; h -- cofactor (nh = number of points on the curve) |
35 | (define (curve p a b g n h) |
36 | (let ((+ (bn 'bn+)) |
37 | (- (bn 'bn-)) |
38 | (* (bn 'bn*)) |
39 | (*fix (bn 'bn*fix)) |
40 | (*2 (bn 'bn*2)) |
41 | (^2 (bn 'bn^2)) |
42 | (zero? (bn 'bn-zero?)) |
43 | (even? (bn 'bn-even?)) |
44 | (= (bn 'bn=)) |
45 | (> (bn 'bn>)) |
46 | (< (bn 'bn<)) |
47 | (n-bits (nbits n)) |
48 | (n/2 (/2 n)) |
49 | (remainder (bn 'bn-remainder)) |
50 | (mod-inverse (bn 'bn-mod-inverse))) |
51 | |
52 | (define (modp a) |
53 | (remainder a p)) |
54 | |
55 | (define (modn a) |
56 | (remainder a n)) |
57 | |
58 | ;; Compute a-b mod p, avoiding negatives; output reduced if inputs are |
59 | (define (mod- a b) |
60 | (if (< a b) (- (+ p a) b) (- a b))) |
61 | |
62 | ;; Compute 2a mod p; output is reduced if input is |
63 | (define (mod*2 a) |
64 | (let ((b (*2 a))) |
65 | (if (< b p) b (- b p)))) |
66 | |
67 | (define (mod^2 a) (modp (^2 a))) |
68 | (define (mod* a b) (modp (* a b))) |
69 | |
70 | ;; Saves a reduction compared to (= (modp a) (modp b)) |
71 | (define (congruent? a b) |
72 | (zero? (modp (if (< a b) (- b a) (- a b))))) |
73 | |
74 | (define (on-curve? point) |
75 | (if (eq? point 'inf) #t |
76 | (let ((x (car point)) (y (cdr point))) |
77 | (and (< x p) |
78 | (< y p) |
79 | (congruent? (^2 y) |
80 | (+ (* (mod^2 x) x) (+ (* a x) b))))))) |
81 | |
82 | ;; EC group operation, per [SEC1] section 2.2.1 |
83 | (define (ec+ p1 p2) |
84 | (if (eq? p1 'inf) p2 ; adding the identity |
85 | (if (eq? p2 'inf) p1 |
86 | (let ((x1 (car p1)) |
87 | (y1 (cdr p1)) |
88 | (x2 (car p2)) |
89 | (y2 (cdr p2))) |
90 | (let ((x2-x1 (mod- x2 x1))) |
91 | (if (and (zero? x2-x1) |
92 | (or (zero? y1) (not (= y1 y2)))) |
93 | 'inf ; adding the inverse |
94 | (let* ((slope (if (zero? x2-x1) |
95 | ; same point (doubling) |
96 | (mod* (modp (+ (*fix (^2 x1) 3) a)) |
97 | (mod-inverse (mod*2 y1) p)) |
98 | (mod* (mod- y2 y1) |
99 | (mod-inverse x2-x1 p)))) |
100 | (x3 (mod- (mod- (mod^2 slope) x1) x2))) |
101 | (cons x3 (mod- (mod* slope (mod- x1 x3)) y1))))))))) |
102 | |
103 | ;; Supposedly doubling can be faster than general addition but I'm not seeing how... |
104 | (define (ec*2 p1) |
105 | (if (eq? p1 'inf) p1 |
106 | (let ((x (car p1)) |
107 | (y (cdr p1))) |
108 | (if (zero? y) 'inf |
109 | (let ((slope (mod* (modp (+ (*fix (^2 x) 3) a)) |
110 | (mod-inverse (mod*2 y) p)))) |
111 | (let ((x3 (mod- (mod^2 slope) (mod*2 x)))) |
112 | (cons x3 (mod- (mod* slope (mod- x x3)) y)))))))) |
113 | |
114 | ;; Scalar multiplication: computes the equivalent of k repeated additions of point p, in O(log k) time. |
115 | (define (scalar* k p) |
116 | (do ((k k (/2 k)) |
117 | (acc 'inf (if (even? k) acc (ec+ acc p*2^bits))) |
118 | (p*2^bits p (ec*2 p*2^bits))) |
119 | ((zero? k) acc))) |
120 | |
121 | ;; Optimize products of g by precomputation |
122 | (define (scalar*g k) |
123 | (do ((k k (/2 k)) |
124 | (acc 'inf (if (even? k) acc (ec+ acc (car doublings)))) |
125 | (doublings (force doublings-of-g) (cdr doublings))) |
126 | ((zero? k) acc))) |
127 | |
128 | (define doublings-of-g |
129 | (delay |
130 | (do ((k (nbits (bn-1 n)) (fix- k 1)) |
131 | (g*2^bits g (ec*2 g*2^bits)) |
132 | (doublings '() (cons g*2^bits doublings))) |
133 | ((fix-zero? k) (reverse doublings))))) |
134 | |
135 | (define gen-priv-key |
136 | (let ((get-rand-int (rand-bn n))) |
137 | (lambda (rng-port) |
138 | (let ((k (get-rand-int rng-port))) |
139 | (if (zero? k) |
140 | (error "generated all-zero key?!") |
141 | k))))) |
142 | |
143 | (define (valid-pub-key? point) |
144 | ;; Per [SEC1] section 3.2.2.1 |
145 | (and (not (eq? point 'inf)) |
146 | (on-curve? point) |
147 | (or (= h bn1) (eq? (scalar* n point) 'inf)))) |
148 | |
149 | ;; Return an ECDSA signature of a message hash via (cont r s). Always succeeds, assuming valid inputs and properly functioning RNG. |
150 | ;; |
151 | ;; As (r, -s mod n) is also a valid signature, the result is canonicalized to use the lesser of the two possible s-values. |
152 | ;; |
153 | ;; Note the sharp edge of the scheme: you do need a good RNG here, as knowledge of the ephemeral key compromises the private key. Repeated r-values make it trivial to compute, and other forms of predictability may well do the same. |
154 | (define (sign hash private-key rng-port cont) |
155 | ; Per [SEC1] section 4.1.3 |
156 | (let ((e (left-bytes->bn hash n-bits))) |
157 | (define (find-temp-key) |
158 | (let* ((k (gen-priv-key rng-port)) |
159 | (r (modn (car (scalar*g k))))) |
160 | (if (zero? r) (find-temp-key) |
161 | (let ((s (modn (* (mod-inverse k n) |
162 | (+ e (modn (* r private-key))))))) |
163 | (if (zero? s) (find-temp-key) |
164 | (cont r (if (< n/2 s) (- n s) s))))))) |
165 | (find-temp-key))) |
166 | |
167 | ;; Return whether (r, s) is a valid ECDSA signature of hash by pub-key. |
168 | ;; WARNING: you might also have to ensure (valid-pub-key? pub-key)! |
169 | (define (valid-sig? r s hash pub-key) |
170 | ;; Per [SEC1] section 4.1.4 |
171 | (and |
172 | (< bn0 r) (< r n) (< bn0 s) (< s n) |
173 | (let ((e (left-bytes->bn hash n-bits)) |
174 | (s-inv (mod-inverse s n))) |
175 | (let ((u1 (modn (* e s-inv))) |
176 | (u2 (modn (* r s-inv)))) |
177 | (let ((bigR (ec+ (scalar*g u1) |
178 | (scalar* u2 pub-key)))) |
179 | (and (not (eq? bigR 'inf)) |
180 | (= (modn (car bigR)) r))))))) |
181 | |
182 | (define (point->hex p) |
183 | (if (eq? p 'inf) p |
184 | (cons (bn->hex (car p)) |
185 | (bn->hex (cdr p))))) |
186 | |
187 | (define (hex->point p) |
188 | (if (eq? p 'inf) p |
189 | (cons (hex->bn (car p)) |
190 | (hex->bn (cdr p))))) |
191 | |
192 | (define (read-cache file) |
193 | ;; I'd rather this be automatic, but no standard way in R5RS to check if a file exists or handle errors if not... |
194 | (let* ((data (with-input-from-file file read)) |
195 | (doublings (map hex->point data))) |
196 | (set! doublings-of-g (delay doublings)))) |
197 | |
198 | (define (write-cache file) |
199 | (with-output-to-file |
200 | file (lambda () (write (map point->hex (force doublings-of-g)))))) |
201 | |
202 | (lambda (message) |
203 | (case message |
204 | ((ec+) ec+) |
205 | ((gen-priv-key) gen-priv-key) |
206 | ((priv->pub) scalar*g) |
207 | ((valid-pub-key?) valid-pub-key?) |
208 | ((sign) sign) |
209 | ((valid-sig?) valid-sig?) |
210 | ((read-cache) read-cache) |
211 | ((write-cache) write-cache) |
212 | (else (error "bad message:" message)))))) |
213 | |
214 | ;;; Well-known curve parameters |
215 | |
216 | (define (from-hex o) |
217 | (cond ((string? o) (hex->bn o)) |
218 | ((pair? o) (cons (from-hex (car o)) (from-hex (cdr o)))) |
219 | (else o))) |
220 | |
221 | (define (curve-from-hex . args) |
222 | (apply curve (from-hex args))) |
223 | |
224 | ;; Generalized Koblitz curve over a 256-bit prime field, per [SEC2] |
225 | (let ((secp256k1 |
226 | (curve-from-hex |
227 | "fffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f" |
228 | "0" |
229 | "7" |
230 | '("79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798" . "483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8") |
231 | "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141" |
232 | "1"))) |
233 | |
234 | (export curve secp256k1))) |
235 | |
236 | ;;; References |
237 | |
238 | ;; [SEC1] Certicom Research 2009. "Standards for Efficient Cryptography: SEC 1: Elliptic Curve Cryptography". Certicom Corp. Version 2.0. http://www.secg.org/sec1-v2.pdf |
239 | ;; [SEC2] Certicom Research 2010. "Standards for Efficient Cryptography: SEC 2: Recommended Elliptic Curve Domain Parameters". Certicom Corp. Version 2.0. http://www.secg.org/sec2-v2.pdf |
240 | ;; [HAC] Menezes, A., van Oorshot, P. and Vanstone, S. 1996. "Handbook of Applied Cryptography". CRC Press. http://www.cacr.math.uwaterloo.ca/hac |