FEAT: Implement System 2 Bouncer and Org-native Authorization Gate

This commit is contained in:
2026-04-11 14:45:00 -04:00
parent db5a941340
commit f596c3db1f
7 changed files with 243 additions and 3 deletions

33
docs/rca/rca-bouncer.org Normal file
View File

@@ -0,0 +1,33 @@
#+TITLE: Root Cause Analysis: System 2 Bouncer & Authorization Gate
#+DATE: 2026-04-11
#+FILETAGS: :rca:bouncer:authorization:psf:security:
* Executive Summary
Implemented the "Planning Mode" Bouncer to intercept high-risk System 1 proposals (e.g., shell commands, Lisp evaluation). The system now forces these actions into an asynchronous "Flight Plan" Org node for manual Sovereign approval, fulfilling the "everything is a node" and high-integrity mandates.
* 1. Issue: Automated High-Risk Execution
** Symptoms
System 1 proposals involving `shell` or `eval` were executed immediately upon passing the `decide` gate's safety harness. This lacked human-in-the-loop oversight for irreversible or complex operations.
** Root Cause
Architecture gap. The system lacked an authorization state between "Safe" and "Executed".
** Resolution
1. **Interceptor:** Added `bouncer-check` to `symbolic.lisp`. It flags high-risk actions that lack the `:approved t` property.
2. **Asynchronous Event:** If flagged, the kernel emits an `:approval-required` event.
3. **Flight Plan Skill:** Created `org-skill-bouncer.org` to:
- Catch the event and create a serialized Org node with state `PLAN`.
- Monitor the Object Store for `APPROVED` states.
- Re-inject approved actions with the `:approved t` bypass flag.
* 2. Design Decision: Org-native Approval
** Requirement
Align with "Homoiconic Memory" and "Lisp Machine Sovereignty".
** Selected Path
State-Based Approval (Org-native).
- *Pros:* Auditable, asynchronous, utilizes existing Org-mode workflows.
- *Cons:* Slightly more latency than an interactive prompt.
** Alignment
Ensures that the agent's "Flight Plans" are first-class citizens in the Memex, allowing the Sovereign to review and approve them using standard GTD tools.
* 3. Permanent Learnings
- **Serial Bypass:** Always include a specific bypass flag (e.g., `:approved t`) when re-injecting intercepted actions to prevent infinite interception loops.
- **Heartbeat Listeners:** Periodic scanning of the Object Store for state transitions is an effective way to implement asynchronous authorization gates without blocking the kernel.

View File

@@ -228,8 +228,27 @@ Enforces high-integrity semantic rules for task management (e.g. blocking closin
nil))
#+end_src
** Authorization Gate (Bouncer)
The Bouncer intercepts high-risk or complex actions and requires manual Sovereign approval.
#+begin_src lisp :tangle ../src/symbolic.lisp
(defun bouncer-check (action)
"Checks if an action requires manual authorization."
(let* ((payload (getf action :payload))
(target (getf action :target))
(act (or (getf payload :action) (getf action :action)))
(tool (or (getf payload :tool) (getf action :tool)))
(approved (getf action :approved)))
(when (and (not approved)
(or (and (eq target :tool) (equal tool "shell"))
(and (eq target :emacs) (eq act :eval))
(and (eq target :tool) (equal tool "repair-file"))))
(return-from bouncer-check t))
nil))
#+end_src
** Validation Gate (decide)
The "System 2" supervisor. It intercepts every action proposed by System 1 and runs it through the task integrity check, the skill's symbolic gate, and the global safety harness.
The "System 2" supervisor. It intercepts every action proposed by System 1 and runs it through the task integrity check, the bouncer, the skill's symbolic gate, and the global safety harness.
#+begin_src lisp :tangle ../src/symbolic.lisp
(defun decide (proposed-action context)
@@ -240,7 +259,14 @@ The "System 2" supervisor. It intercepts every action proposed by System 1 and r
(kernel-log "SYSTEM 2 [INTEGRITY]: ~a~%" integrity-error)
(return-from decide (list :type :LOG :payload (list :text integrity-error)))))
;; 2. Skill-specific and Safety Checks
;; 2. Bouncer Check (Authorization Gate)
(when (bouncer-check proposed-action)
(kernel-log "SYSTEM 2 [BOUNCER]: Action requires manual approval.~%")
(return-from decide
(list :type :EVENT
:payload (list :sensor :approval-required :action proposed-action))))
;; 3. Skill-specific and Safety Checks
(let ((active-skill (find-triggered-skill context)))
(if (and proposed-action (listp proposed-action) active-skill)
(let* ((symbolic-gate (skill-symbolic-fn active-skill))

View File

@@ -17,6 +17,7 @@
(:file "src/safety-harness")
(:file "src/self-fix")
(:file "src/lisp-repair")
(:file "src/bouncer")
(:file "src/core"))
:build-operation "program-op"
:build-pathname "org-agent-server"
@@ -34,6 +35,7 @@
(:file "tests/task-orchestrator-tests")
(:file "tests/self-fix-tests")
(:file "tests/lisp-repair-tests")
(:file "tests/bouncer-tests")
(:file "tests/chaos-qa"))
:perform (test-op (o s)
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :oacp-suite :org-agent-tests))
@@ -46,4 +48,5 @@
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :task-orchestrator-suite :org-agent-task-orchestrator-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :self-fix-suite :org-agent-self-fix-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :lisp-repair-suite :org-agent-lisp-repair-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :bouncer-suite :org-agent-bouncer-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :chaos-suite :org-agent-chaos-qa))))

