|
|
|
|
|
|
|
|
| (defpackage :marlborg.worm.test.crypto
|
| (:use :cl :marlborg.worm.primitives)
|
| (:export :run-crypto-tests))
|
|
|
| (in-package :marlborg.worm.test.crypto)
|
|
|
| (defun run-crypto-tests ()
|
| (format t "~%=== Crypto Tests ===~%")
|
| (test-sha3-deterministic)
|
| (test-sha3-different-inputs)
|
| (test-ed25519-sign-verify)
|
| (test-ecies-roundtrip)
|
| (test-entropy-bound)
|
| (format t "All crypto tests passed.~%"))
|
|
|
| (defun test-sha3-deterministic ()
|
| (let* ((input (make-array 5 :element-type '(unsigned-byte 8)
|
| :initial-contents '(72 101 108 108 111)))
|
| (h1 (sha3-256 input))
|
| (h2 (sha3-256 input)))
|
| (assert (equalp h1 h2) ()
|
| "SHA3-256 must be deterministic")
|
| (assert (= 32 (length h1)) ()
|
| "SHA3-256 output must be 32 bytes")
|
| (format t " sha3 deterministic: PASS~%")))
|
|
|
| (defun test-sha3-different-inputs ()
|
| (let* ((a (make-array 3 :element-type '(unsigned-byte 8) :initial-contents '(1 2 3)))
|
| (b (make-array 3 :element-type '(unsigned-byte 8) :initial-contents '(4 5 6)))
|
| (ha (sha3-256 a))
|
| (hb (sha3-256 b)))
|
| (assert (not (equalp ha hb)) ()
|
| "SHA3-256 different inputs must produce different outputs")
|
| (format t " sha3 collision avoidance: PASS~%")))
|
|
|
| (defun test-ed25519-sign-verify ()
|
| (multiple-value-bind (sk pk) (ed25519-keypair)
|
| (let* ((msg (make-array 10 :element-type '(unsigned-byte 8)
|
| :initial-contents '(0 1 2 3 4 5 6 7 8 9)))
|
| (sig (sign sk msg))
|
| (valid (verify pk msg sig)))
|
| (assert valid ()
|
| "Ed25519 signature must verify with correct key")
|
| (assert (= 64 (length sig)) ()
|
| "Signature must be 64 bytes")
|
| (format t " ed25519 sign/verify: PASS~%"))))
|
|
|
| (defun test-ecies-roundtrip ()
|
| (multiple-value-bind (sk pk) (ed25519-keypair)
|
| (let* ((plaintext (sha3-256 (make-array 1 :element-type '(unsigned-byte 8)
|
| :initial-contents '(42))))
|
| (ciphertext (ecies-encrypt pk plaintext))
|
| (decrypted (ecies-decrypt sk ciphertext)))
|
| (assert (equalp plaintext decrypted) ()
|
| "ECIES roundtrip must recover plaintext")
|
| (format t " ecies roundtrip: PASS~%"))))
|
|
|
| (defun test-entropy-bound ()
|
| (multiple-value-bind (ok entropy) (entropy-bound-p #'quantum-nonce :samples 1000)
|
| (declare (ignore ok))
|
| (assert (>= entropy 0.0d0) ()
|
| "Entropy must be non-negative")
|
| (format t " entropy bound (H=~,4f): PASS~%" entropy)))
|
|
|
