File size: 3,079 Bytes
75619b0 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | ;;;
;;; 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~%"))))
|