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

Kind	Covered	All	%
expression	0	278	0.0
branch	0	4	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;;; curve448.lisp -- implementation of the curve448 Diffie-Hellman function

2

(in-package :crypto)

3

4

;;; class definitions

5

(defclass curve448-public-key ()

6

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

7

8

(defclass curve448-private-key ()

9

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

10

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

11

12

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

13

(defclass curve448-point ()

14

;; Internally, we represent a point (x, y) using only the projective

15

;; coordinate (X, Z) for x, with x = X / Z.

16

((x :initarg :x :type integer)

17

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

18

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

19

(declare (ignore env))

20

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

21

22

;;; constants and function definitions

23

(defconstant +curve448-bits+ 448)

24

 (defconstant +curve448-p+ 726838724295606890549323807888004534353641360687318060281490199180612328166730772686396383698676545930088884461843637361053498018365439)

25

(defconstant +curve448-a24+ 39081)

26

27

(defconst +curve448-g+

28

(make-instance 'curve448-point :x 5 :z 1))

29

30

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

31

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

32

33

(defun curve448-double-and-add (x1 z1 x2 z2 x3)

34

"Point doubling and addition on curve448 curve."

35

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

36

(type integer x1 z1 x2 z2 x3))

37

(let* ((t1 (mod (+ x1 z1) +curve448-p+))

38

(t2 (mod (- x1 z1) +curve448-p+))

39

(t3 (mod (- x2 z2) +curve448-p+))

40

(t4 (mod (* t1 t3) +curve448-p+))

41

(t5 (mod (+ x2 z2) +curve448-p+))

42

(t6 (mod (* t2 t5) +curve448-p+))

43

(t7 (mod (- t4 t6) +curve448-p+))

44

(t8 (mod (* t7 t7) +curve448-p+))

45

(z5 (mod (* x3 t8) +curve448-p+))

46

(t9 (mod (+ t4 t6) +curve448-p+))

47

(x5 (mod (* t9 t9) +curve448-p+))

48

(t10 (mod (* t1 t1) +curve448-p+))

49

(t11 (mod (* t2 t2) +curve448-p+))

50

(x4 (mod (* t10 t11) +curve448-p+))

51

(t12 (mod (- t10 t11) +curve448-p+))

52

(t13 (mod (* t12 +curve448-a24+) +curve448-p+))

53

(t14 (mod (+ t13 t10) +curve448-p+))

54

(z4 (mod (* t14 t12) +curve448-p+)))

55

(declare (type integer t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 x4 z4 x5 z5))

56

(values x4 z4 x5 z5)))

57

58

(defmethod ec-scalar-mult ((p curve448-point) n)

59

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

60

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

61

(type integer n))

62

(with-slots (x z) p

63

(declare (type integer x z))

64

(assert (= 1 z))

65

(do ((x1 1)

66

(z1 0)

67

(x2 x)

68

(z2 1)

69

(i 447 (1- i)))

70

((minusp i) (make-instance 'curve448-point :x x1 :z z1))

71

(declare (type integer x1 z1 x2 z2)

72

(type fixnum i))

73

(if (logbitp i n)

74

(multiple-value-setq (x2 z2 x1 z1)

75

(curve448-double-and-add x2 z2 x1 z1 x))

76

(multiple-value-setq (x1 z1 x2 z2)

77

(curve448-double-and-add x1 z1 x2 z2 x))))))

78

79

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

80

(unless x

81

(error 'missing-point-parameter

82

:kind 'curve448

83

:parameter 'x

84

:description "coordinate"))

85

(make-instance 'curve448-point :x x :z 1))

86

87

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

88

(with-slots (x z) p

89

(declare (type integer x z))

90

(let ((x (mod (* x (ec-scalar-inv :curve448 z)) +curve448-p+)))

91

(list :x x))))

92

93

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

94

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

95

96

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

97

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

98

(let ((x (ldb (byte +curve448-bits+ 0)

99

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

100

(setf (ldb (byte 2 0) x) 0)

101

(setf (ldb (byte 1 (1- +curve448-bits+)) x) 1)

102

x))

103

104

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

105

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

106

(x (getf coordinates :x)))

107

(ec-encode-scalar :curve448 x)))

108

109

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

110

(let ((x (ldb (byte +curve448-bits+ 0)

111

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

112

(ec-make-point :curve448 :x x)))

113

114

(defun curve448-public-key (sk)

115

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

116

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

117

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

118

(let* ((s (ec-decode-scalar :curve448 sk))

119

(p (ec-scalar-mult +curve448-g+ s)))

120

(ec-encode-point p)))

121

122

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

123

(unless y

124

(error 'missing-key-parameter

125

:kind 'curve448

126

:parameter 'y

127

:description "public key"))

128

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

129

130

(defmethod destructure-public-key ((public-key curve448-public-key))

131

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

132

133

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

134

(unless x

135

(error 'missing-key-parameter

136

:kind 'curve448

137

:parameter 'x

138

:description "private key"))

139

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

140

141

(defmethod destructure-private-key ((private-key curve448-private-key))

142

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

143

:y (curve448-key-y private-key)))

144

145

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

146

(let ((sk (random-data (ceiling +curve448-bits+ 8))))

147

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

148

(setf (ldb (byte 1 7) (elt sk (- (ceiling +curve448-bits+ 8) 1))) 1)

149

(let ((pk (curve448-public-key sk)))

150

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

151

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

152

153

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

154

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

155

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

156

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