(in-package :passepartout) (defun policy-compliance-check (action context) "Enforces constitutional invariants on proposed actions." (declare (ignore context)) (let* ((payload (proto-get action :payload)) (explanation (proto-get payload :explanation))) (if (and explanation (stringp explanation) (> (length explanation) 10)) action (progn (log-message "POLICY VIOLATION: Action lacks sufficient explanation.") (list :type :LOG :payload (list :level :warn :text "Action blocked: Missing or insufficient :explanation. Please justify your reasoning.")))))) (defskill :passepartout-security-policy :priority 500 :trigger (lambda (ctx) (declare (ignore ctx)) t) :deterministic #'policy-compliance-check) (eval-when (:compile-toplevel :load-toplevel :execute) (ql:quickload :fiveam :silent t)) (defpackage :passepartout-security-policy-tests (:use :cl :fiveam :passepartout) (:export #:policy-suite)) (in-package :passepartout-security-policy-tests) (def-suite policy-suite :description "Verification of the Constitutional Policy Layer") (in-suite policy-suite) (test test-policy-passes-valid-explanation "Contract 1: action with sufficient explanation passes through unchanged." (let* ((action '(:type :REQUEST :payload (:action :read :explanation "The user asked me to read the TODO list for today."))) (result (policy-compliance-check action nil))) (is (equal action result)))) (test test-policy-rejects-short-explanation "Contract 1: action with explanation ≤10 characters is rejected with :LOG." (let* ((action '(:type :REQUEST :payload (:action :read :explanation "hi"))) (result (policy-compliance-check action nil))) (is (eq :LOG (getf result :type))) (is (search "blocked" (getf (getf result :payload) :text) :test #'char-equal)))) (test test-policy-rejects-missing-explanation "Contract 1: action without :explanation is rejected." (let* ((action '(:type :REQUEST :payload (:action :read))) (result (policy-compliance-check action nil))) (is (eq :LOG (getf result :type)))))