From da5718b97c133ddbd31fc97521237f5e4ae2dfe1 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Fri, 8 May 2026 21:24:20 -0400 Subject: [PATCH] =?UTF-8?q?v0.7.2:=20Merkle=20audit=20=E2=80=94=20audit-ve?= =?UTF-8?q?rify-hash=20with=20hash=20integrity=20check=20=E2=80=94=20TDD?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit audit-verify-hash counts total objects and those with missing/empty hashes. /audit verify uses it to report VERIFY PASS or MISSING HASHES count. fboundp-guarded. - core-memory: audit-verify-hash fn, 1 test - channel-tui-main: updated /audit verify handler - Core: 90/90 TUI Main: 102/102 --- lisp/channel-tui-main.lisp | 31 +++++++++++++++++-------------- lisp/core-memory.lisp | 23 +++++++++++++++++++++++ org/channel-tui-main.org | 20 ++++++++++---------- org/core-memory.org | 23 +++++++++++++++++++++++ 4 files changed, 73 insertions(+), 24 deletions(-) diff --git a/lisp/channel-tui-main.lisp b/lisp/channel-tui-main.lisp index 192487a..92c0328 100644 --- a/lisp/channel-tui-main.lisp +++ b/lisp/channel-tui-main.lisp @@ -217,13 +217,16 @@ (subseq (or (getf info :hash) "(none)") 0 16))) (add-msg :system (format nil "Node ~a not found" node-id)))) (add-msg :system "Memory audit not available"))) - ;; /tags command — tag stack - ;; /tags command — tag stack + ;; /tags command — tag stack with trigger counts ((string-equal text "/tags") - (let ((cats passepartout::*tag-categories*)) + (let ((cats passepartout::*tag-categories*) + (counts passepartout::*tag-trigger-count*)) (if cats (dolist (entry cats) - (add-msg :system (format nil "~a: ~a" (car entry) (cdr entry)))) + (let* ((tag (car entry)) + (sev (cdr entry)) + (n (gethash (string-downcase tag) counts 0))) + (add-msg :system (format nil "~a: ~a (~d trigger~:p this session)" tag sev n)))) (add-msg :system "No tags configured. Set TAG_CATEGORIES env var.")))) ;; /context command — section breakdown with token estimates ((string-equal text "/context") @@ -318,16 +321,16 @@ (add-msg :system "No snapshots available")))) ;; /audit verify — memory integrity ((string-equal text "/audit verify") - (let ((count 0) (hashed 0)) - (maphash (lambda (k v) (declare (ignore k)) - (when v - (incf count) - (when (passepartout::memory-object-hash v) - (incf hashed)))) - passepartout::*memory-store*) - (add-msg :system (format nil "Audit: ~d objects, ~d hashed, ~d snapshots" - count hashed - (length passepartout::*memory-snapshots*))))) + (if (fboundp 'passepartout::audit-verify-hash) + (let* ((result (funcall 'passepartout::audit-verify-hash)) + (total (car result)) + (missing (cdr result))) + (add-msg :system (format nil "Audit: ~d objects, ~d missing hashes, ~d snapshots~@[ — VERIFY PASS~]~@[ — ~d MISSING HASHES~]" + total missing + (length passepartout::*memory-snapshots*) + (zerop missing) + (unless (zerop missing) missing)))) + (add-msg :system "Memory audit not available"))) ;; /resume — resume from snapshot ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/resume ")) (let* ((n-str (string-trim '(#\Space) (subseq text 8))) diff --git a/lisp/core-memory.lisp b/lisp/core-memory.lisp index 2833e4e..a496944 100644 --- a/lisp/core-memory.lisp +++ b/lisp/core-memory.lisp @@ -204,6 +204,20 @@ :hash (or (memory-object-hash obj) "(none)") :scope (memory-object-scope obj))))) +(defun audit-verify-hash () + "Count memory objects and report any with missing/empty hashes. +Returns (total . missing-hashes)." + (let ((total 0) (missing 0)) + (maphash (lambda (id obj) + (declare (ignore id)) + (when obj + (incf total) + (let ((h (memory-object-hash obj))) + (when (or (null h) (string= h "")) + (incf missing))))) + *memory-store*) + (cons total missing))) + (eval-when (:compile-toplevel :load-toplevel :execute) (ql:quickload :fiveam :silent t)) @@ -326,3 +340,12 @@ (test test-audit-node-not-found "Contract v0.7.2: audit-node returns nil for nonexistent id." (is (null (passepartout::audit-node "nonexistent-xxxx")))) + +(test test-audit-verify-hash + "Contract v0.7.2: audit-verify-hash returns (total . missing)." + (clrhash passepartout::*memory-store*) + (setf (gethash "a" passepartout::*memory-store*) + (passepartout::make-memory-object :id "a" :type :HEADLINE :hash "abc")) + (let ((result (passepartout::audit-verify-hash))) + (is (= 1 (car result))) + (is (= 0 (cdr result))))) diff --git a/org/channel-tui-main.org b/org/channel-tui-main.org index 9424023..a456c98 100644 --- a/org/channel-tui-main.org +++ b/org/channel-tui-main.org @@ -355,16 +355,16 @@ Event handlers + daemon I/O + main loop. (add-msg :system "No snapshots available")))) ;; /audit verify — memory integrity ((string-equal text "/audit verify") - (let ((count 0) (hashed 0)) - (maphash (lambda (k v) (declare (ignore k)) - (when v - (incf count) - (when (passepartout::memory-object-hash v) - (incf hashed)))) - passepartout::*memory-store*) - (add-msg :system (format nil "Audit: ~d objects, ~d hashed, ~d snapshots" - count hashed - (length passepartout::*memory-snapshots*))))) + (if (fboundp 'passepartout::audit-verify-hash) + (let* ((result (funcall 'passepartout::audit-verify-hash)) + (total (car result)) + (missing (cdr result))) + (add-msg :system (format nil "Audit: ~d objects, ~d missing hashes, ~d snapshots~@[ — VERIFY PASS~]~@[ — ~d MISSING HASHES~]" + total missing + (length passepartout::*memory-snapshots*) + (zerop missing) + (unless (zerop missing) missing)))) + (add-msg :system "Memory audit not available"))) ;; /resume — resume from snapshot ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/resume ")) (let* ((n-str (string-trim '(#\Space) (subseq text 8))) diff --git a/org/core-memory.org b/org/core-memory.org index 4728009..04c36da 100644 --- a/org/core-memory.org +++ b/org/core-memory.org @@ -415,6 +415,20 @@ Restores memory state from a previously saved snapshot file. Called during boot :version (memory-object-version obj) :hash (or (memory-object-hash obj) "(none)") :scope (memory-object-scope obj))))) + +(defun audit-verify-hash () + "Count memory objects and report any with missing/empty hashes. +Returns (total . missing-hashes)." + (let ((total 0) (missing 0)) + (maphash (lambda (id obj) + (declare (ignore id)) + (when obj + (incf total) + (let ((h (memory-object-hash obj))) + (when (or (null h) (string= h "")) + (incf missing))))) + *memory-store*) + (cons total missing))) #+end_src * Test Suite @@ -542,4 +556,13 @@ Verifies that the Merkle hash is deterministic and consistent across independent (test test-audit-node-not-found "Contract v0.7.2: audit-node returns nil for nonexistent id." (is (null (passepartout::audit-node "nonexistent-xxxx")))) + +(test test-audit-verify-hash + "Contract v0.7.2: audit-verify-hash returns (total . missing)." + (clrhash passepartout::*memory-store*) + (setf (gethash "a" passepartout::*memory-store*) + (passepartout::make-memory-object :id "a" :type :HEADLINE :hash "abc")) + (let ((result (passepartout::audit-verify-hash))) + (is (= 1 (car result))) + (is (= 0 (cdr result))))) #+end_src \ No newline at end of file