Amr Gharbeia
8fd56dece3
Phase 1 — dedup + hardening (~9 items): - Remove duplicate *skill-registry* defvar from core-skills - Merge *backend-registry* into *probabilistic-backends*, delete backend-register - Remove inject-stimulus alias, standardize on stimulus-inject - Add pre-eval sandbox (skill-source-scan) blocks restricted symbols before eval - Remove dead plist-get function; remove duplicate json-alist-to-plist export - Fix read-framed-message whitespace DoS (4096-iteration max) - Add *read-eval* nil to dispatcher-approvals-process read-from-string (RCE) - Add test-op to ASDF; update .asd version 0.4.3→0.7.2 Phase 2 — prose + contracts + reorder: - Split ROADMAP: 2623→1089 lines (TODO only), CHANGELOG: 260→1528 lines (full DONE history, 14 versions reverse chron) - Add Contracts + Overview to 6 channel files + embedding-native + programming-standards + symbolic-scope - Reorder 28 .org files: Contract → Test Suite → Implementation (TDD order) - Add 7-phase inline prose to think() in core-reason - Expand USER_MANUAL: 183→461 lines (10 new sections) Phase 3 — decomposition + export organization: - Decompose think() into think-assemble-prompt, think-call-llm, think-parse-response orchestrator - Organize 188 exports into 16 grouped sections by module Phase 4 — budget enforcement + error protocol: - Per-session budget enforcement (SESSION_BUDGET_USD env var, budget-exhausted-p, guard in think-call-llm) - Error condition hierarchy (6 conditions: pipeline-error, llm-error, gate-error, budget-error, protocol-error) - Restarts in loop-process: skip-signal, use-fallback, abort-pipeline
94 lines
3.8 KiB
Org Mode
94 lines
3.8 KiB
Org Mode
#+TITLE: SKILL: Policy (org-skill-policy.org)
|
|
#+AUTHOR: Agent
|
|
#+FILETAGS: :system:policy:constitutional:
|
|
#+PROPERTY: header-args:lisp :tangle ../lisp/security-policy.lisp
|
|
|
|
* Architectural Intent: The Constitutional Layer
|
|
|
|
The Policy skill encodes the non-negotiable values of Passepartout. Every action the agent proposes must pass through this gate. If the action lacks justification, it is blocked — not because it's dangerous, but because it's opaque.
|
|
|
|
This is the "Radical Transparency" invariant in practice. The agent must explain *why* it wants to do something, not just *what* it wants to do. An action with ~:explanation "Because I said so"~ is rejected. An action with ~:explanation "The user asked me to read their TODO list and summarize it"~ passes.
|
|
|
|
The Policy skill is intentionally simple. It has one job: ensure every action has a meaningful explanation. Other security concerns (secret scanning, path blocking, network exfiltration) are handled by the Dispatcher. The Policy is about values, not threats.
|
|
|
|
** Contract
|
|
|
|
1. (policy-compliance-check action context): if ~action~ has an
|
|
~:explanation~ string longer than 10 characters, returns the action
|
|
unchanged. Otherwise, returns a ~:LOG~ rejection plist with
|
|
~:level :warn~.
|
|
|
|
** Boundaries
|
|
|
|
- Does NOT check for dangerous content — the Dispatcher does that.
|
|
- Does NOT validate explanation quality — only length and presence.
|
|
- Does NOT consider ~context~ — implementation ignores it currently.
|
|
|
|
* Test Suite
|
|
|
|
#+begin_src lisp
|
|
(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)))))
|
|
#+end_src
|
|
|
|
* Implementation
|
|
|
|
** Package Context
|
|
#+begin_src lisp
|
|
(in-package :passepartout)
|
|
#+end_src
|
|
|
|
** Policy Logic (policy-compliance-check)
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(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."))))))
|
|
#+end_src
|
|
|
|
** Skill Registration
|
|
#+begin_src lisp
|
|
(defskill :passepartout-security-policy
|
|
:priority 500
|
|
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
|
:deterministic #'policy-compliance-check)
|
|
#+end_src
|
|
|