Coverage report: /home/ellis/comp/ext/ironclad/src/public-key/secp256k1.lisp

Kind	Covered	All	%
expression	0	729	0.0
branch	0	38	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;;; secp256k1.lisp -- secp256k1 elliptic curve

2

3

(in-package :crypto)

4

5

;;; class definitions

6

(defclass secp256k1-public-key ()

7

((y :initarg :y :reader secp256k1-key-y :type (simple-array (unsigned-byte 8) (*)))))

8

9

(defclass secp256k1-private-key ()

10

((x :initarg :x :reader secp256k1-key-x :type (simple-array (unsigned-byte 8) (*)))

11

(y :initarg :y :reader secp256k1-key-y :type (simple-array (unsigned-byte 8) (*)))))

12

13

(eval-when (:compile-toplevel :load-toplevel :execute)

14

(defclass secp256k1-point ()

15

;; Internally, a point (x, y) is represented using the Jacobian projective

16

;; coordinates (X, Y, Z), with x = X / Z^2 and y = Y / Z^3.

17

((x :initarg :x :type integer)

18

(y :initarg :y :type integer)

19

(z :initarg :z :type integer)))

20

(defmethod make-load-form ((p secp256k1-point) &optional env)

21

(declare (ignore env))

22

(make-load-form-saving-slots p)))

23

24

;;; constant and function definitions

25

(defconstant +secp256k1-bits+ 256)

26

(defconstant +secp256k1-p+ 115792089237316195423570985008687907853269984665640564039457584007908834671663)

27

(defconstant +secp256k1-b+ 7)

28

(defconstant +secp256k1-l+ 115792089237316195423570985008687907852837564279074904382605163141518161494337)

29

(defconstant +secp256k1-i+ 86844066927987146567678238756515930889952488499230423029593188005931626003747)

30

31

(defconst +secp256k1-g+

32

(make-instance 'secp256k1-point

33

:x 55066263022277343669578718895168534326250603453777594175500187360389116729240

34

:y 32670510020758816978083085130507043184471273380659243275938904335757337482424

35

:z 1))

36

