Skip to content

Commit b5cbbf4

Browse files
authored
Merge pull request #4902 from unisonweb/ed25519-rkt
Add Ed25519 to racket crypto.rkt
2 parents 1583bb8 + c013809 commit b5cbbf4

File tree

1 file changed

+178
-27
lines changed

1 file changed

+178
-27
lines changed

scheme-libs/racket/unison/crypto.rkt

Lines changed: 178 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,11 @@
55
racket/runtime-path
66
(for-syntax racket/base)
77
openssl/libcrypto
8-
unison/chunked-seq)
8+
unison/chunked-seq
9+
racket/bool
10+
(only-in openssl/sha1 bytes->hex-string hex-string->bytes)
11+
12+
)
913

1014
(provide (prefix-out unison-FOp-crypto.
1115
(combine-out
@@ -19,7 +23,10 @@
1923
HashAlgorithm.Blake2b_256
2024
HashAlgorithm.Blake2b_512
2125
hashBytes
22-
hmacBytes)))
26+
hmacBytes
27+
Ed25519.sign.impl
28+
Ed25519.verify.impl
29+
)))
2330

2431
(define-runtime-path libb2-so '(so "libb2" ("1" #f)))
2532

@@ -68,7 +75,7 @@
6875
_int ; key-len
6976
_pointer ; input
7077
_int ; input-len
71-
_pointer ; md
78+
_pointer ; output pointer
7279
_pointer ; null
7380
-> _pointer ; unused
7481
))))
@@ -99,6 +106,134 @@
99106
(define HashAlgorithm.Blake2s_256 (lc-algo "EVP_blake2s256" 256))
100107
(define HashAlgorithm.Blake2b_512 (lc-algo "EVP_blake2b512" 512))
101108

