Projects : gbw-signer : gbw-signer_static_bit_ops_reindent
| 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 |