feat: HITL — continuation-based human-in-the-loop
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s

- dispatcher-check: add :level :approval-required to network/high-impact returns
- cognitive-verify: distinguish approval-required from hard rejection; pass
  approval requests through to act gate instead of returning early
- loop-gate-reason: don't retry approval requests; pass them as approved-action
  with :status :requires-approval
- loop-gate-act: detect approval-required, create Flight Plan, dispatch HITL
  message to user's client, don't execute original action
- loop-gate-perceive: handle re-injected approved signals from
  dispatcher-approvals-process; set :approved-action on signal
- dispatcher-approvals-process: fix function name (stimulus-inject) and wrap
  action in proper signal envelope with :sensor :approval-required
- Fix: list-objects-with-attribute → memory-objects-by-attribute
- Fix: org-id-new → org-id-generate
- Fix: inject-stimulus → stimulus-inject (correct function name)

Flow:
1. LLM proposes high-risk action → dispatcher returns approval-required
2. cognitive-verify collects approval request → passes to reason as :requires-approval
3. loop-gate-act creates Flight Plan → dispatches HITL message to client → exits
4. Human approves in Emacs → heartbeat re-injects with :approved t
5. Re-injected signal flows through pipeline → dispatcher passes through
6. Action executed normally
This commit is contained in:
2026-05-03 13:00:19 -04:00
parent 231c3bb445
commit 5e7b1cee33
11 changed files with 209 additions and 108 deletions

View File

@@ -241,25 +241,34 @@ This architecture makes safety compositional: each skill adds one constraint. Th
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun cognitive-verify (proposed-action context)
(let ((current-action proposed-action)
(skills nil))
"Runs all registered deterministic gates against the proposed action.
Returns either a rejection plist (for :LOG or :EVENT errors) or the
modified action (for approval-required or pass)."
(let ((current-action (copy-tree proposed-action))
(approval-needed nil)
(approval-action nil))
(maphash (lambda (name skill)
(declare (ignore name))
(when (skill-deterministic-fn skill)
(push skill skills)))
(let ((gate (skill-deterministic-fn skill)))
(when gate
(let ((result (funcall gate current-action context)))
(cond
;; Approval-required: remember it and continue checking
((eq (getf result :level) :approval-required)
(setf approval-needed t
approval-action (getf (getf result :payload) :action)))
;; Hard rejection: return immediately
((member (getf result :type) '(:LOG :EVENT))
(return-from cognitive-verify result))
;; Normal: update action
(t (setf current-action result))))))))
*skill-registry*)
(setf skills (sort skills #'> :key #'skill-priority))
(dolist (skill skills)
(let ((trigger (skill-trigger-fn skill))
(gate (skill-deterministic-fn skill)))
(when (or (null trigger) (ignore-errors (funcall trigger context)))
(let ((next-action (funcall gate current-action context)))
(when (and (listp next-action)
(member (proto-get next-action :type) '(:LOG :EVENT)))
(log-message "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
(return-from cognitive-verify next-action))
(when next-action (setf current-action next-action))))))
current-action))
(if approval-needed
(list :type :EVENT :level :approval-required
:payload (list :sensor :approval-required
:action approval-action))
current-action)))
#+end_src
** Reason Gate (Stage 2)
@@ -289,14 +298,21 @@ The retry limit prevents infinite loops. If the LLM cannot produce a passable pr
(when last-rejection
(setf (getf (getf current-signal :payload) :rejection-trace) last-rejection))
(let ((candidate (think current-signal)))
(if (and candidate (listp candidate))
(let ((verified (cognitive-verify candidate current-signal)))
(if (member (getf verified :type) '(:LOG :EVENT))
(progn (decf retries) (setf last-rejection verified))
(progn
(setf (getf signal :approved-action) verified)
(setf (getf signal :status) :reasoned)
(return signal))))
(if (and candidate (listp candidate))
(let ((verified (cognitive-verify candidate current-signal)))
;; Approval-required is not a rejection — pass to act for Flight Plan
(if (eq (getf verified :level) :approval-required)
(progn
(setf (getf signal :approved-action) verified)
(setf (getf signal :status) :requires-approval)
(return signal))
;; Hard rejection: retry with feedback
(if (member (getf verified :type) '(:LOG :EVENT))
(progn (decf retries) (setf last-rejection verified))
(progn
(setf (getf signal :approved-action) verified)
(setf (getf signal :status) :reasoned)
(return signal)))))
(progn
(setf (getf signal :approved-action) nil)
(setf (getf signal :status) :reasoned)