View File

@@ -0,0 +1,65 @@
:PROPERTIES:
:ID: bouncer-agent-skill
:CREATED: [2026-04-11 Sat 15:20]
:END:
#+TITLE: SKILL: System 2 Bouncer (Authorization Gate)
#+STARTUP: content
#+FILETAGS: :system:bouncer:authorization:psf:
* Overview
The *System 2 Bouncer* is the authorization gate for high-risk actions. It serializes intercepted actions into Org nodes ("Flight Plans") and re-injects them once manually approved by the Sovereign.
* Implementation
** Approval Processing
#+begin_src lisp :tangle ../src/bouncer.lisp
(in-package :org-agent)
(defun bouncer-process-approvals ()
"Scans the object store for APPROVED flight plans and re-injects their actions."
(let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
(found-any nil))
(dolist (node approved-nodes)
(let* ((tags (getf (org-object-attributes node) :TAGS))
(action-str (getf (org-object-attributes node) :ACTION)))
(when (and (member "FLIGHT_PLAN" tags :test #'string-equal) action-str)
(kernel-log "BOUNCER: Found approved flight plan ~a. Re-injecting..." (org-object-id node))
(let ((action (ignore-errors (read-from-string action-str))))
(when action
;; Add bypass flag
(setf (getf action :approved) t)
(inject-stimulus action)
;; Mark as DONE
(setf (getf (org-object-attributes node) :TODO) "DONE")
(setq found-any t))))))
found-any))
#+end_src
** Skill Definition
#+begin_src lisp :tangle ../src/bouncer.lisp
(defskill :skill-bouncer
:priority 100
:trigger (lambda (ctx)
(or (eq (getf (getf ctx :payload) :sensor) :approval-required)
(eq (getf (getf ctx :payload) :sensor) :heartbeat)))
:neuro nil
:symbolic (lambda (action context)
(declare (ignore action))
(let* ((payload (getf context :payload))
(sensor (getf payload :sensor)))
(case sensor
(:approval-required
(let* ((blocked-action (getf payload :action))
(id (org-id-new)))
(kernel-log "BOUNCER: Creating flight plan node...")
;; Create the node in Emacs (or inbox)
(list :type :REQUEST :target :emacs :action :insert-node
:id id :attributes `(:TITLE "Flight Plan: High-Risk Action"
:TODO "PLAN"
:TAGS ("FLIGHT_PLAN")
:ACTION ,(format nil "~s" blocked-action)))))
(:heartbeat
;; Periodically check for approvals
(bouncer-process-approvals)
nil)))))
#+end_src

46
src/bouncer.lisp Normal file
View File

@@ -0,0 +1,46 @@
(in-package :org-agent)
(defun bouncer-process-approvals ()
"Scans the object store for APPROVED flight plans and re-injects their actions."
(let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
(found-any nil))
(dolist (node approved-nodes)
(let* ((tags (getf (org-object-attributes node) :TAGS))
(action-str (getf (org-object-attributes node) :ACTION)))
(when (and (member "FLIGHT_PLAN" tags :test #'string-equal) action-str)
(kernel-log "BOUNCER: Found approved flight plan ~a. Re-injecting..." (org-object-id node))
(let ((action (ignore-errors (read-from-string action-str))))
(when action
;; Add bypass flag
(setf (getf action :approved) t)
(inject-stimulus action)
;; Mark as DONE
(setf (getf (org-object-attributes node) :TODO) "DONE")
(setq found-any t))))))
found-any))
(defskill :skill-bouncer
:priority 100
:trigger (lambda (ctx)
(or (eq (getf (getf ctx :payload) :sensor) :approval-required)
(eq (getf (getf ctx :payload) :sensor) :heartbeat)))
:neuro nil
:symbolic (lambda (action context)
(declare (ignore action))
(let* ((payload (getf context :payload))
(sensor (getf payload :sensor)))
(case sensor
(:approval-required
(let* ((blocked-action (getf payload :action))
(id (org-id-new)))
(kernel-log "BOUNCER: Creating flight plan node...")
;; Create the node in Emacs (or inbox)
(list :type :REQUEST :target :emacs :action :insert-node
:id id :attributes `(:TITLE "Flight Plan: High-Risk Action"
:TODO "PLAN"
:TAGS ("FLIGHT_PLAN")
:ACTION ,(format nil "~s" blocked-action)))))
(:heartbeat
;; Periodically check for approvals
(bouncer-process-approvals)
nil)))))

View File

@@ -14,6 +14,20 @@
(return-from task-integrity-check "Blocked by Task Integrity: Active children exist."))))
nil))
(defun bouncer-check (action)
"Checks if an action requires manual authorization."
(let* ((payload (getf action :payload))
(target (getf action :target))
(act (or (getf payload :action) (getf action :action)))
(tool (or (getf payload :tool) (getf action :tool)))
(approved (getf action :approved)))
(when (and (not approved)
(or (and (eq target :tool) (equal tool "shell"))
(and (eq target :emacs) (eq act :eval))
(and (eq target :tool) (equal tool "repair-file"))))
(return-from bouncer-check t))
nil))
(defun decide (proposed-action context)
"The System 2 Safety Gate: validates or rejects proposed neural actions."
;; 1. Task Integrity Check (GTD Semantics)
@@ -22,7 +36,14 @@
(kernel-log "SYSTEM 2 [INTEGRITY]: ~a~%" integrity-error)
(return-from decide (list :type :LOG :payload (list :text integrity-error)))))
;; 2. Skill-specific and Safety Checks
;; 2. Bouncer Check (Authorization Gate)
(when (bouncer-check proposed-action)
(kernel-log "SYSTEM 2 [BOUNCER]: Action requires manual approval.~%")
(return-from decide
(list :type :EVENT
:payload (list :sensor :approval-required :action proposed-action))))
;; 3. Skill-specific and Safety Checks
(let ((active-skill (find-triggered-skill context)))
(if (and proposed-action (listp proposed-action) active-skill)
(let* ((symbolic-gate (skill-symbolic-fn active-skill))

46
tests/bouncer-tests.lisp Normal file
View File

@@ -0,0 +1,46 @@
(defpackage :org-agent-bouncer-tests
(:use :cl :fiveam :org-agent)
(:export #:bouncer-suite))
(in-package :org-agent-bouncer-tests)
(def-suite bouncer-suite :description "Tests for System 2 Bouncer & Authorization Gate.")
(in-suite bouncer-suite)
(test test-bouncer-interception
"Verify that a high-risk action is intercepted by the bouncer."
(let* ((action '(:type :REQUEST :target :tool :action :call :tool "shell" :args (:cmd "rm -rf /")))
(context '(:payload (:sensor :test)))
(result (org-agent:decide-gate (list :type :EVENT :candidate action :payload '(:sensor :test)))))
(let ((approved (getf result :approved-action)))
;; Result should be an EVENT requiring approval, not the original REQUEST
(is (eq :EVENT (getf approved :type)))
(is (eq :approval-required (getf (getf approved :payload) :sensor)))
(is (equal action (getf (getf approved :payload) :action))))))
(test test-bouncer-bypass
"Verify that an approved action bypasses the bouncer."
(let* ((action '(:type :REQUEST :target :tool :action :call :tool "shell" :args (:cmd "ls") :approved t))
(context '(:payload (:sensor :test)))
(result (org-agent:decide-gate (list :type :EVENT :candidate action :payload '(:sensor :test)))))
(let ((approved (getf result :approved-action)))
;; Result should be the original action because it has :approved t
(is (eq :REQUEST (getf approved :type)))
(is (equal action approved)))))
(test test-bouncer-approval-reaction
"Verify that the bouncer skill re-injects an action when a plan node is APPROVED."
(clrhash org-agent::*object-store*)
(let* ((action '(:type :REQUEST :target :tool :action :call :tool "ls"))
(node-id "plan-1"))
;; 1. Setup an APPROVED flight plan node
(setf (gethash node-id org-agent::*object-store*)
(org-agent::make-org-object
:id node-id
:attributes `(:TITLE "Flight Plan" :TODO "APPROVED" :TAGS ("FLIGHT_PLAN") :ACTION ,(format nil "~s" action))))
;; 2. Manually trigger the bouncer's approval checker
(let ((result (org-agent::bouncer-process-approvals)))
(is (eq t result))
;; The node should now be DONE
(let ((obj (gethash node-id org-agent::*object-store*)))
(is (equal "DONE" (getf (org-agent:org-object-attributes obj) :TODO)))))))