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

(defpackage :marlborg.worm.test.worm
  (:use :cl :marlborg.worm.primitives)
  (:export :run-worm-tests))

(in-package :marlborg.worm.test.worm)

(defun run-worm-tests ()
  (format t "~%=== WORM Chain Tests ===~%")
  (test-genesis)
  (test-append-and-verify)
  (test-tamper-detection)
  (test-chain-growth)
  (format t "All WORM tests passed.~%"))

(defun test-genesis ()
  (let ((chain (make-chain)))
    (assert (= 1 (length (worm-chain-blocks chain))) ()
            "Genesis chain must have exactly 1 block")
    (assert (= 0 (worm-block-index (car (worm-chain-blocks chain)))) ()
            "Genesis block index must be 0")
    (format t "  genesis: PASS~%")))

(defun test-append-and-verify ()
  (multiple-value-bind (sk pk) (ed25519-keypair)
    (let* ((chain (make-chain))
           (payload (sha3-256 (make-array 4 :element-type '(unsigned-byte 8)
                                            :initial-contents '(1 2 3 4))))
           (chain2 (append-block chain
                                 (ecies-encrypt pk payload)
                                 sk)))
      (assert (= 2 (length (worm-chain-blocks chain2))) ()
              "Chain must grow by 1")
      (assert (= 1 (worm-block-index (car (worm-chain-blocks chain2)))) ()
              "New block index must be 1")
      (assert (verify-chain chain2 pk) ()
              "Chain must verify after append")
      (format t "  append + verify: PASS~%"))))

(defun test-tamper-detection ()
  (multiple-value-bind (sk pk) (ed25519-keypair)
    (let* ((chain (make-chain))
           (payload (sha3-256 (make-array 2 :element-type '(unsigned-byte 8)
                                            :initial-contents '(99 100))))
           (chain2 (append-block chain (ecies-encrypt pk payload) sk))
           (tampered-blocks (copy-list (worm-chain-blocks chain2)))
           (tampered-block (copy-structure (car tampered-blocks))))
      (setf (worm-block-payload-hash tampered-block)
            (make-array 64 :element-type '(unsigned-byte 8) :initial-element 255))
      (setf (car tampered-blocks) tampered-block)
      (let ((tampered-chain (%make-chain :blocks tampered-blocks
                                          :genesis-hash (worm-chain-genesis-hash chain2))))
        (assert (not (verify-chain tampered-chain pk)) ()
                "Tampered chain must not verify")
        (format t "  tamper detection: PASS~%")))))

(defun test-chain-growth ()
  (multiple-value-bind (sk pk) (ed25519-keypair)
    (let ((chain (make-chain)))
      (dotimes (i 10)
        (let ((payload (sha3-256 (encode-uint64 i))))
          (setf chain (append-block chain (ecies-encrypt pk payload) sk))))
      (assert (= 11 (length (worm-chain-blocks chain))) ()
              "Chain must have genesis + 10 blocks")
      (assert (verify-chain chain pk) ()
              "10-block chain must verify")
      (format t "  chain growth (10 blocks): PASS~%"))))