|
5 | 5 | racket/runtime-path |
6 | 6 | (for-syntax racket/base) |
7 | 7 | 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 | + ) |
9 | 13 |
|
10 | 14 | (provide (prefix-out unison-FOp-crypto. |
11 | 15 | (combine-out |
|
19 | 23 | HashAlgorithm.Blake2b_256 |
20 | 24 | HashAlgorithm.Blake2b_512 |
21 | 25 | hashBytes |
22 | | - hmacBytes))) |
| 26 | + hmacBytes |
| 27 | + Ed25519.sign.impl |
| 28 | + Ed25519.verify.impl |
| 29 | + ))) |
23 | 30 |
|
24 | 31 | (define-runtime-path libb2-so '(so "libb2" ("1" #f))) |
25 | 32 |
|
|
68 | 75 | _int ; key-len |
69 | 76 | _pointer ; input |
70 | 77 | _int ; input-len |
71 | | - _pointer ; md |
| 78 | + _pointer ; output pointer |
72 | 79 | _pointer ; null |
73 | 80 | -> _pointer ; unused |
74 | 81 | )))) |
|
99 | 106 | (define HashAlgorithm.Blake2s_256 (lc-algo "EVP_blake2s256" 256)) |
100 | 107 | (define HashAlgorithm.Blake2b_512 (lc-algo "EVP_blake2b512" 512)) |
101 | 108 |
|
| 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 | + |
102 | 237 | ; This one isn't provided by libcrypto, for some reason |
103 | 238 | (define (HashAlgorithm.Blake2b_256) (cons 'blake2b 256)) |
104 | 239 |
|
|
154 | 289 | (hashBytes-raw kind full))) |
155 | 290 |
|
156 | 291 | (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)])) |
168 | 303 |
|
169 | 304 |
|
170 | 305 | ; These will only be evaluated by `raco test` |
171 | 306 | (module+ test |
172 | 307 | (require rackunit |
173 | 308 | (only-in openssl/sha1 bytes->hex-string hex-string->bytes)) |
174 | 309 |
|
| 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 | + |
175 | 326 | (test-case "sha1 hmac" |
176 | 327 | (check-equal? |
177 | | - (bytes->hex-string (hmacBytes (HashAlgorithm.Sha1) #"key" #"message")) |
| 328 | + (bytes->hex-string (hmacBytes-raw (HashAlgorithm.Sha1) #"key" #"message")) |
178 | 329 | "2088df74d5f2146b48146caf4965377e9d0be3a4")) |
179 | 330 |
|
180 | 331 | (test-case "blake2b-256 hmac" |
181 | 332 | (check-equal? |
182 | | - (bytes->hex-string (hmacBytes (HashAlgorithm.Blake2b_256) #"key" #"message")) |
| 333 | + (bytes->hex-string (hmacBytes-raw (HashAlgorithm.Blake2b_256) #"key" #"message")) |
183 | 334 | "442d98a3872d3f56220f89e2b23d0645610b37c33dd3315ef224d0e39ada6751")) |
184 | 335 |
|
185 | 336 | (test-case "blake2b-512 hmac" |
186 | 337 | (check-equal? |
187 | | - (bytes->hex-string (hmacBytes (HashAlgorithm.Blake2b_512) #"key" #"message")) |
| 338 | + (bytes->hex-string (hmacBytes-raw (HashAlgorithm.Blake2b_512) #"key" #"message")) |
188 | 339 | "04e9ada930688cde75eec939782eed653073dd621d7643f813702976257cf037d325b50eedd417c01b6ad1f978fbe2980a93d27d854044e8626df6fa279d6680")) |
189 | 340 |
|
190 | 341 | (test-case "blake2s-256 hmac" |
191 | 342 | (check-equal? |
192 | | - (bytes->hex-string (hmacBytes (HashAlgorithm.Blake2s_256) #"key" #"message")) |
| 343 | + (bytes->hex-string (hmacBytes-raw (HashAlgorithm.Blake2s_256) #"key" #"message")) |
193 | 344 | "bba8fa28708ae80d249e317318c95c859f3f77512be23910d5094d9110454d6f")) |
194 | 345 |
|
195 | 346 | (test-case "md5 basic" |
196 | 347 | (check-equal? |
197 | | - (bytes->hex-string (hashBytes (HashAlgorithm.Md5) #"")) |
| 348 | + (bytes->hex-string (hashBytes-raw (HashAlgorithm.Md5) #"")) |
198 | 349 | "d41d8cd98f00b204e9800998ecf8427e")) |
199 | 350 |
|
200 | 351 | (test-case "sha1 basic" |
201 | 352 | (check-equal? |
202 | | - (bytes->hex-string (hashBytes (HashAlgorithm.Sha1) #"")) |
| 353 | + (bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha1) #"")) |
203 | 354 | "da39a3ee5e6b4b0d3255bfef95601890afd80709")) |
204 | 355 |
|
205 | 356 | (test-case "sha2-256 basic" |
206 | 357 | (check-equal? |
207 | | - (bytes->hex-string (hashBytes (HashAlgorithm.Sha2_256) #"")) |
| 358 | + (bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha2_256) #"")) |
208 | 359 | "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855")) |
209 | 360 |
|
210 | 361 | (test-case "sha2-512 basic" |
211 | 362 | (check-equal? |
212 | | - (bytes->hex-string (hashBytes (HashAlgorithm.Sha2_512) #"")) |
| 363 | + (bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha2_512) #"")) |
213 | 364 | "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e")) |
214 | 365 |
|
215 | 366 | (test-case "sha3-256 basic" |
216 | 367 | (check-equal? |
217 | | - (bytes->hex-string (hashBytes (HashAlgorithm.Sha3_256) #"")) |
| 368 | + (bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha3_256) #"")) |
218 | 369 | "a7ffc6f8bf1ed76651c14756a061d662f580ff4de43b49fa82d80a4b80f8434a")) |
219 | 370 |
|
220 | 371 | (test-case "sha3-512 basic" |
221 | 372 | (check-equal? |
222 | | - (bytes->hex-string (hashBytes (HashAlgorithm.Sha3_512) #"")) |
| 373 | + (bytes->hex-string (hashBytes-raw (HashAlgorithm.Sha3_512) #"")) |
223 | 374 | "a69f73cca23a9ac5c8b567dc185a756e97c982164fe25859e0d1dcc1475c80a615b2123af1f5f94c11e3e9402c3ac558f500199d95b6d3e301758586281dcd26")) |
224 | 375 |
|
225 | 376 | (test-case "blake2s_256 basic" |
226 | 377 | (check-equal? |
227 | | - (bytes->hex-string (hashBytes (HashAlgorithm.Blake2s_256) #"")) |
| 378 | + (bytes->hex-string (hashBytes-raw (HashAlgorithm.Blake2s_256) #"")) |
228 | 379 | "69217a3079908094e11121d042354a7c1f55b6482ca1a51e1b250dfd1ed0eef9")) |
229 | 380 |
|
230 | 381 | (test-case "blake2b_256 basic" |
231 | 382 | (check-equal? |
232 | | - (bytes->hex-string (hashBytes (HashAlgorithm.Blake2b_256) #"")) |
| 383 | + (bytes->hex-string (hashBytes-raw (HashAlgorithm.Blake2b_256) #"")) |
233 | 384 | "0e5751c026e543b2e8ab2eb06099daa1d1e5df47778f7787faab45cdf12fe3a8")) |
234 | 385 |
|
235 | 386 | (test-case "blake2b_512 basic" |
236 | 387 | (check-equal? |
237 | | - (bytes->hex-string (hashBytes (HashAlgorithm.Blake2b_512) #"")) |
| 388 | + (bytes->hex-string (hashBytes-raw (HashAlgorithm.Blake2b_512) #"")) |
238 | 389 | "786a02f742015903c6c6fd852552d272912f4740e15847618a86e217f71f5419d25e1031afee585313896444934eb04b903a685b1448b755d56f701afe9be2ce"))) |
0 commit comments