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

Kind	Covered	All	%
expression	0	282	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

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

2

(in-package :crypto)

3

4

;;; class definitions

5

(defclass curve25519-public-key ()

6

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

7

8

(defclass curve25519-private-key ()

9

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

10

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

11

12

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

13

(defclass curve25519-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 curve25519-point) &optional env)

19

(declare (ignore env))

20

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

21

22

;;; constants and function definitions

23

(defconstant +curve25519-bits+ 256)

24

(defconstant +curve25519-p+ 57896044618658097711785492504343953926634992332820282019728792003956564819949)

25

(defconstant +curve25519-a24+ 121666)

26

27

(defconst +curve25519-g+

28

(make-instance 'curve25519-point :x 9 :z 1))

29

30

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

31

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

32

33

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

34

"Point doubling and addition on curve25519 curve."

35

(declare (type integer x1 z1 x2 z2 x3)

36

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

37

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

38

(t2 (mod (* t1 t1) +curve25519-p+))

39

(t3 (mod (- x1 z1) +curve25519-p+))

40

(t4 (mod (* t3 t3) +curve25519-p+))

41

(t5 (mod (- t2 t4) +curve25519-p+))

42

(t6 (mod (+ x2 z2) +curve25519-p+))

43

(t7 (mod (- x2 z2) +curve25519-p+))

44

(t8 (mod (* t1 t7) +curve25519-p+))

45

(t9 (mod (* t3 t6) +curve25519-p+))

46

(t10 (mod (+ t8 t9) +curve25519-p+))

47

(t11 (mod (- t8 t9) +curve25519-p+))

48

(x4 (mod (* t2 t4) +curve25519-p+))

49

(t12 (mod (* t5 +curve25519-a24+) +curve25519-p+))

50

(t13 (mod (+ t4 t12) +curve25519-p+))

51

(z4 (mod (* t5 t13) +curve25519-p+))

52

(x5 (mod (* t10 t10) +curve25519-p+))

53

(t14 (mod (* t11 t11) +curve25519-p+))

54

(z5 (mod (* x3 t14) +curve25519-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 curve25519-point) n)

59

;; Point multiplication on curve22519 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 254 (1- i)))

70

((minusp i) (make-instance 'curve25519-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

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

76

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

77

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

78

79

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

80

(unless x

81

(error 'missing-point-parameter

82

:kind 'curve25519

83

:parameter 'x

84

:description "coordinate"))

85

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

86

87

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

88

(with-slots (x z) p

89

(declare (type integer x z))

90

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

91

(list :x x))))

92

93

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

94

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

95

96

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

97

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

98

(let ((x (ldb (byte (1- +curve25519-bits+) 0)

99

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

100

(setf (ldb (byte 3 0) x) 0)

101

(setf (ldb (byte 1 (- +curve25519-bits+ 2)) x) 1)

102

x))

103

104

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

105

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

106

(x (getf coordinates :x)))

107

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

108

109

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

110

(let ((x (ldb (byte (1- +curve25519-bits+) 0)

111

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

112

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

113

114

(defun curve25519-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 :curve25519 sk))

119

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

120

(ec-encode-point p)))

121

122

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

123

(unless y

124

(error 'missing-key-parameter

125

:kind 'curve25519

126

:parameter 'y

127

:description "public key"))

128

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

129

130

(defmethod destructure-public-key ((public-key curve25519-public-key))

131

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

132

133

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

134

(unless x

135

(error 'missing-key-parameter

136

:kind 'curve25519

137

:parameter 'x

138

:description "private key"))

139

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

140

141

(defmethod destructure-private-key ((private-key curve25519-private-key))

142

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

143

:y (curve25519-key-y private-key)))

144

145

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

146

(let ((sk (random-data (/ +curve25519-bits+ 8))))

147

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

148

(setf (ldb (byte 2 6) (elt sk (- (/ +curve25519-bits+ 8) 1))) 1)

149

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

150

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

151

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

152

153

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

154

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

155

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

156

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