diff --git a/scheme-libs/racket/unison/crypto.rkt b/scheme-libs/racket/unison/crypto.rkt index 4d25dc3d9b..b356d6b609 100644 --- a/scheme-libs/racket/unison/crypto.rkt +++ b/scheme-libs/racket/unison/crypto.rkt @@ -3,6 +3,7 @@ ffi/unsafe/define racket/exn racket/runtime-path + (only-in unison/data-info ref-either-left ref-either-right) (for-syntax racket/base) openssl/libcrypto unison/chunked-seq @@ -23,10 +24,12 @@ HashAlgorithm.Blake2b_256 HashAlgorithm.Blake2b_512 hashBytes - hmacBytes - Ed25519.sign.impl - Ed25519.verify.impl - ))) + hmacBytes)) + (prefix-out builtin-crypto. + (combine-out + Ed25519.sign.impl + Ed25519.verify.impl)) + ) (define-runtime-path libb2-so '(so "libb2" ("1" #f))) @@ -50,6 +53,14 @@ (unless (= 1 v) (error who "failed with return value ~a" v))) +(define ERR_get_error (if (string? libcrypto) + (lambda _ (raise (error 'libcrypto "ERR_get_error\n~a" libcrypto))) + (get-ffi-obj "ERR_get_error" libcrypto (_fun -> _long)))) +(define ERR_error_string_n (if (string? libcrypto) + (lambda _ (raise (error 'libcrypto "ERR_error_string_n\n~a" libcrypto))) + (get-ffi-obj "ERR_error_string_n" libcrypto + (_fun _long _bytes _long -> _void)))) + (define EVP_Digest (if (string? libcrypto) (lambda _ (raise (error 'libcrypto "EVP_Digest\n~a" libcrypto))) @@ -200,39 +211,46 @@ -> _int )))) +(define (get-error-message id) + (let* ([buffer (make-bytes 512)]) + (ERR_error_string_n id buffer (bytes-length buffer)) + (bytes->string/utf-8 buffer))) + +(define (libcrypto-error message) + (error (string-append message (get-error-message (ERR_get_error))))) (define EVP_PKEY_ED25519 1087) (define (evpSign-raw seed input) (let* ([ctx (EVP_MD_CTX_new)] [pkey (EVP_PKEY_new_raw_private_key EVP_PKEY_ED25519 #f seed (bytes-length seed))]) (if (false? pkey) - (raise (error "Invalid seed provided.")) + (raise (libcrypto-error "Invalid seed provided. ")) (if (<= (EVP_DigestSignInit ctx #f #f #f pkey) 0) - (raise (error "Initializing signing failed")) + (raise (libcrypto-error "Initializing signing failed. ")) (let* ([output (make-bytes 64)]) (if (<= (EVP_DigestSign ctx output input (bytes-length input)) 0) - (raise (error "Running digest failed")) + (raise (libcrypto-error "Running digest failed. ")) output)))))) (define (evpVerify-raw public-key input signature) (let* ([ctx (EVP_MD_CTX_new)] [pkey (EVP_PKEY_new_raw_public_key EVP_PKEY_ED25519 #f public-key (bytes-length public-key))]) (if (false? pkey) - (raise (error "Invalid seed provided.")) + (raise (libcrypto-error "Invalid seed provided. ")) (if (<= (EVP_DigestVerifyInit ctx #f #f #f pkey) 0) - (raise (error "Initializing Verify failed")) + (raise (libcrypto-error "Initializing Verify failed. ")) (if (<= (EVP_DigestVerify ctx signature (bytes-length signature) input (bytes-length input)) 0) #f #t))))) (define (Ed25519.sign.impl seed _ignored_pubkey input) - (bytes->chunked-bytes (evpSign-raw (chunked-bytes->bytes seed) (chunked-bytes->bytes input)))) + (ref-either-right (bytes->chunked-bytes (evpSign-raw (chunked-bytes->bytes seed) (chunked-bytes->bytes input))))) (define (Ed25519.verify.impl public-key input signature) - (evpVerify-raw + (ref-either-right (evpVerify-raw (chunked-bytes->bytes public-key) (chunked-bytes->bytes input) - (chunked-bytes->bytes signature))) + (chunked-bytes->bytes signature)))) ; This one isn't provided by libcrypto, for some reason (define (HashAlgorithm.Blake2b_256) (cons 'blake2b 256)) diff --git a/scheme-libs/racket/unison/primops.ss b/scheme-libs/racket/unison/primops.ss index 745f3be605..d26ba150c3 100644 --- a/scheme-libs/racket/unison/primops.ss +++ b/scheme-libs/racket/unison/primops.ss @@ -547,6 +547,8 @@ unison-FOp-crypto.HashAlgorithm.Blake2s_256 unison-FOp-crypto.HashAlgorithm.Blake2b_256 unison-FOp-crypto.HashAlgorithm.Blake2b_512 + builtin-crypto.Ed25519.sign.impl + builtin-crypto.Ed25519.verify.impl unison-FOp-IO.clientSocket.impl.v3 unison-FOp-IO.closeSocket.impl.v3 @@ -1388,7 +1390,7 @@ (exception->string e) ref-unit-unit))]) (thunk ref-unit-unit))) - + (declare-builtin-link builtin-Float.*) (declare-builtin-link builtin-Float.fromRepresentation) (declare-builtin-link builtin-Float.toRepresentation)