FEAT: Implement System 2 Bouncer and Org-native Authorization Gate
This commit is contained in:
33
docs/rca/rca-bouncer.org
Normal file
33
docs/rca/rca-bouncer.org
Normal 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.
|
||||
@@ -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))
|
||||
|
||||
@@ -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))))
|
||||
|
||||
65
skills/org-skill-bouncer.org
Normal file
65
skills/org-skill-bouncer.org
Normal 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
46
src/bouncer.lisp
Normal 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)))))
|
||||
@@ -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
46
tests/bouncer-tests.lisp
Normal 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)))))))
|
||||
Reference in New Issue
Block a user