test/wasm/src/crypto-probe/main.sgl

1;;; The sigil-crypto wasm probe: one line per check, printed identically on

2;;; every target. test/wasm/run-wasm-test.mjs builds this for the host and

3;;; for wasm32-wasi, runs both, and requires the two outputs to match line

4;;; for line (except lines starting "target:", which say what the target

5;;; is expected to differ on), and each line to have its expected value.

6(define-library (crypto-probe main)

7 (import (sigil core)

8 (sigil io)

9 (sigil math)

10 (sigil crypto)

11 (sigil crypto minisign)

12 (crypto-probe fixtures))

13 (export main)

14 (begin

15 (define (hex->bv s)

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

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

18 (let loop ((i 0))

19 (if (< i n)

20 (begin

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

22 (loop (+ i 1)))

23 bv))))

25 (define (bv->hex bv)

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

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

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

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

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

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

33 (define (flip-byte bv index)

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

35 (bytevector-u8-set! out index (bitwise-xor (bytevector-u8-ref out index) 1))

36 out))

38 ;; The message of whatever `thunk` raises, or "no-error".

39 (define (raised-message thunk)

40 (guard (e (#t (if (error-object? e) (error-object-message e) "non-error raise")))

41 (thunk)

42 "no-error"))

44 (define (show label value) (println "~a: ~a" label value))

46 ;; RFC 8032 section 7.1 TEST 2 and TEST 3.

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

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

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

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

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

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

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

55 (define (main . args)

56 (let ((key-a (minisign-parse-public-key (fixture "a.pub")))

57 (key-b (minisign-parse-public-key (fixture "b.pub")))

58 (root (minisign-parse-public-key

59 "RWRa9dPSUBFexBbLdzZIfuAmuCYL736UeHC7IbdAOIYpgGIyDmWRaQHY"))

60 (hello (fixture "hello.txt"))

61 (sig (lambda (name) (minisign-parse-signature (fixture name)))))

62 (show "blake2b-512 abc" (bv->hex (blake2b-512 "abc")))

63 (show "blake2b-512 binary.bin" (bv->hex (blake2b-512 (fixture "binary.bin"))))

64 (show "ed25519 rfc8032 test 2 verifies" (ed25519-verify t2-pk t2-msg t2-sig))

65 (show "ed25519 rfc8032 test 3 verifies" (ed25519-verify t3-pk t3-msg t3-sig))

66 (show "ed25519 test 2 flipped message" (ed25519-verify t2-pk (flip-byte t2-msg 0) t2-sig))

67 (show "ed25519 test 3 flipped signature" (ed25519-verify t3-pk t3-msg (flip-byte t3-sig 5)))

68 (show "ed25519 test 3 flipped key" (ed25519-verify (flip-byte t3-pk 7) t3-msg t3-sig))

69 (show "ed25519 test 2 public key" (bv->hex (ed25519-public-key t2-seed)))

70 (show "ed25519 test 2 signature" (bv->hex (ed25519-sign t2-seed t2-msg)))

71 (show "ed25519 31-byte key" (raised-message (lambda () (ed25519-verify (make-bytevector 31 0) "m" t2-sig))))

72 (show "minisign key a id" (minisign-public-key-id key-a))

73 (show "minisign hello ED" (minisign-verify key-a (sig "hello.txt.ED.minisig") hello))

74 (show "minisign hello Ed" (minisign-verify key-a (sig "hello.txt.Ed.minisig") hello))

75 (show "minisign binary ED" (minisign-verify key-a (sig "binary.bin.ED.minisig") (fixture "binary.bin")))

        (show "minisign registry root" (minisign-verify-prehashed root (sig "registry.json.minisig") (fixture "registry.json")))

        (show "minisign registry tampered" (minisign-failure-reason root (sig "registry.json.minisig") (flip-byte (fixture "registry.json") 100) #t))

        (show "minisign hello tampered" (minisign-failure-reason key-a (sig "hello.txt.ED.minisig") (flip-byte hello 0) #f))

79 (show "minisign key mismatch" (minisign-failure-reason key-a (sig "hello.txt.keyb.minisig") hello #f))

80 (show "minisign key b" (minisign-failure-reason key-b (sig "hello.txt.keyb.minisig") hello #f))

81 (show "minisign legacy refused" (minisign-failure-reason key-a (sig "hello.txt.Ed.minisig") hello #t))

82 (show "minisign bad key line" (raised-message (lambda () (minisign-parse-public-key "RWQ"))))

83 (show "timing-safe-equal?" (timing-safe-equal? "abc" "abc"))

84 ;; Differs by design: Mbed TLS is not built for wasm.

85 (show "target: sha256" (raised-message (lambda () (sha256 "abc"))))

86 (show "target: base64url-encode" (raised-message (lambda () (base64url-encode "abc"))))

87 (println "REACHED-END")

88 0))))