test/test-ed25519.sgl — sigil-crypto

1;;; Ed25519 (RFC 8032) and BLAKE2b-512 in (sigil crypto).

2;;;

3;;; The bulk vector sets (RFC 8032, Wycheproof, ed25519-speccheck) are in

4;;; test-ed25519-vectors.sgl. This file holds the RFC 8032 key derivation and

5;;; signing checks, the negative cases built from a valid signature with one

6;;; controlled change, and BLAKE2b-512.

8(import (sigil test)

9 (sigil crypto)

10 (sigil math))

12(define (hex->bv s)

13 (let* ((n (quotient (string-length s) 2))

14 (bv (make-bytevector n 0)))

15 (let loop ((i 0))

16 (if (< i n)

17 (begin

18 (bytevector-u8-set! bv i (string->number (substring s (* 2 i) (+ 2 (* 2 i))) 16))

19 (loop (+ i 1)))

20 bv))))

22(define (bv->hex bv)

23 (let loop ((i 0) (acc '()))

24 (if (< i (bytevector-length bv))

25 (let* ((b (bytevector-u8-ref bv i))

26 (h (number->string b 16)))

27 (loop (+ i 1) (cons (if (< b 16) (string-append "0" h) h) acc)))

28 (apply string-append (reverse acc)))))

30;; A copy of bv with bit `bit` of byte `index` flipped.

31(define (flip-bit bv index bit)

32 (let ((out (bytevector-copy bv)))

33 (bytevector-u8-set! out index

34 (bitwise-xor (bytevector-u8-ref out index)

35 (arithmetic-shift 1 bit)))

36 out))

38;; RFC 8032 section 7.1, TEST 1 to TEST 3.

39(define t1-seed (hex->bv "9d61b19deffd5a60ba844af492ec2cc44449c5697b326919703bac031cae7f60"))

40(define t1-pk (hex->bv "d75a980182b10ab7d54bfed3c964073a0ee172f3daa62325af021a68f707511a"))

41(define t1-msg (make-bytevector 0 0))

(define t1-sig (hex->bv "e5564300c360ac729086e2cc806e828a84877f1eb8e5d974d873e065224901555fb8821590a33bacc61e39701cf9b46bd25bf5f0595bbe24655141438e7a100b"))

44(define t2-seed (hex->bv "4ccd089b28ff96da9db6c346ec114e0f5b8a319f35aba624da8cf6ed4fb8a6fb"))

45(define t2-pk (hex->bv "3d4017c3e843895a92b70aa74d1b7ebc9c982ccf2ec4968cc0cd55f12af4660c"))

46(define t2-msg (hex->bv "72"))

(define t2-sig (hex->bv "92a009a9f0d4cab8720e820b5f642540a2b27b5416503f8fb3762223ebdb69da085ac1e43e15996e458f3613d0f11d8c387b2eaeb4302aeeb00d291612bb0c00"))

49(define t3-seed (hex->bv "c5aa8df43f9f837bedb7442f31dcb7b166d38535076f094b85ce3a2e0b4458f7"))

50(define t3-pk (hex->bv "fc51cd8e6218a1a38da47ed00230f0580816ed13ba3303ac5deb911548908025"))

51(define t3-msg (hex->bv "af82"))

(define t3-sig (hex->bv "6291d657deec24024827e69c3abe01a30ce548a284743a445e3680d7db5ac3ac18ff9b538d16f290ae67f760984dc6594a7c15e9716ed28dc027beceea1ec40a"))

54;; TEST 1's signature with S replaced by S + L (L = 2^252 +

55;; 27742317777372353535851937790883648493, the group order), computed with

56;; Python integers. [S + L]B = [S]B, so this satisfies the verification

57;; equation; only the S < L range check can reject it.

58(define t1-sig-s-plus-l

59 (hex->bv (string-append

60 "e5564300c360ac729086e2cc806e828a84877f1eb8e5d974d873e06522490155"

61 "4c8c7872aa064e049dbb3013fbf29380d25bf5f0595bbe24655141438e7a101b")))

63(test-group "ed25519 RFC 8032 derivation and signing"

64 (test "TEST 1 public key from seed"

65 (assert-equal (bv->hex t1-pk) (bv->hex (ed25519-public-key t1-seed))))

66 (test "TEST 2 public key from seed"

67 (assert-equal (bv->hex t2-pk) (bv->hex (ed25519-public-key t2-seed))))

68 (test "TEST 3 public key from seed"

69 (assert-equal (bv->hex t3-pk) (bv->hex (ed25519-public-key t3-seed))))

70 (test "TEST 1 signature is the RFC's"

71 (assert-equal (bv->hex t1-sig) (bv->hex (ed25519-sign t1-seed t1-msg))))

72 (test "TEST 2 signature is the RFC's"

73 (assert-equal (bv->hex t2-sig) (bv->hex (ed25519-sign t2-seed t2-msg))))

74 (test "TEST 3 signature is the RFC's"

75 (assert-equal (bv->hex t3-sig) (bv->hex (ed25519-sign t3-seed t3-msg))))

76 (test "the seed bytevector is not wiped by derivation or signing"

77 (let ((seed (bytevector-copy t2-seed)))

78 (ed25519-public-key seed)

79 (ed25519-sign seed "x")

80 (assert-equal (bv->hex t2-seed) (bv->hex seed))))

81 (test "a string message signs its UTF-8 bytes"

82 (assert-equal (bv->hex (ed25519-sign t2-seed (bytevector 104 105)))

83 (bv->hex (ed25519-sign t2-seed "hi")))))

85(test-group "ed25519 verify: controls"

86 (test "TEST 1 verifies"

87 (assert-eq #t (ed25519-verify t1-pk t1-msg t1-sig)))

88 (test "TEST 2 verifies"

89 (assert-eq #t (ed25519-verify t2-pk t2-msg t2-sig)))

90 (test "TEST 3 verifies"

91 (assert-eq #t (ed25519-verify t3-pk t3-msg t3-sig)))

92 (test "a sign/verify round trip with a string message"

93 (let ((sig (ed25519-sign t3-seed "round trip")))

94 (assert-eq #t (ed25519-verify t3-pk "round trip" sig)))))

96;; Each negative below changes ONE input of a signature the control group

97;; shows verifying, so the change is the only possible cause of the #f.

98(test-group "ed25519 verify: negatives"

99 (test "every single-bit flip of TEST 2's message fails"

100 (let loop ((bit 0))

101 (when (< bit 8)

102 (assert-eq #f (ed25519-verify t2-pk (flip-bit t2-msg 0 bit) t2-sig))

103 (loop (+ bit 1)))))

104 (test "a flipped bit in each byte of TEST 3's signature fails"

105 (let loop ((i 0))

106 (when (< i 64)

107 (assert-eq #f (ed25519-verify t3-pk t3-msg (flip-bit t3-sig i (modulo i 8))))

108 (loop (+ i 1)))))

109 (test "a flipped bit in each byte of TEST 3's public key fails"

110 (let loop ((i 0))

111 (when (< i 32)

112 (assert-eq #f (ed25519-verify (flip-bit t3-pk i (modulo i 8)) t3-msg t3-sig))

113 (loop (+ i 1)))))

114 (test "a signature under another key fails"

115 (assert-eq #f (ed25519-verify t2-pk t3-msg t3-sig)))

116 (test "an extra trailing message byte fails"

117 (assert-eq #f (ed25519-verify t3-pk (hex->bv "af8200") t3-sig)))

118 (test "S + L (non-canonical S) fails although the equation holds"

119 (assert-eq #f (ed25519-verify t1-pk t1-msg t1-sig-s-plus-l)))

120 (test "the all-zero signature fails"

121 (assert-eq #f (ed25519-verify t1-pk t1-msg (make-bytevector 64 0))))

122 (test "the identity public key fails for any signature"

123 ;; Identity (order 1) as A: [8](sB - hA - R) = [8](sB - R), so a

124 ;; cofactored check alone would accept R = [s]B for any message.

125 ;; With R = B (the base point) and S = 1: [8]([1]B - h*O - B) = O for

126 ;; every message, so only the small-order check on A can reject it.

127 (let* ((identity (let ((b (make-bytevector 32 0))) (bytevector-u8-set! b 0 1) b))

128 (base-point (hex->bv "5866666666666666666666666666666666666666666666666666666666666666"))

129 (one (let ((b (make-bytevector 32 0))) (bytevector-u8-set! b 0 1) b))

130 (forged (bytevector-append base-point one)))

131 (assert-eq #f (ed25519-verify identity "anything" forged))

132 (assert-eq #f (ed25519-verify identity "anything else" forged)))))

133

134;; The second shape of the documented divergence from libsodium, crafted by

135;; the adversarial review (independent Python curve arithmetic): an honest

136;; key from seed 00..1f, and R = rB + T8 with T8 of order 8. Cofactored

137;; verification accepts it; libsodium's cofactorless check rejects it

138;; (test/differential/run.sh pins that). Only the key holder can make one.

139(test-group "ed25519 verify: documented cofactored acceptance"

140 (test "the crafted key is the honest key for its seed"

141 (let ((seed (let ((b (make-bytevector 32 0)))

142 (let loop ((i 0))

143 (if (< i 32) (begin (bytevector-u8-set! b i i) (loop (+ i 1))) b)))))

144 (assert-equal "03a107bff3ce10be1d70dd18e74bc09967e4d6309ba50d5f1ddc8664125531b8"

145 (bv->hex (ed25519-public-key seed)))))

146 (test "a mixed-order R under that key is accepted"

147 (assert-eq #t (ed25519-verify

148 (hex->bv "03a107bff3ce10be1d70dd18e74bc09967e4d6309ba50d5f1ddc8664125531b8")

149 (hex->bv "6d697865642d6f7264657220522c20686f6e657374206b6579")

150

                    (hex->bv "12b8d902558f234e020abb7be4e3bd2c2f1e847c3e49560413512eecab8f131ec05dc8d713151494f13f8bace8263ae68b6e564f07764b39bd1f9d25b1bf6f08")))))

151

152(test-group "ed25519 verify: argument checking"

153 (test "a 31-byte public key raises"

154 (assert-error (ed25519-verify (make-bytevector 31 0) "m" t1-sig)))

155 (test "a 65-byte signature raises"

156 (assert-error (ed25519-verify t1-pk "m" (make-bytevector 65 0))))

157 (test "a string public key raises"

158 (assert-error (ed25519-verify "not a key" "m" t1-sig)))

159 (test "a 16-byte seed raises"

160 (assert-error (ed25519-sign (make-bytevector 16 0) "m"))))

161

162(test-group "blake2b-512"

163 (test "RFC 7693 appendix A: abc"

164

    (assert-equal "ba80a53f981c4d0d6a2797b69f12f6e94c212f14685ac4b74b12bb6fdbffa2d17d87c5392aab792dc252d5de4533cc9518d38aa8dbf1925ab92386edd4009923"

165 (bv->hex (blake2b-512 "abc"))))

166 (test "empty input (coreutils b2sum)"

167

    (assert-equal "786a02f742015903c6c6fd852552d272912f4740e15847618a86e217f71f5419d25e1031afee585313896444934eb04b903a685b1448b755d56f701afe9be2ce"

168 (bv->hex (blake2b-512 (make-bytevector 0 0)))))

169 (test "1000 x 'a', more than one 128-byte block (coreutils b2sum)"

170

    (assert-equal "d6a69459fe93fc6b9537ed4336e5099e0dcca3e97290a412500ed7a0daffb03d80cf3650a20e0591f748e10c3c534945ee83d5f2c9722f1a68d98b8c01af23fd"

171 (bv->hex (blake2b-512 (make-bytevector 1000 97)))))

172 (test "string and bytevector input agree"

173 (assert-equal (bv->hex (blake2b-512 "abc"))

174 (bv->hex (blake2b-512 (bytevector 97 98 99))))))