Files
passepartout/lisp/security-policy.lisp
Amr Gharbeia e04b12c31c v0.8.0: TUI stabilization, command palette reverse-video highlight, hint bar redesign
- ROADMAP: consolidate all TUI work under v0.8.0 (removed premature
  v0.9.0/v0.10.x labels), restored original v0.9.0 eval harness plan
- channel-tui-view.org: Emacs-style reverse-video cursor (swap fg/bg
  instead of drawing █), hint bar now shows F:focus/MCP:count on left
  and token gauge + keybindings on right, sidebar reorganized to show
  GATE TRACE, RULES + BLOCK COUNT, COST, FILES panels
- channel-tui-main.org: command palette selection now uses reverse-video
  highlight (bg-input fg on input-fg bg, matching cursor style), fixed
  cond order so sel-p is checked before cat (all items had :category
  making sel-p unreachable), added session-cost extraction from daemon
- passepartout: export COLORTERM=truecolor for modern backend detection
2026-05-17 15:37:40 -04:00

51 lines
2.1 KiB
Common Lisp

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