;;;
;;; Copyright (c) 2026 BEL ESPRIT D ACCORD TRUST HOLDINGS INC
;;; All rights reserved.

(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)))