109+
(define _EVP_PKEY-pointer (_cpointer 'EVP_PKEY))
110+
(define _EVP_MD_CTX-pointer (_cpointer 'EVP_MD_CTX))
111+
112+
(define EVP_MD_CTX_new
113+
(if (string? libcrypto)
114+
(lambda _ (raise (error 'libcrypto "EVP_MD_CTX_create\n~a" libcrypto)))
115+
(get-ffi-obj "EVP_MD_CTX_new" libcrypto
116+
(_fun -> _EVP_MD_CTX-pointer
117+
))))
118+
119+
; EVP_PKEY_new_raw_private_key(int type, NULL, const unsigned char *key, size_t keylen);
120+
(define EVP_PKEY_new_raw_private_key
121+
(if (string? libcrypto)
122+
(lambda _ (raise (error 'libcrypto "EVP_PKEY_new_raw_private_key\n~a" libcrypto)))
123+
(get-ffi-obj "EVP_PKEY_new_raw_private_key" libcrypto
124+
(_fun
125+
_int ; type
126+
_pointer ; engine (null)
127+
_pointer ; key
128+
_int ; key-len
129+
-> _EVP_PKEY-pointer
130+
))))
131+
132+
; EVP_DigestSignInit(hctx, NULL, EVP_sha256(), NULL, pkey)
133+
(define EVP_DigestSignInit
134+
(if (string? libcrypto)
135+
(lambda _ (raise (error 'libcrypto "EVP_DigestSignInit\n~a" libcrypto)))
136+
(get-ffi-obj "EVP_DigestSignInit" libcrypto
137+
(_fun
138+
_EVP_MD_CTX-pointer
139+
_pointer ; (null)
140+
_pointer ; (null)
141+
_pointer ; (null)
142+
_EVP_PKEY-pointer ; pkey
143+
-> _int
144+
))))
145+
146+
; EVP_DigestSign(hctx, output, output-len-ptr, input-data, input-data-len)
147+
(define EVP_DigestSign
148+
(if (string? libcrypto)
149+
(lambda _ (raise (error 'libcrypto "EVP_DigestSign\n~a" libcrypto)))
150+
(get-ffi-obj "EVP_DigestSign" libcrypto
151+
(_fun
152+
_EVP_MD_CTX-pointer
153+
_pointer ; output
154+
(_ptr o _int) ; output-len (null prolly)
155+
_pointer ; input-data
156+
_int ; input-data-len
157+
-> _int
158+
))))
159+
160+
; EVP_PKEY_new_raw_public_key(int type, NULL, const unsigned char *key, size_t keylen);
161+
(define EVP_PKEY_new_raw_public_key
162+
(if (string? libcrypto)
163+
(lambda _ (raise (error 'libcrypto "EVP_PKEY_new_raw_public_key\n~a" libcrypto)))
164+
(get-ffi-obj "EVP_PKEY_new_raw_public_key" libcrypto
165+
(_fun
166+
_int ; type
167+
_pointer ; engine (null)
168+
_pointer ; key
169+
_int ; key-len
170+
-> _EVP_PKEY-pointer
171+
))))
172+
173+
; int EVP_DigestVerifyInit(EVP_MD_CTX *ctx, EVP_PKEY_CTX **pctx,
174+
; const EVP_MD *type, ENGINE *e, EVP_PKEY *pkey);
175+
(define EVP_DigestVerifyInit
176+
(if (string? libcrypto)
177+
(lambda _ (raise (error 'libcrypto "EVP_DigestVerifyInit\n~a" libcrypto)))
178+
(get-ffi-obj "EVP_DigestVerifyInit" libcrypto
179+
(_fun
180+
_EVP_MD_CTX-pointer
181+
_pointer ; (null)
182+
_pointer ; (null)
183+
_pointer ; (null)
184+
_EVP_PKEY-pointer ; pkey
185+
-> _int
186+
))))
187+
188+
; int EVP_DigestVerify(EVP_MD_CTX *ctx, const unsigned char *sig,
189+
; size_t siglen, const unsigned char *tbs, size_t tbslen);
190+
(define EVP_DigestVerify
191+
(if (string? libcrypto)
192+
(lambda _ (raise (error 'libcrypto "EVP_DigestVerify\n~a" libcrypto)))
193+
(get-ffi-obj "EVP_DigestVerify" libcrypto
194+
(_fun
195+
_EVP_MD_CTX-pointer
196+
_pointer ; signature
197+
_int ; signature-len
198+
_pointer ; input-data
199+
_int ; input-data-len
200+
-> _int
201+
))))
202+
203+
204+
(define EVP_PKEY_ED25519 1087)
205+
(define (evpSign-raw seed input)
206+
(let* ([ctx (EVP_MD_CTX_new)]
207+
[pkey (EVP_PKEY_new_raw_private_key EVP_PKEY_ED25519 #f seed (bytes-length seed))])
208+
(if (false? pkey)
209+
(raise (error "Invalid seed provided."))
210+
(if (<= (EVP_DigestSignInit ctx #f #f #f pkey) 0)
211+
(raise (error "Initializing signing failed"))
212+
(let* ([output (make-bytes 64)])
213+
(if (<= (EVP_DigestSign ctx output input (bytes-length input)) 0)
214+
(raise (error "Running digest failed"))
215+
output))))))
216+
217+
(define (evpVerify-raw public-key input signature)
218+
(let* ([ctx (EVP_MD_CTX_new)]
219+
[pkey (EVP_PKEY_new_raw_public_key EVP_PKEY_ED25519 #f public-key (bytes-length public-key))])
220+
(if (false? pkey)
221+
(raise (error "Invalid seed provided."))
222+
(if (<= (EVP_DigestVerifyInit ctx #f #f #f pkey) 0)
223+
(raise (error "Initializing Verify failed"))
224+
(if (<= (EVP_DigestVerify ctx signature (bytes-length signature) input (bytes-length input)) 0)
225+
#f
226+
#t)))))
227+
228+
(define (Ed25519.sign.impl seed _ignored_pubkey input)
229+
(bytes->chunked-bytes (evpSign-raw (chunked-bytes->bytes seed) (chunked-bytes->bytes input))))
230+
231+
(define (Ed25519.verify.impl public-key input signature)
232+
(evpVerify-raw
233+
(chunked-bytes->bytes public-key)
234+
(chunked-bytes->bytes input)
235+
(chunked-bytes->bytes signature)))
236+
102237
; This one isn't provided by libcrypto, for some reason
103238
(define (HashAlgorithm.Blake2b_256) (cons 'blake2b 256))
104239

@@ -154,85 +289,101 @@
154289
(hashBytes-raw kind full)))
155290

156291
(define (hmacBytes kind key input)
157-
(let ([key (chunked-bytes->bytes key)]
158-
[input (chunked-bytes->bytes input)])
159-
(bytes->chunked-bytes
160-
(case (car kind)
161-
['blake2b (hmacBlake kind key input)]
162-
[else
163-
(let* ([bytes (/ (cdr kind) 8)]
164-
[output (make-bytes bytes)]
165-
[algo (car kind)])
166-
(HMAC algo key (bytes-length key) input (bytes-length input) output #f)
167-
output)]))))
292+
(bytes->chunked-bytes (hmacBytes-raw kind (chunked-bytes->bytes key) (chunked-bytes->bytes input))))
293+
294+
(define (hmacBytes-raw kind key input)
295+
(case (car kind)
296+
['blake2b (hmacBlake kind key input)]
297+
[else
298+
(let* ([bytes (/ (cdr kind) 8)]
299+
[output (make-bytes bytes)]
300+
[algo (car kind)])
301+
(HMAC algo key (bytes-length key) input (bytes-length input) output #f)
302+
output)]))
168303

169304

170305
; These will only be evaluated by `raco test`
171306
(module+ test
172307
(require rackunit
173308
(only-in openssl/sha1 bytes->hex-string hex-string->bytes))
174309

310+
(test-case "ed25519 sign"
311+
(check-equal?
312+
(bytes->hex-string
313+
(evpSign-raw
314+
(hex-string->bytes "0000000000000000000000000000000000000000000000000000000000000000") #""))
315+
"8f895b3cafe2c9506039d0e2a66382568004674fe8d237785092e40d6aaf483e4fc60168705f31f101596138ce21aa357c0d32a064f423dc3ee4aa3abf53f803"))
316+
317+
(test-case "ed25519 verify"
318+
(check-equal?
319+
(evpVerify-raw
320+
(hex-string->bytes "3b6a27bcceb6a42d62a3a8d02a6f0d73653215771de243a63ac048a18b59da29")
321+
#""
322+
(hex-string->bytes "8f895b3cafe2c9506039d0e2a66382568004674fe8d237785092e40d6aaf483e4fc60168705f31f101596138ce21aa357c0d32a064f423dc3ee4aa3abf53f803")
323+
)
324+
#t))
325+
175326
(test-case "sha1 hmac"
176327
(check-equal?
177-
(bytes->hex-string (hmacBytes (HashAlgorithm.Sha1) #"key" #"message"))
328+
(bytes->hex-string (hmacBytes-raw (HashAlgorithm.Sha1) #"key" #"message"))
178329
"2088df74d5f2146b48146caf4965377e9d0be3a4"))
179330

180331
(test-case "blake2b-256 hmac"
181332
(check-equal?
182-
(bytes->hex-string (hmacBytes (HashAlgorithm.Blake2b_256) #"key" #"message"))
333+
(bytes->hex-string (hmacBytes-raw (HashAlgorithm.Blake2b_256) #"key" #"message"))
183334
"442d98a3872d3f56220f89e2b23d0645610b37c33dd3315ef224d0e39ada6751"))
184335

185336
(test-case "blake2b-512 hmac"
186337
(check-equal?
187-
(bytes->hex-string (hmacBytes (HashAlgorithm.Blake2b_512) #"key" #"message"))
338+
(bytes->hex-string (hmacBytes-raw (HashAlgorithm.Blake2b_512) #"key" #"message"))
188339
"04e9ada930688cde75eec939782eed653073dd621d7643f813702976257cf037d325b50eedd417c01b6ad1f978fbe2980a93d27d854044e8626df6fa279d6680"))
189340

190341
(test-case "blake2s-256 hmac"
191342
(check-equal?
192-
(bytes->hex-string (hmacBytes (HashAlgorithm.Blake2s_256) #"key" #"message"))
343+
(bytes->hex-string (hmacBytes-raw (HashAlgorithm.Blake2s_256) #"key" #"message"))
193344
"bba8fa28708ae80d249e317318c95c859f3f77512be23910d5094d9110454d6f"))
194345

195346
(test-case "md5 basic"
196347
(check-equal?
197-
(bytes->hex-string (hashBytes (HashAlgorithm.Md5) #""))
348+
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Md5) #""))
198349
"d41d8cd98f00b204e9800998ecf8427e"))
199350

200351
(test-case "sha1 basic"
201352
(check-equal?
202-
(bytes->hex-string (hashBytes (HashAlgorithm.Sha1) #""))
353+
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha1) #""))
203354
"da39a3ee5e6b4b0d3255bfef95601890afd80709"))
204355

205356
(test-case "sha2-256 basic"
206357
(check-equal?
207-
(bytes->hex-string (hashBytes (HashAlgorithm.Sha2_256) #""))
358+
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha2_256) #""))
208359
"e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"))
209360

210361
(test-case "sha2-512 basic"
211362
(check-equal?
212-
(bytes->hex-string (hashBytes (HashAlgorithm.Sha2_512) #""))
363+
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha2_512) #""))
213364
"cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e"))
214365

215366
(test-case "sha3-256 basic"
216367
(check-equal?
217-
(bytes->hex-string (hashBytes (HashAlgorithm.Sha3_256) #""))
368+
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha3_256) #""))
218369
"a7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80a4b80f8434a"))
219370

220371
(test-case "sha3-512 basic"
221372
(check-equal?
222-
(bytes->hex-string (hashBytes (HashAlgorithm.Sha3_512) #""))
373+
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha3_512) #""))
223374
"a69f73cca23a9ac5c8b567dc185a756e97c982164fe25859e0d1dcc1475c80a615b2123af1f5f94c11e3e9402c3ac558f500199d95b6d3e301758586281dcd26"))
224375

225376
(test-case "blake2s_256 basic"
226377
(check-equal?
227-
(bytes->hex-string (hashBytes (HashAlgorithm.Blake2s_256) #""))
378+
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Blake2s_256) #""))
228379
"69217a3079908094e11121d042354a7c1f55b6482ca1a51e1b250dfd1ed0eef9"))
229380

230381
(test-case "blake2b_256 basic"
231382
(check-equal?
232-
(bytes->hex-string (hashBytes (HashAlgorithm.Blake2b_256) #""))
383+
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Blake2b_256) #""))
233384
"0e5751c026e543b2e8ab2eb06099daa1d1e5df47778f7787faab45cdf12fe3a8"))
234385

235386
(test-case "blake2b_512 basic"
236387
(check-equal?
237-
(bytes->hex-string (hashBytes (HashAlgorithm.Blake2b_512) #""))
388+
(bytes->hex-string (hashBytes-raw (HashAlgorithm.Blake2b_512) #""))
238389
"786a02f742015903c6c6fd852552d272912f4740e15847618a86e217f71f5419d25e1031afee585313896444934eb04b903a685b1448b755d56f701afe9be2ce")))

0 commit comments

Comments
 (0)