FEAT: Implement System 2 Bouncer and Org-native Authorization Gate
This commit is contained in:
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))
|
||||
|
||||
Reference in New Issue
Block a user