(defconst +secp256k1-point-at-infinity+

37

(make-instance 'secp256k1-point :x 1 :y 1 :z 0))

38

39

(defmethod ec-scalar-inv ((kind (eql :secp256k1)) n)

40

(expt-mod n (- +secp256k1-p+ 2) +secp256k1-p+))

41

42

(defmethod ec-point-equal ((p secp256k1-point) (q secp256k1-point))

43

(declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))

44

(with-slots ((x1 x) (y1 y) (z1 z)) p

45

(declare (type integer x1 y1 z1))

46

(with-slots ((x2 x) (y2 y) (z2 z)) q

47

(declare (type integer x2 y2 z2))

48

(let ((z1z1 (mod (* z1 z1) +secp256k1-p+))

49

(z2z2 (mod (* z2 z2) +secp256k1-p+)))

50

(and (zerop (mod (- (* x1 z2z2) (* x2 z1z1)) +secp256k1-p+))

51

(zerop (mod (- (* y1 z2z2 z2) (* y2 z1z1 z1)) +secp256k1-p+)))))))

52

53

(defmethod ec-double ((p secp256k1-point))

54

(declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))

55

(with-slots ((x1 x) (y1 y) (z1 z)) p

56

(declare (type integer x1 y1 z1))

57

(if (zerop z1)

58

+secp256k1-point-at-infinity+

59

(let* ((a (mod (* x1 x1) +secp256k1-p+))

60

(b (mod (* y1 y1) +secp256k1-p+))

61

(c (mod (* b b) +secp256k1-p+))

62

(x1+b (mod (+ x1 b) +secp256k1-p+))

63

(d (mod (* 2 (- (* x1+b x1+b) a c)) +secp256k1-p+))

64

(e (mod (* 3 a) +secp256k1-p+))

65

(f (mod (* e e) +secp256k1-p+))

66

(x2 (mod (- f (* 2 d)) +secp256k1-p+))

67

(y2 (mod (- (* e (- d x2)) (* 8 c)) +secp256k1-p+))

68

(z2 (mod (* 2 y1 z1) +secp256k1-p+)))

69

(make-instance 'secp256k1-point :x x2 :y y2 :z z2)))))

70

71

(defmethod ec-add ((p secp256k1-point) (q secp256k1-point))

72

(declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))

73

(with-slots ((x1 x) (y1 y) (z1 z)) p

74

(declare (type integer x1 y1 z1))

75

(with-slots ((x2 x) (y2 y) (z2 z)) q

76

(declare (type integer x2 y2 z2))

77

(cond

78

((zerop z1)

79

q)

80

((zerop z2)

81

p)

82

(t

83

(let* ((z1z1 (mod (* z1 z1) +secp256k1-p+))

84

(z2z2 (mod (* z2 z2) +secp256k1-p+))

85

(u1 (mod (* x1 z2z2) +secp256k1-p+))

86

(u2 (mod (* x2 z1z1) +secp256k1-p+))

87

(s1 (mod (* y1 z2 z2z2) +secp256k1-p+))

88

(s2 (mod (* y2 z1 z1z1) +secp256k1-p+)))

89

(if (= u1 u2)

90

(if (= s1 s2)

91

(ec-double p)

92

+secp256k1-point-at-infinity+)

93

(let* ((h (mod (- u2 u1) +secp256k1-p+))

94

(i (mod (* 4 h h) +secp256k1-p+))

95

(j (mod (* h i) +secp256k1-p+))

96

(r (mod (* 2 (- s2 s1)) +secp256k1-p+))

97

(v (mod (* u1 i) +secp256k1-p+))

98

(x3 (mod (- (* r r) j (* 2 v)) +secp256k1-p+))

99

(y3 (mod (- (* r (- v x3)) (* 2 s1 j)) +secp256k1-p+))

100

(z1+z2 (mod (+ z1 z2) +secp256k1-p+))

101

(z3 (mod (* (- (* z1+z2 z1+z2) z1z1 z2z2) h) +secp256k1-p+)))

102

(make-instance 'secp256k1-point :x x3 :y y3 :z z3)))))))))

103

104

(defmethod ec-scalar-mult ((p secp256k1-point) e)

105

;; Point multiplication on NIST P-256 curve using the Montgomery ladder.

106

(declare (optimize (speed 3) (safety 0) (space 0) (debug 0))

107

(type integer e))

108

(do ((r0 +secp256k1-point-at-infinity+)

109

(r1 p)

110

(i (1- +secp256k1-bits+) (1- i)))

111

((minusp i) r0)

112

(declare (type secp256k1-point r0 r1)

113

(type fixnum i))

114

(if (logbitp i e)

115

(setf r0 (ec-add r0 r1)

116

r1 (ec-double r1))

117

(setf r1 (ec-add r0 r1)

118

r0 (ec-double r0)))))

119

120

(defmethod ec-point-on-curve-p ((p secp256k1-point))

121

(declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))

122

(with-slots (x y z) p

123

(declare (type integer x y z))

124

(let* ((y2 (mod (* y y) +secp256k1-p+))

125

(x3 (mod (* x x x) +secp256k1-p+))

126

(z3 (mod (* z z z) +secp256k1-p+))

127

(z6 (mod (* z3 z3) +secp256k1-p+))

128

(a (mod (+ x3 (* +secp256k1-b+ z6)) +secp256k1-p+)))

129

(declare (type integer y2 x3 z3 z6 a))

130

(zerop (mod (- y2 a) +secp256k1-p+)))))

131

132

(defmethod ec-make-point ((kind (eql :secp256k1)) &key x y)

133

(unless x

134

(error 'missing-point-parameter

135

:kind 'secp256k1

136

:parameter 'x

137

:description "coordinate"))

138

(unless y

139

(error 'missing-point-parameter

140

:kind 'secp256k1

141

:parameter 'y

142

:description "coordinate"))

143

(let ((p (make-instance 'secp256k1-point :x x :y y :z 1)))

144

(if (ec-point-on-curve-p p)

145

p

146

(error 'invalid-curve-point :kind 'secp256k1))))

147

148

(defmethod ec-destructure-point ((p secp256k1-point))

149

(with-slots (x y z) p

150

(declare (type integer x y z))

151

(when (zerop z)

152

(error 'ironclad-error

153

:format-control "The point at infinity can't be encoded."))

154

(let* ((invz (ec-scalar-inv :secp256k1 z))

155

(invz2 (mod (* invz invz) +secp256k1-p+))

156

(invz3 (mod (* invz2 invz) +secp256k1-p+))

157

(x (mod (* x invz2) +secp256k1-p+))

158

(y (mod (* y invz3) +secp256k1-p+)))

159

(list :x x :y y))))

160

161

(defmethod ec-encode-scalar ((kind (eql :secp256k1)) n)

162

(integer-to-octets n :n-bits +secp256k1-bits+ :big-endian t))

163

164

(defmethod ec-decode-scalar ((kind (eql :secp256k1)) octets)

165

(octets-to-integer octets :big-endian t))

166

167

(defmethod ec-encode-point ((p secp256k1-point))

168

(let* ((coordinates (ec-destructure-point p))

169

(x (getf coordinates :x))

170

(y (getf coordinates :y)))

171

(concatenate '(simple-array (unsigned-byte 8) (*))

172

(vector 4)

173

(ec-encode-scalar :secp256k1 x)

174

(ec-encode-scalar :secp256k1 y))))

175

176

(defmethod ec-decode-point ((kind (eql :secp256k1)) octets)

177

(case (aref octets 0)

178

((2 3)

179

;; Compressed point

180

(if (= (length octets) (1+ (/ +secp256k1-bits+ 8)))

181

(let* ((x-bytes (subseq octets 1 (1+ (/ +secp256k1-bits+ 8))))

182

(x (ec-decode-scalar :secp256k1 x-bytes))

183

(y-sign (- (aref octets 0) 2))

184

(y2 (mod (+ (* x x x) +secp256k1-b+) +secp256k1-p+))

185

(y (expt-mod y2 +secp256k1-i+ +secp256k1-p+))

186

(y (if (= (logand y 1) y-sign) y (- +secp256k1-p+ y))))

187

(ec-make-point :secp256k1 :x x :y y))

188

(error 'invalid-curve-point :kind 'secp256k1)))

189

((4)

190

;; Uncompressed point

191

(if (= (length octets) (1+ (/ +secp256k1-bits+ 4)))

192

(let* ((x-bytes (subseq octets 1 (1+ (/ +secp256k1-bits+ 8))))

193

(x (ec-decode-scalar :secp256k1 x-bytes))

194

(y-bytes (subseq octets (1+ (/ +secp256k1-bits+ 8))))

195

(y (ec-decode-scalar :secp256k1 y-bytes)))

196

(ec-make-point :secp256k1 :x x :y y))

197

(error 'invalid-curve-point :kind 'secp256k1)))

198

(t

199

(error 'invalid-curve-point :kind 'secp256k1))))

200

201

(defun secp256k1-public-key (sk)

202

(let ((a (ec-decode-scalar :secp256k1 sk)))

203

(ec-encode-point (ec-scalar-mult +secp256k1-g+ a))))

204

205

(defmethod make-signature ((kind (eql :secp256k1)) &key r s &allow-other-keys)

206

(unless r

207

(error 'missing-signature-parameter

208

:kind 'secp256k1

209

:parameter 'r

210

:description "first signature element"))

211

(unless s

212

(error 'missing-signature-parameter

213

:kind 'secp256k1

214

:parameter 's

215

:description "second signature element"))

216

(concatenate '(simple-array (unsigned-byte 8) (*)) r s))

217

218

(defmethod destructure-signature ((kind (eql :secp256k1)) signature)

219

(let ((length (length signature)))

220

(if (/= length (/ +secp256k1-bits+ 4))

221

(error 'invalid-signature-length :kind 'secp256k1)

222

(let* ((middle (/ length 2))

223

(r (subseq signature 0 middle))

224

(s (subseq signature middle)))

225

(list :r r :s s)))))

226

227

(defmethod generate-signature-nonce ((key secp256k1-private-key) message &optional parameters)

228

(declare (ignore key message parameters))

229

(or *signature-nonce-for-test*

230

(1+ (strong-random (1- +secp256k1-l+)))))

231

232

;;; Note that hashing is not performed here.

233

(defmethod sign-message ((key secp256k1-private-key) message &key (start 0) end &allow-other-keys)

234

(declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))

235

(let* ((end (min (or end (length message)) (/ +secp256k1-bits+ 8)))

236

(sk (ec-decode-scalar :secp256k1 (secp256k1-key-x key)))

237

(k (generate-signature-nonce key message))

238

(invk (modular-inverse-with-blinding k +secp256k1-l+))

239

(r (ec-scalar-mult +secp256k1-g+ k))

240

(x (subseq (ec-encode-point r) 1 (1+ (/ +secp256k1-bits+ 8))))

241

(r (ec-decode-scalar :secp256k1 x))

242

(r (mod r +secp256k1-l+))

243

(h (subseq message start end))

244

(e (ec-decode-scalar :secp256k1 h))

245

(s (mod (* invk (+ e (* sk r))) +secp256k1-l+)))

246

(if (not (or (zerop r) (zerop s)))

247

(make-signature :secp256k1

248

:r (ec-encode-scalar :secp256k1 r)

249

:s (ec-encode-scalar :secp256k1 s))

250

(sign-message key message :start start :end end))))

251

252

 (defmethod verify-signature ((key secp256k1-public-key) message signature &key (start 0) end &allow-other-keys)

253

(declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))

254

(unless (= (length signature) (/ +secp256k1-bits+ 4))

255

(error 'invalid-signature-length :kind 'secp256k1))

256

(let* ((end (min (or end (length message)) (/ +secp256k1-bits+ 8)))

257

(pk (ec-decode-point :secp256k1 (secp256k1-key-y key)))

258

(signature-elements (destructure-signature :secp256k1 signature))

259

(r (ec-decode-scalar :secp256k1 (getf signature-elements :r)))

260

(s (ec-decode-scalar :secp256k1 (getf signature-elements :s)))

261

(h (subseq message start end))

262

(e (ec-decode-scalar :secp256k1 h))

263

(w (modular-inverse-with-blinding s +secp256k1-l+))

264

(u1 (mod (* e w) +secp256k1-l+))

265

(u2 (mod (* r w) +secp256k1-l+))

266

(rp (ec-add (ec-scalar-mult +secp256k1-g+ u1)

267

(ec-scalar-mult pk u2)))

268

(x (subseq (ec-encode-point rp) 1 (1+ (/ +secp256k1-bits+ 8))))

269

(v (ec-decode-scalar :secp256k1 x))

270

(v (mod v +secp256k1-l+)))

271

(and (< r +secp256k1-l+)

272

(< s +secp256k1-l+)

273

(= v r))))

274

275

(defmethod make-public-key ((kind (eql :secp256k1)) &key y &allow-other-keys)

276

(unless y

277

(error 'missing-key-parameter

278

:kind 'secp256k1

279

:parameter 'y

280

:description "public key"))

281

(make-instance 'secp256k1-public-key :y y))

282

283

(defmethod destructure-public-key ((public-key secp256k1-public-key))

284

(list :y (secp256k1-key-y public-key)))

285

286

(defmethod make-private-key ((kind (eql :secp256k1)) &key x y &allow-other-keys)

287

(unless x

288

(error 'missing-key-parameter

289

:kind 'secp256k1

290

:parameter 'x

291

:description "private key"))

292

(make-instance 'secp256k1-private-key :x x :y (or y (secp256k1-public-key x))))

293

294

(defmethod destructure-private-key ((private-key secp256k1-private-key))

295

(list :x (secp256k1-key-x private-key)

296

:y (secp256k1-key-y private-key)))

297

298

(defmethod generate-key-pair ((kind (eql :secp256k1)) &key &allow-other-keys)

299

(let* ((sk (ec-encode-scalar :secp256k1 (1+ (strong-random (1- +secp256k1-l+)))))

300

(pk (secp256k1-public-key sk)))

301

(values (make-private-key :secp256k1 :x sk :y pk)

302

(make-public-key :secp256k1 :y pk))))

303

304

(defmethod diffie-hellman ((private-key secp256k1-private-key) (public-key secp256k1-public-key))

305

(let ((s (ec-decode-scalar :secp256k1 (secp256k1-key-x private-key)))

306

(p (ec-decode-point :secp256k1 (secp256k1-key-y public-key))))

307

(ec-encode-point (ec-scalar-mult p s))))