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

Kind	Covered	All	%
expression	18	709	2.5
branch	1	24	4.2

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;;; ed448.lisp -- implementation of the ed448 signature algorithm

2

(in-package :crypto)

3

4

;;; class definitions

5

(defclass ed448-public-key ()

6

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

7

8

(defclass ed448-private-key ()

9

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

10

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

11

12

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

13

(defclass ed448-point ()

14

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

15

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

16

((x :initarg :x :type integer)

17

(y :initarg :y :type integer)

18

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

19

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

20

(declare (ignore env))

21

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

22

23

;;; constant and function definitions

24

(defconstant +ed448-bits+ 456)

25

 (defconstant +ed448-q+ 726838724295606890549323807888004534353641360687318060281490199180612328166730772686396383698676545930088884461843637361053498018365439)

26

 (defconstant +ed448-l+ 181709681073901722637330951972001133588410340171829515070372549795146003961539585716195755291692375963310293709091662304773755859649779)

27

(defconstant +ed448-d+ -39081)

28

29

(defconst +ed448-b+

30

(make-instance 'ed448-point

31

                  :x 224580040295924300187604334099896036246789641632564134246125461686950415467406032909029192869357953282578032075146446173674602635247710

32

                  :y 298819210078481492676017930443930673437544040154080242095928241372331506189835876003536878655418784733982303233503462500531545062832660

33

:z 1))

34

(defconst +ed448-point-at-infinity+

35

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

36

37

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

38

(defun ed448-dom (x y)

39

(declare (type (unsigned-byte 8) x)

40

(type (simple-array (unsigned-byte 8) (*)) y)

41

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

42

(when (> (length y) 255)

43

(error 'ironclad-error

44

:format-control "The Y array is to big."))

45

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

46

(map 'vector #'char-code "SigEd448")

47

(vector x)

48

(vector (length y))

49

y)))

50

;; Ed448 (x = 0), no context (y = #())

51

(defconst +ed448-dom+ (ed448-dom 0 (make-array 0 :element-type '(unsigned-byte 8))))

52

53

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

54

(expt-mod n (- +ed448-q+ 2) +ed448-q+))

55

56

(defun ed448-recover-x (y)

57

"Recover the X coordinate of a point on ed448 curve from the Y coordinate."

58

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

59

(type integer y))

60

(let* ((u (mod (1- (* y y)) +ed448-q+))

61

(v (mod (1- (* +ed448-d+ (1+ u))) +ed448-q+))

62

(uv (mod (* u v) +ed448-q+))

63

(u3v (mod (* u u uv) +ed448-q+))

64

(u5v3 (mod (* u3v uv uv) +ed448-q+))

65

(x (mod (* u3v (expt-mod u5v3 (/ (- +ed448-q+ 3) 4) +ed448-q+)) +ed448-q+)))

66

(declare (type integer u v uv u3v u5v3 x))

67

(unless (evenp x)

68

(setf x (- +ed448-q+ x)))

69

x))

70

71

(defmethod ec-add ((p ed448-point) (q ed448-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

(let* ((a (mod (* z1 z2) +ed448-q+))

78

(b (mod (* a a) +ed448-q+))

79

(c (mod (* x1 x2) +ed448-q+))

80

(d (mod (* y1 y2) +ed448-q+))

81

(k (mod (* c d) +ed448-q+))

82

(e (mod (* +ed448-d+ k) +ed448-q+))

83

(f (mod (- b e) +ed448-q+))

84

(g (mod (+ b e) +ed448-q+))

85

(h (mod (* (+ x1 y1) (+ x2 y2)) +ed448-q+))

86

(i (mod (* a f) +ed448-q+))

87

(j (mod (* a g) +ed448-q+))

88

(x3 (mod (* i (- h c d)) +ed448-q+))

89

(y3 (mod (* j (- d c)) +ed448-q+))

90

(z3 (mod (* f g) +ed448-q+)))

91

(declare (type integer a b c d e f g h i j k x3 y3 z3))

92

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

93

94

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

95

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

96

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

97

(declare (type integer x1 y1 z1))

98

(let* ((a (mod (+ x1 y1) +ed448-q+))

99

(b (mod (* a a) +ed448-q+))

100

(c (mod (* x1 x1) +ed448-q+))

101

(d (mod (* y1 y1) +ed448-q+))

102

(e (mod (+ c d) +ed448-q+))

103

(f (mod (* z1 z1) +ed448-q+))

104

(g (mod (- e (* 2 f)) +ed448-q+))

105

(x2 (mod (* (- b e) g) +ed448-q+))

106

(y2 (mod (* (- c d) e) +ed448-q+))

107

(z2 (mod (* e g) +ed448-q+)))

108

(declare (type integer a b c d e f g x2 y2 z2))

109

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

110

111

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

112

;; Point multiplication on ed448 curve using the Montgomery ladder.

113

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

114

(type integer e))

115

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

116

(r1 p)

117

(i 447 (1- i)))

118

((minusp i) r0)

119

(declare (type ed448-point r0 r1)

120

(type fixnum i))

121

(if (logbitp i e)

122

(setf r0 (ec-add r0 r1)

123

r1 (ec-double r1))

124

(setf r1 (ec-add r0 r1)

125

r0 (ec-double r0)))))

126

127

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

128

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

129

(with-slots (x y z) p

130

(declare (type integer x y z))

131

(let* ((xx (mod (* x x) +ed448-q+))

132

(yy (mod (* y y) +ed448-q+))

133

(zz (mod (* z z) +ed448-q+))

134

(zzzz (mod (* zz zz) +ed448-q+))

135

(a (mod (* zz (+ yy xx)) +ed448-q+))

136

(b (mod (+ zzzz (* +ed448-d+ xx yy)) +ed448-q+)))

137

(declare (type integer xx yy zz zzzz a b))

138

(zerop (mod (- a b) +ed448-q+)))))

139

140

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

141

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

142

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

143

(declare (type integer x1 y1 z1))

144

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

145

(declare (type integer x2 y2 z2))

146

(and (zerop (mod (- (* x1 z2) (* x2 z1)) +ed448-q+))

147

(zerop (mod (- (* y1 z2) (* y2 z1)) +ed448-q+))))))

148

149

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

150

(unless x

151

(error 'missing-point-parameter

152

:kind 'ed448

153

:parameter 'x

154

:description "coordinate"))

155

(unless y

156

(error 'missing-point-parameter

157

:kind 'ed448

158

:parameter 'y

159

:description "coordinate"))

160

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

161

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

162

p

163

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

164

165

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

166

(with-slots (x y z) p

167

(declare (type integer x y z))

168

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

169

(x (mod (* x invz) +ed448-q+))

170

(y (mod (* y invz) +ed448-q+)))

171

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

172

173

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

174

(integer-to-octets n :n-bits +ed448-bits+ :big-endian nil))

175

176

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

177

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

178

179

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

180

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

181

(x (getf coordinates :x))

182

(y (getf coordinates :y)))

183

(declare (type integer x y))

184

(setf (ldb (byte 1 (- +ed448-bits+ 1)) y) (ldb (byte 1 0) x))

185

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

186

187

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

188

(let* ((y (ec-decode-scalar :ed448 octets))

189

(b (ldb (byte 1 (- +ed448-bits+ 1)) y)))

190

(setf (ldb (byte 1 (- +ed448-bits+ 1)) y) 0)

191

(let ((x (ed448-recover-x y)))

192

(declare (type integer x))

193

(unless (= (ldb (byte 1 0) x) b)

194

(setf x (- +ed448-q+ x)))

195

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

196

197

(defun ed448-hash (&rest messages)

198

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

199

(let ((digest (make-digest :shake256 :output-length 114)))

200

(dolist (m messages)

201

(update-digest digest m))

202

(produce-digest digest)))

203

204

(defun ed448-public-key (sk)

205

"Compute the public key associated to the private key SK."

206

(let ((h (ed448-hash sk)))

207

(setf h (subseq h 0 (ceiling +ed448-bits+ 8)))

208

(setf (ldb (byte 2 0) (elt h 0)) 0)

209

(setf (ldb (byte 1 7) (elt h (- (ceiling +ed448-bits+ 8) 2))) 1)

210

(setf (elt h (- (ceiling +ed448-bits+ 8) 1)) 0)

211

(let ((a (ec-decode-scalar :ed448 h)))

212

(ec-encode-point (ec-scalar-mult +ed448-b+ a)))))

213

214

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

215

(unless r

216

(error 'missing-signature-parameter

217

:kind 'ed448

218

:parameter 'r

219

:description "first signature element"))

220

(unless s

221

(error 'missing-signature-parameter

222

:kind 'ed448

223

:parameter 's

224

:description "second signature element"))

225

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

226

227

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

228

(let ((length (length signature)))

229

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

230

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

231

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

232

(r (subseq signature 0 middle))

233

(s (subseq signature middle)))

234

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

235

236

(defun ed448-sign (m sk pk)

237

(declare (type (simple-array (unsigned-byte 8) (*)) m sk pk)

238

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

239

(let ((h (ed448-hash sk)))

240

(setf (ldb (byte 2 0) (elt h 0)) 0)

241

(setf (ldb (byte 1 7) (elt h (- (ceiling +ed448-bits+ 8) 2))) 1)

242

(setf (elt h (- (ceiling +ed448-bits+ 8) 1)) 0)

243

(let* ((a (ec-decode-scalar :ed448 (subseq h 0 (ceiling +ed448-bits+ 8))))

244

            (rh (ed448-hash +ed448-dom+ (subseq h (ceiling +ed448-bits+ 8) (ceiling +ed448-bits+ 4)) m))

245

(ri (mod (ec-decode-scalar :ed448 rh) +ed448-l+))

246

(r (ec-scalar-mult +ed448-b+ ri))

247

(rp (ec-encode-point r))

248

(k (mod (ec-decode-scalar :ed448 (ed448-hash +ed448-dom+ rp pk m)) +ed448-l+))

249

(s (mod (+ (* k a) ri) +ed448-l+)))

250

(make-signature :ed448 :r rp :s (ec-encode-scalar :ed448 s)))))

251

252

(defun ed448-verify (s m pk)

253

(declare (type (simple-array (unsigned-byte 8) (*)) s m pk)

254

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

255

(unless (= (length s) (ceiling +ed448-bits+ 4))

256

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

257

(unless (= (length pk) (ceiling +ed448-bits+ 8))

258

(error 'invalid-public-key-length :kind 'ed448))

259

(let* ((signature-elements (destructure-signature :ed448 s))

260

(r (getf signature-elements :r))

261

(rp (ec-decode-point :ed448 r))

262

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

263

(a (ec-decode-point :ed448 pk))

264

(h (mod (ec-decode-scalar :ed448 (ed448-hash +ed448-dom+ r pk m)) +ed448-l+))

265

(res1 (ec-scalar-mult +ed448-b+ s))

266

(res2 (ec-add rp (ec-scalar-mult a h))))

267

(declare (type (simple-array (unsigned-byte 8) (*)) r)

268

(type integer s h)

269

(type ed448-point rp a res1 res2))

270

(and (< s +ed448-l+)

271

(ec-point-equal res1 res2))))

272

273

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

274

(unless y

275

(error 'missing-key-parameter

276

:kind 'ed448

277

:parameter 'y

278

:description "public key"))

279

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

280

281

(defmethod destructure-public-key ((public-key ed448-public-key))

282

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

283

284

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

285

(unless x

286

(error 'missing-key-parameter

287

:kind 'ed448

288

:parameter 'x

289

:description "private key"))

290

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

291

292

(defmethod destructure-private-key ((private-key ed448-private-key))

293

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

294

:y (ed448-key-y private-key)))

295

296

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

297

(let ((end (or end (length message)))

298

(sk (ed448-key-x key))

299

(pk (ed448-key-y key)))

300

(ed448-sign (subseq message start end) sk pk)))

301

302

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

303

(let ((end (or end (length message)))

304

(pk (ed448-key-y key)))

305

(ed448-verify signature (subseq message start end) pk)))

306

307

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

308

(let* ((sk (random-data (ceiling +ed448-bits+ 8)))

309

(pk (ed448-public-key sk)))

310

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

311

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