1;;;; -*- mode: lisp; indent-tabs-mode: nil -*- 2;;;; ed448.lisp -- implementation of the ed448 signature algorithm 3 4(in-package :crypto) 5 6 7;;; class definitions 8 9(defclass ed448-public-key () 10 ((y :initarg :y :reader ed448-key-y :type (simple-array (unsigned-byte 8) (*))))) 11 12(defclass ed448-private-key () 13 ((x :initarg :x :reader ed448-key-x :type (simple-array (unsigned-byte 8) (*))) 14 (y :initarg :y :reader ed448-key-y :type (simple-array (unsigned-byte 8) (*))))) 15 16(eval-when (:compile-toplevel :load-toplevel :execute) 17 (defclass ed448-point () 18 ;; Internally, a point (x, y) is represented using the projective 19 ;; coordinates (X, Y, Z), with x = X / Z and y = Y / Z. 20 ((x :initarg :x :type integer) 21 (y :initarg :y :type integer) 22 (z :initarg :z :type integer))) 23 (defmethod make-load-form ((p ed448-point) &optional env) 24 (declare (ignore env)) 25 (make-load-form-saving-slots p))) 26 27 28;;; constant and function definitions 29 30(defconstant +ed448-bits+ 456) 31(defconstant +ed448-q+ 726838724295606890549323807888004534353641360687318060281490199180612328166730772686396383698676545930088884461843637361053498018365439) 32(defconstant +ed448-l+ 181709681073901722637330951972001133588410340171829515070372549795146003961539585716195755291692375963310293709091662304773755859649779) 33(defconstant +ed448-d+ -39081) 34 35(defconst +ed448-b+ 36 (make-instance 'ed448-point 37 :x 224580040295924300187604334099896036246789641632564134246125461686950415467406032909029192869357953282578032075146446173674602635247710 38 :y 298819210078481492676017930443930673437544040154080242095928241372331506189835876003536878655418784733982303233503462500531545062832660 39 :z 1)) 40(defconst +ed448-point-at-infinity+ 41 (make-instance 'ed448-point :x 0 :y 1 :z 1)) 42 43 44(eval-when (:compile-toplevel :load-toplevel :execute) 45 (defun ed448-dom (x y) 46 (declare (type (unsigned-byte 8) x) 47 (type (simple-array (unsigned-byte 8) (*)) y) 48 (optimize (speed 3) (safety 0) (space 0) (debug 0))) 49 (when (> (length y) 255) 50 (error 'ironclad-error 51 :format-control "The Y array is to big.")) 52 (concatenate '(simple-array (unsigned-byte 8) (*)) 53 (map 'vector #'char-code "SigEd448") 54 (vector x) 55 (vector (length y)) 56 y))) 57;; Ed448 (x = 0), no context (y = #()) 58(defconst +ed448-dom+ (ed448-dom 0 (make-array 0 :element-type '(unsigned-byte 8)))) 59 60(defmethod ec-scalar-inv ((kind (eql :ed448)) n) 61 (expt-mod n (- +ed448-q+ 2) +ed448-q+)) 62 63(defun ed448-recover-x (y) 64 "Recover the X coordinate of a point on ed448 curve from the Y coordinate." 65 (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)) 66 (type integer y)) 67 (let* ((u (mod (1- (* y y)) +ed448-q+)) 68 (v (mod (1- (* +ed448-d+ (1+ u))) +ed448-q+)) 69 (uv (mod (* u v) +ed448-q+)) 70 (u3v (mod (* u u uv) +ed448-q+)) 71 (u5v3 (mod (* u3v uv uv) +ed448-q+)) 72 (x (mod (* u3v (expt-mod u5v3 (/ (- +ed448-q+ 3) 4) +ed448-q+)) +ed448-q+))) 73 (declare (type integer u v uv u3v u5v3 x)) 74 (unless (evenp x) 75 (setf x (- +ed448-q+ x))) 76 x)) 77 78(defmethod ec-add ((p ed448-point) (q ed448-point)) 79 (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))) 80 (with-slots ((x1 x) (y1 y) (z1 z)) p 81 (declare (type integer x1 y1 z1)) 82 (with-slots ((x2 x) (y2 y) (z2 z)) q 83 (declare (type integer x2 y2 z2)) 84 (let* ((a (mod (* z1 z2) +ed448-q+)) 85 (b (mod (* a a) +ed448-q+)) 86 (c (mod (* x1 x2) +ed448-q+)) 87 (d (mod (* y1 y2) +ed448-q+)) 88 (k (mod (* c d) +ed448-q+)) 89 (e (mod (* +ed448-d+ k) +ed448-q+)) 90 (f (mod (- b e) +ed448-q+)) 91 (g (mod (+ b e) +ed448-q+)) 92 (h (mod (* (+ x1 y1) (+ x2 y2)) +ed448-q+)) 93 (i (mod (* a f) +ed448-q+)) 94 (j (mod (* a g) +ed448-q+)) 95 (x3 (mod (* i (- h c d)) +ed448-q+)) 96 (y3 (mod (* j (- d c)) +ed448-q+)) 97 (z3 (mod (* f g) +ed448-q+))) 98 (declare (type integer a b c d e f g h i j k x3 y3 z3)) 99 (make-instance 'ed448-point :x x3 :y y3 :z z3))))) 100 101(defmethod ec-double ((p ed448-point)) 102 (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))) 103 (with-slots ((x1 x) (y1 y) (z1 z)) p 104 (declare (type integer x1 y1 z1)) 105 (let* ((a (mod (+ x1 y1) +ed448-q+)) 106 (b (mod (* a a) +ed448-q+)) 107 (c (mod (* x1 x1) +ed448-q+)) 108 (d (mod (* y1 y1) +ed448-q+)) 109 (e (mod (+ c d) +ed448-q+)) 110 (f (mod (* z1 z1) +ed448-q+)) 111 (g (mod (- e (* 2 f)) +ed448-q+)) 112 (x2 (mod (* (- b e) g) +ed448-q+)) 113 (y2 (mod (* (- c d) e) +ed448-q+)) 114 (z2 (mod (* e g) +ed448-q+))) 115 (declare (type integer a b c d e f g x2 y2 z2)) 116 (make-instance 'ed448-point :x x2 :y y2 :z z2)))) 117 118(defmethod ec-scalar-mult ((p ed448-point) e) 119 ;; Point multiplication on ed448 curve using the Montgomery ladder. 120 (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)) 121 (type integer e)) 122 (do ((r0 +ed448-point-at-infinity+) 123 (r1 p) 124 (i 447 (1- i))) 125 ((minusp i) r0) 126 (declare (type ed448-point r0 r1) 127 (type fixnum i)) 128 (if (logbitp i e) 129 (setf r0 (ec-add r0 r1) 130 r1 (ec-double r1)) 131 (setf r1 (ec-add r0 r1) 132 r0 (ec-double r0))))) 133 134(defmethod ec-point-on-curve-p ((p ed448-point)) 135 (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))) 136 (with-slots (x y z) p 137 (declare (type integer x y z)) 138 (let* ((xx (mod (* x x) +ed448-q+)) 139 (yy (mod (* y y) +ed448-q+)) 140 (zz (mod (* z z) +ed448-q+)) 141 (zzzz (mod (* zz zz) +ed448-q+)) 142 (a (mod (* zz (+ yy xx)) +ed448-q+)) 143 (b (mod (+ zzzz (* +ed448-d+ xx yy)) +ed448-q+))) 144 (declare (type integer xx yy zz zzzz a b)) 145 (zerop (mod (- a b) +ed448-q+))))) 146 147(defmethod ec-point-equal ((p ed448-point) (q ed448-point)) 148 (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))) 149 (with-slots ((x1 x) (y1 y) (z1 z)) p 150 (declare (type integer x1 y1 z1)) 151 (with-slots ((x2 x) (y2 y) (z2 z)) q 152 (declare (type integer x2 y2 z2)) 153 (and (zerop (mod (- (* x1 z2) (* x2 z1)) +ed448-q+)) 154 (zerop (mod (- (* y1 z2) (* y2 z1)) +ed448-q+)))))) 155 156(defmethod ec-encode-scalar ((kind (eql :ed448)) n) 157 (integer-to-octets n :n-bits +ed448-bits+ :big-endian nil)) 158 159(defmethod ec-decode-scalar ((kind (eql :ed448)) octets) 160 (octets-to-integer octets :big-endian nil)) 161 162(defmethod ec-encode-point ((p ed448-point)) 163 (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))) 164 (with-slots (x y z) p 165 (declare (type integer x y z)) 166 (let* ((invz (ec-scalar-inv :ed448 z)) 167 (x (mod (* x invz) +ed448-q+)) 168 (y (mod (* y invz) +ed448-q+))) 169 (declare (type integer x y)) 170 (setf (ldb (byte 1 (- +ed448-bits+ 1)) y) (ldb (byte 1 0) x)) 171 (ec-encode-scalar :ed448 y)))) 172 173(defmethod ec-decode-point ((kind (eql :ed448)) octets) 174 (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))) 175 (let* ((y (ec-decode-scalar :ed448 octets)) 176 (b (ldb (byte 1 (- +ed448-bits+ 1)) y))) 177 (setf (ldb (byte 1 (- +ed448-bits+ 1)) y) 0) 178 (let ((x (ed448-recover-x y))) 179 (declare (type integer x)) 180 (unless (= (ldb (byte 1 0) x) b) 181 (setf x (- +ed448-q+ x))) 182 (let ((p (make-instance 'ed448-point :x x :y y :z 1))) 183 (if (ec-point-on-curve-p p) 184 p 185 (error 'invalid-curve-point :kind 'ed448)))))) 186 187(defun ed448-hash (&rest messages) 188 (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))) 189 (let ((digest (make-digest :shake256 :output-length 114))) 190 (dolist (m messages) 191 (update-digest digest m)) 192 (produce-digest digest))) 193 194(defun ed448-public-key (sk) 195 "Compute the public key associated to the private key SK." 196 (let ((h (ed448-hash sk))) 197 (setf h (subseq h 0 (ceiling +ed448-bits+ 8))) 198 (setf (ldb (byte 2 0) (elt h 0)) 0) 199 (setf (ldb (byte 1 7) (elt h (- (ceiling +ed448-bits+ 8) 2))) 1) 200 (setf (elt h (- (ceiling +ed448-bits+ 8) 1)) 0) 201 (let ((a (ec-decode-scalar :ed448 h))) 202 (ec-encode-point (ec-scalar-mult +ed448-b+ a))))) 203 204(defmethod make-signature ((kind (eql :ed448)) &key r s &allow-other-keys) 205 (unless r 206 (error 'missing-signature-parameter 207 :kind 'ed448 208 :parameter 'r 209 :description "first signature element")) 210 (unless s 211 (error 'missing-signature-parameter 212 :kind 'ed448 213 :parameter 's 214 :description "second signature element")) 215 (concatenate '(simple-array (unsigned-byte 8) (*)) r s)) 216 217(defmethod destructure-signature ((kind (eql :ed448)) signature) 218 (let ((length (length signature))) 219 (if (/= length (/ +ed448-bits+ 4)) 220 (error 'invalid-signature-length :kind 'ed448) 221 (let* ((middle (/ length 2)) 222 (r (subseq signature 0 middle)) 223 (s (subseq signature middle))) 224 (list :r r :s s))))) 225 226(defun ed448-sign (m sk pk) 227 (declare (type (simple-array (unsigned-byte 8) (*)) m sk pk) 228 (optimize (speed 3) (safety 0) (space 0) (debug 0))) 229 (let ((h (ed448-hash sk))) 230 (setf (ldb (byte 2 0) (elt h 0)) 0) 231 (setf (ldb (byte 1 7) (elt h (- (ceiling +ed448-bits+ 8) 2))) 1) 232 (setf (elt h (- (ceiling +ed448-bits+ 8) 1)) 0) 233 (let* ((a (ec-decode-scalar :ed448 (subseq h 0 (ceiling +ed448-bits+ 8)))) 234 (rh (ed448-hash +ed448-dom+ (subseq h (ceiling +ed448-bits+ 8) (ceiling +ed448-bits+ 4)) m)) 235 (ri (mod (ec-decode-scalar :ed448 rh) +ed448-l+)) 236 (r (ec-scalar-mult +ed448-b+ ri)) 237 (rp (ec-encode-point r)) 238 (k (mod (ec-decode-scalar :ed448 (ed448-hash +ed448-dom+ rp pk m)) +ed448-l+)) 239 (s (mod (+ (* k a) ri) +ed448-l+))) 240 (make-signature :ed448 :r rp :s (ec-encode-scalar :ed448 s))))) 241 242(defun ed448-verify (s m pk) 243 (declare (type (simple-array (unsigned-byte 8) (*)) s m pk) 244 (optimize (speed 3) (safety 0) (space 0) (debug 0))) 245 (unless (= (length s) (ceiling +ed448-bits+ 4)) 246 (error 'invalid-signature-length :kind 'ed448)) 247 (unless (= (length pk) (ceiling +ed448-bits+ 8)) 248 (error 'invalid-public-key-length :kind 'ed448)) 249 (let* ((signature-elements (destructure-signature :ed448 s)) 250 (r (getf signature-elements :r)) 251 (rp (ec-decode-point :ed448 r)) 252 (s (ec-decode-scalar :ed448 (getf signature-elements :s))) 253 (a (ec-decode-point :ed448 pk)) 254 (h (mod (ec-decode-scalar :ed448 (ed448-hash +ed448-dom+ r pk m)) +ed448-l+)) 255 (res1 (ec-scalar-mult +ed448-b+ s)) 256 (res2 (ec-add rp (ec-scalar-mult a h)))) 257 (declare (type (simple-array (unsigned-byte 8) (*)) r) 258 (type integer s h) 259 (type ed448-point rp a res1 res2)) 260 (and (< s +ed448-l+) 261 (ec-point-equal res1 res2)))) 262 263(defmethod make-public-key ((kind (eql :ed448)) &key y &allow-other-keys) 264 (unless y 265 (error 'missing-key-parameter 266 :kind 'ed448 267 :parameter 'y 268 :description "public key")) 269 (make-instance 'ed448-public-key :y y)) 270 271(defmethod destructure-public-key ((public-key ed448-public-key)) 272 (list :y (ed448-key-y public-key))) 273 274(defmethod make-private-key ((kind (eql :ed448)) &key x y &allow-other-keys) 275 (unless x 276 (error 'missing-key-parameter 277 :kind 'ed448 278 :parameter 'x 279 :description "private key")) 280 (make-instance 'ed448-private-key :x x :y (or y (ed448-public-key x)))) 281 282(defmethod destructure-private-key ((private-key ed448-private-key)) 283 (list :x (ed448-key-x private-key) 284 :y (ed448-key-y private-key))) 285 286(defmethod sign-message ((key ed448-private-key) message &key (start 0) end &allow-other-keys) 287 (let ((end (or end (length message))) 288 (sk (ed448-key-x key)) 289 (pk (ed448-key-y key))) 290 (ed448-sign (subseq message start end) sk pk))) 291 292(defmethod verify-signature ((key ed448-public-key) message signature &key (start 0) end &allow-other-keys) 293 (let ((end (or end (length message))) 294 (pk (ed448-key-y key))) 295 (ed448-verify signature (subseq message start end) pk))) 296 297(defmethod generate-key-pair ((kind (eql :ed448)) &key &allow-other-keys) 298 (let* ((sk (random-data (ceiling +ed448-bits+ 8))) 299 (pk (ed448-public-key sk))) 300 (values (make-private-key :ed448 :x sk :y pk) 301 (make-public-key :ed448 :y pk)))) 302