typed→rust: crypto-prim kind — FFI to vetted RustCrypto crates
ober
d2dd7f7de82d3e1bc2f3056e912cb59167facc07
--- a/lib/jerboa/typed/checker.ss +++ b/lib/jerboa/typed/checker.ss @@ -376,7 +376,20 @@ ;; callers cast integers up with exact->inexact first. (cons 'log2 (make-typed-call-sig (list 'Float) 'Float '() - 'log2 '())))) + 'log2 '())) + ;; crypto primitives — FFI to vetted RustCrypto crates, never reimplemented. + ;; Each carries kind 'crypto-prim and an info `prim` the emitter dispatches + ;; on; the Rust block they emit references the crate (sha2/hmac/hkdf) that + ;; typed-rust.ss scans to populate Cargo.toml. + (cons 'sha256 + (make-typed-call-sig (list 'Bytes) 'Bytes '() + 'crypto-prim (list (cons 'prim 'sha256)))) + (cons 'hmac-sha256 + (make-typed-call-sig (list 'Bytes 'Bytes) 'Bytes '() + 'crypto-prim (list (cons 'prim 'hmac-sha256)))) + (cons 'hkdf-sha256 + (make-typed-call-sig (list 'Bytes 'Bytes 'Bytes 'Nat) 'Bytes '() + 'crypto-prim (list (cons 'prim 'hkdf-sha256)))))) (def (field-types fields) (map typed-field-type fields)) --- a/lib/jerboa/typed/core.ss +++ b/lib/jerboa/typed/core.ss @@ -138,7 +138,8 @@ option-some option-none result-ok - result-err)) + result-err + crypto-prim)) ;; --- generic accessors --------------------------------------------------- --- a/lib/jerboa/typed/rust.ss +++ b/lib/jerboa/typed/rust.ss @@ -1346,6 +1346,67 @@ (emit-expression (car args)) ")).into_owned()")) + ;; --- crypto primitives (FFI to vetted RustCrypto crates) ----------------- + ;; + ;; Each crypto primitive emits a self-contained block expression that calls a + ;; vetted crate (sha2/hmac/hkdf/aes-gcm/x25519-dalek) — we never reimplement a + ;; cipher or hash. All byte operands are Bytes (Vec<u8>); we pass them as + ;; slices with `&(EXPR)[..]`, which both borrows (no move under the Clone-heavy + ;; ownership model) and coerces a &Vec<u8> to the &[u8] these APIs want. The + ;; crate token in each block (e.g. `sha2::`) is what typed-rust.ss scans to + ;; decide the Cargo.toml [dependencies], so a dep is added iff its crate is + ;; actually referenced by generated code. + + (def (bytes-slice arg) + (string-append "&(" (emit-expression arg) ")[..]")) + + ;; (sha256 data) : Bytes -> Bytes (32-byte digest). + (def (emit-sha256 args) + (unless (= (length args) 1) + (error 'typed-rust "sha256 expects one Bytes operand" args)) + (string-append + "{ use sha2::Digest; let mut __h = sha2::Sha256::new(); __h.update(" + (bytes-slice (car args)) + "); __h.finalize().to_vec() }")) + + ;; (hmac-sha256 key msg) : (Bytes Bytes) -> Bytes (32-byte MAC). HMAC accepts + ;; any key length, so new_from_slice never errors here. + (def (emit-hmac-sha256 args) + (unless (= (length args) 2) + (error 'typed-rust "hmac-sha256 expects key and msg Bytes operands" args)) + (string-append + "{ use hmac::Mac; let mut __m = hmac::Hmac::<sha2::Sha256>::new_from_slice(" + (bytes-slice (car args)) + ").expect(\"HMAC accepts any key length\"); __m.update(" + (bytes-slice (cadr args)) + "); __m.finalize().into_bytes().to_vec() }")) + + ;; (hkdf-sha256 salt ikm info length) : (Bytes Bytes Bytes Nat) -> Bytes. + ;; HKDF-Extract-and-Expand; an empty salt reproduces RFC 5869's None (HMAC + ;; zero-pads either to the block size identically). expand only fails when + ;; length > 255*32, which the Nat operand never reaches in practice. + (def (emit-hkdf-sha256 args) + (unless (= (length args) 4) + (error 'typed-rust + "hkdf-sha256 expects salt, ikm, info Bytes and a Nat length" args)) + (string-append + "{ let __hk = hkdf::Hkdf::<sha2::Sha256>::new(Some(" + (bytes-slice (car args)) + "), " + (bytes-slice (cadr args)) + "); let mut __okm = vec![0u8; (" + (emit-expression (cadddr args)) + ") as usize]; __hk.expand(" + (bytes-slice (caddr args)) + ", &mut __okm).expect(\"hkdf expand within output limit\"); __okm }")) + + (def (emit-crypto-prim prim args) + (case prim + [(sha256) (emit-sha256 args)] + [(hmac-sha256) (emit-hmac-sha256 args)] + [(hkdf-sha256) (emit-hkdf-sha256 args)] + [else (error 'typed-rust "unknown crypto primitive" prim)])) + (def (emit-equality args) (unless (= (length args) 2) (error 'typed-rust "equal? expects two operands" args)) @@ -1585,6 +1646,7 @@ [(make-bytevector) (emit-make-bytevector args)] [(exact->inexact) (emit-to-float args)] [(log2) (emit-log2 args)] + [(crypto-prim) (emit-crypto-prim (ir-call-info-ref ir 'prim) args)] [(debug-string) (emit-debug-string args)] [(record-ctor) (let ([record (lookup-name (ir-call-info-ref ir 'record) --- a/support/typed-rust.ss +++ b/support/typed-rust.ss @@ -101,6 +101,53 @@ (define cargo-toml "[package]\nname = \"jerboa-typed-generated\"\nversion = \"0.0.0\"\nedition = \"2021\"\npublish = false\n\n[lib]\ncrate-type = [\"rlib\", \"staticlib\", \"cdylib\"]\n") +(define (string-contains-substr? haystack needle) + (let ([hlen (string-length haystack)] + [nlen (string-length needle)]) + (cond + [(= nlen 0) #t] + [(> nlen hlen) #f] + [else + (let loop ([i 0]) + (cond + [(> i (- hlen nlen)) #f] + [(let inner ([j 0]) + (cond + [(= j nlen) #t] + [(char=? (string-ref haystack (+ i j)) (string-ref needle j)) + (inner (+ j 1))] + [else #f])) + #t] + [else (loop (+ i 1))]))]))) + +;; Crate dependencies the crypto primitives may reference. A dep is emitted iff +;; the crate's path token actually appears in generated code, so plain numeric/ +;; byte kernels stay dependency-free. Keep the version pins in lockstep with the +;; `use`/path tokens the Rust emitter writes (lib/jerboa/typed/rust.ss). +(define crypto-crate-deps + '(("sha2::" . "sha2 = \"0.10\"") + ("hmac::" . "hmac = \"0.12\"") + ("hkdf::" . "hkdf = \"0.12\"") + ("aes_gcm::" . "aes-gcm = \"0.10\"") + ("x25519_dalek::" . "x25519-dalek = \"2\""))) + +(define (detect-dependencies files) + (let ([blob (apply string-append (map cdr files))]) + (let loop ([rest crypto-crate-deps] [out '()]) + (cond + [(null? rest) (reverse out)] + [(string-contains-substr? blob (caar rest)) + (loop (cdr rest) (cons (cdar rest) out))] + [else (loop (cdr rest) out)])))) + +(define (cargo-toml-with-deps dep-lines) + (if (null? dep-lines) + cargo-toml + (string-append + cargo-toml "\n[dependencies]\n" + (apply string-append + (map (lambda (l) (string-append l "\n")) dep-lines))))) + (define (path-parent path) (let loop ([i (- (string-length path) 1)]) (cond @@ -126,7 +173,8 @@ (error 'typed-rust "no typed-library forms found" source-paths)) (let ([files (typed-library-forms->rust-crate-files forms)]) (ensure-directory-tree src-dir) - (write-file-string (path-join2 safe-out-dir "Cargo.toml") cargo-toml) + (write-file-string (path-join2 safe-out-dir "Cargo.toml") + (cargo-toml-with-deps (detect-dependencies files))) (for-each (lambda (entry) (write-crate-file safe-out-dir entry)) files) (printf "Typed Jerboa Rust: wrote ~a module~a (~a file~a) to ~a\n" (length forms)