feat: HITL — continuation-based human-in-the-loop

- 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

docs/.#DESIGN_DECISIONS.org

@@ -0,0 +1 @@
+user@amr.59355:1777807168

lisp/core-loop-act.lisp

@@ -97,16 +97,36 @@
       (format nil "TOOL [~a] RESULT: ~a" tool-name result)))
 
 (defun loop-gate-act (signal)
-  "Final stage of the metabolic pipeline: Actuation."
+  "Final stage of the metabolic pipeline: Actuation.
+For approval-required actions, creates a Flight Plan instead of executing."
   (let* ((approved (getf signal :approved-action))
+         (signal-status (getf signal :status))
          (type (getf signal :type))
          (meta (getf signal :meta))
          (source (getf meta :source))
          (feedback nil))
+    ;; HITL: if the approved action requires human approval,
+    ;; create a Flight Plan and notify the user via their client.
+    (when (and approved
+               (eq (getf approved :level) :approval-required))
+      (let* ((payload (getf approved :payload))
+             (blocked-action (getf payload :action)))
+        (log-message "ACT: Action requires approval — creating Flight Plan")
+        (dispatcher-flight-plan-create blocked-action)
+        (setf (getf signal :status) :suspended)
+        ;; Dispatch HITL notification to the user's client via the source actuator
+        (action-dispatch (list :target source
+                               :payload (list :text
+                                 "HITL: Action requires your approval. Check Flight Plan and set TODO to APPROVED."))
+                         signal)
+        (setf approved nil)  ;; Don't execute the original action
+        (setf feedback nil)))  ;; Don't loop back — wait for human
     (when approved
       (let* ((original-type (getf approved :type))
              (verified (cognitive-verify approved signal)))
-        (if (and (listp verified) (member (getf verified :type) '(:LOG :EVENT)) (not (member original-type '(:LOG :EVENT))))
+        (if (and (listp verified) (member (getf verified :type) '(:LOG :EVENT))
+                 (not (eq (getf verified :level) :approval-required))
+                 (not (member original-type '(:LOG :EVENT))))
             (progn
               (log-message "ACT BLOCKED: Action failed last-mile deterministic check.")
               (setf (getf signal :approved-action) nil)
@@ -145,8 +165,8 @@
 (in-suite pipeline-act-suite)
 
 (test test-loop-gate-act-basic
-  (clrhash passepartout::*skills-registry*)
+  (clrhash passepartout::*skill-registry*)
   (let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello"))))
-         (result (loop-gate-act signal)))
+          (result (loop-gate-act signal)))
     (is (eq :acted (getf signal :status)))
     (is (null result))))

lisp/core-loop-perceive.lisp

@@ -51,20 +51,29 @@
                  type (or sensor "no-sensor") (getf meta :source))
 
     (cond ((eq type :EVENT)
-           (case sensor
-             (:buffer-update
-              (let ((ast (getf payload :ast)))
-                (when ast
-                  (snapshot-memory)
-                  (ingest-ast ast))))
-             (:point-update
-              (let ((element (getf payload :element)))
-                (when element
-                  (snapshot-memory)
-                  (setf *loop-focus-id* (getf element :id))
-                  (ingest-ast element))))
-             (:interrupt
-              (setf *loop-interrupt* t))))
+            (case sensor
+              (:buffer-update
+               (let ((ast (getf payload :ast)))
+                 (when ast
+                   (snapshot-memory)
+                   (ingest-ast ast))))
+              (:point-update
+               (let ((element (getf payload :element)))
+                 (when element
+                   (snapshot-memory)
+                   (setf *loop-focus-id* (getf element :id))
+                   (ingest-ast element))))
+              (:interrupt
+               (setf *loop-interrupt* t))
+              ;; HITL: re-injected approved action from dispatcher-approvals-process
+              (:approval-required
+               (when (getf payload :approved)
+                 (log-message "GATE [Perceive]: Approved Flight Plan re-injected")
+                 (setf (getf signal :approved t))
+                 (setf (getf signal :approved-action) (getf payload :action))))
+              ;; Default sensor: pass through without requiring user-input processing
+              (otherwise
+               (log-message "GATE [Perceive]: Unknown sensor ~a, passing through" sensor))))
           ((eq type :RESPONSE)
            (log-message "GATE [Perceive]: Act Result -> ~a" (getf payload :status))))
 

lisp/core-loop-reason.lisp

@@ -92,25 +92,34 @@
             (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine."))))))
 
 (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)))
 
 (defun loop-gate-reason (signal)
   (let* ((type (proto-get signal :type))
@@ -129,14 +138,21 @@
         (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)

lisp/core-loop.lisp

@@ -24,15 +24,15 @@
           (return nil))
 
         (handler-case
-            (progn
-              (setf current-signal (perceive-gate current-signal))
-              (setf current-signal (reason-gate current-signal))
-              (let ((feedback (act-gate current-signal)))
-                (if feedback
-                    (progn
-                      (unless (getf feedback :meta) (setf (getf feedback :meta) meta))
-                      (setf current-signal feedback))
-                    (setf current-signal nil))))
+             (progn
+               (setf current-signal (perceive-gate current-signal))
+               (setf current-signal (reason-gate current-signal))
+               (let ((feedback (act-gate current-signal)))
+                 (if feedback
+                     (progn
+                       (unless (getf feedback :meta) (setf (getf feedback :meta) meta))
+                       (setf current-signal feedback))
+                     (setf current-signal nil))))
           (error (c)
             (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
               (log-message "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)

lisp/security-dispatcher.lisp

@@ -270,7 +270,8 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
                 (and (eq target :tool) (equal (proto-get payload :tool) "shell")))
             (dispatcher-check-network-exfil cmd))
         (log-message "SECURITY WARNING: External network call detected. Queuing for approval.")
-        (list :type :EVENT :payload (list :sensor :approval-required :action action)))
+        (list :type :EVENT :level :approval-required
+              :payload (list :sensor :approval-required :action action)))
 
       ;; Vector 8: High-impact action approval
       ((or (member target '(:shell))
@@ -282,7 +283,7 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
 
 (defun dispatcher-approvals-process ()
   "Scans for APPROVED flight plans and re-injects them."
-  (let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
+  (let ((approved-nodes (memory-objects-by-attribute :TODO "APPROVED"))
         (found-any nil))
     (dolist (node approved-nodes)
       (let* ((attrs (memory-object-attributes node))
@@ -293,14 +294,18 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
           (let ((action (ignore-errors (read-from-string action-str))))
             (when action
               (setf (getf action :approved) t)
-              (inject-stimulus action)
+              (stimulus-inject (list :type :EVENT
+                                     :payload (list :sensor :approval-required
+                                                    :action action
+                                                    :approved t)
+                                     :meta (list :source :system)))
               (setf (getf (memory-object-attributes node) :TODO) "DONE")
               (setq found-any t))))))
     found-any))
 
 (defun dispatcher-flight-plan-create (blocked-action)
   "Creates a Flight Plan node for manual approval."
-  (let ((id (org-id-new)))
+  (let ((id (org-id-generate)))
     (log-message "BOUNCER: Creating flight plan node '~a'..." id)
     (list :type :REQUEST :target :emacs
           :payload (list :action :insert-node :id id

org/core-loop-act.org

@@ -196,16 +196,36 @@ After dispatch, the gate captures any feedback produced by the actuation (tool o
 ;; REPL-VERIFIED: 2026-05-03T13:00:00
 #+begin_src lisp
 (defun loop-gate-act (signal)
-  "Final stage of the metabolic pipeline: Actuation."
+  "Final stage of the metabolic pipeline: Actuation.
+For approval-required actions, creates a Flight Plan instead of executing."
   (let* ((approved (getf signal :approved-action))
+         (signal-status (getf signal :status))
          (type (getf signal :type))
          (meta (getf signal :meta))
          (source (getf meta :source))
          (feedback nil))
+    ;; HITL: if the approved action requires human approval,
+    ;; create a Flight Plan and notify the user via their client.
+    (when (and approved
+               (eq (getf approved :level) :approval-required))
+      (let* ((payload (getf approved :payload))
+             (blocked-action (getf payload :action)))
+        (log-message "ACT: Action requires approval — creating Flight Plan")
+        (dispatcher-flight-plan-create blocked-action)
+        (setf (getf signal :status) :suspended)
+        ;; Dispatch HITL notification to the user's client via the source actuator
+        (action-dispatch (list :target source
+                               :payload (list :text
+                                 "HITL: Action requires your approval. Check Flight Plan and set TODO to APPROVED."))
+                         signal)
+        (setf approved nil)  ;; Don't execute the original action
+        (setf feedback nil)))  ;; Don't loop back — wait for human
     (when approved
       (let* ((original-type (getf approved :type))
              (verified (cognitive-verify approved signal)))
-        (if (and (listp verified) (member (getf verified :type) '(:LOG :EVENT)) (not (member original-type '(:LOG :EVENT))))
+        (if (and (listp verified) (member (getf verified :type) '(:LOG :EVENT))
+                 (not (eq (getf verified :level) :approval-required))
+                 (not (member original-type '(:LOG :EVENT))))
             (progn
               (log-message "ACT BLOCKED: Action failed last-mile deterministic check.")
               (setf (getf signal :approved-action) nil)
@@ -248,9 +268,9 @@ Verifies that the act gate correctly processes an approved action and sets the s
 (in-suite pipeline-act-suite)
 
 (test test-loop-gate-act-basic
-  (clrhash passepartout::*skills-registry*)
+  (clrhash passepartout::*skill-registry*)
   (let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello"))))
-         (result (loop-gate-act signal)))
+          (result (loop-gate-act signal)))
     (is (eq :acted (getf signal :status)))
     (is (null result))))
 #+end_src

org/core-loop-perceive.org

@@ -128,20 +128,29 @@ All signals get tagged with their processing stage (`:status :perceived`) and th
                  type (or sensor "no-sensor") (getf meta :source))
 
     (cond ((eq type :EVENT)
-           (case sensor
-             (:buffer-update
-              (let ((ast (getf payload :ast)))
-                (when ast
-                  (snapshot-memory)
-                  (ingest-ast ast))))
-             (:point-update
-              (let ((element (getf payload :element)))
-                (when element
-                  (snapshot-memory)
-                  (setf *loop-focus-id* (getf element :id))
-                  (ingest-ast element))))
-             (:interrupt
-              (setf *loop-interrupt* t))))
+            (case sensor
+              (:buffer-update
+               (let ((ast (getf payload :ast)))
+                 (when ast
+                   (snapshot-memory)
+                   (ingest-ast ast))))
+              (:point-update
+               (let ((element (getf payload :element)))
+                 (when element
+                   (snapshot-memory)
+                   (setf *loop-focus-id* (getf element :id))
+                   (ingest-ast element))))
+              (:interrupt
+               (setf *loop-interrupt* t))
+              ;; HITL: re-injected approved action from dispatcher-approvals-process
+              (:approval-required
+               (when (getf payload :approved)
+                 (log-message "GATE [Perceive]: Approved Flight Plan re-injected")
+                 (setf (getf signal :approved t))
+                 (setf (getf signal :approved-action) (getf payload :action))))
+              ;; Default sensor: pass through without requiring user-input processing
+              (otherwise
+               (log-message "GATE [Perceive]: Unknown sensor ~a, passing through" sensor))))
           ((eq type :RESPONSE)
            (log-message "GATE [Perceive]: Act Result -> ~a" (getf payload :status))))
 

org/core-loop-reason.org

@@ -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)

org/core-loop.org

@@ -95,15 +95,15 @@ The function handles four failure modes:
           (return nil))
 
         (handler-case
-            (progn
-              (setf current-signal (perceive-gate current-signal))
-              (setf current-signal (reason-gate current-signal))
-              (let ((feedback (act-gate current-signal)))
-                (if feedback
-                    (progn
-                      (unless (getf feedback :meta) (setf (getf feedback :meta) meta))
-                      (setf current-signal feedback))
-                    (setf current-signal nil))))
+             (progn
+               (setf current-signal (perceive-gate current-signal))
+               (setf current-signal (reason-gate current-signal))
+               (let ((feedback (act-gate current-signal)))
+                 (if feedback
+                     (progn
+                       (unless (getf feedback :meta) (setf (getf feedback :meta) meta))
+                       (setf current-signal feedback))
+                     (setf current-signal nil))))
           (error (c)
             (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
               (log-message "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)

org/security-dispatcher.org

@@ -388,7 +388,8 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
                 (and (eq target :tool) (equal (proto-get payload :tool) "shell")))
             (dispatcher-check-network-exfil cmd))
         (log-message "SECURITY WARNING: External network call detected. Queuing for approval.")
-        (list :type :EVENT :payload (list :sensor :approval-required :action action)))
+        (list :type :EVENT :level :approval-required
+              :payload (list :sensor :approval-required :action action)))
 
       ;; Vector 8: High-impact action approval
       ((or (member target '(:shell))
@@ -405,7 +406,7 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
 #+begin_src lisp
 (defun dispatcher-approvals-process ()
   "Scans for APPROVED flight plans and re-injects them."
-  (let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
+  (let ((approved-nodes (memory-objects-by-attribute :TODO "APPROVED"))
         (found-any nil))
     (dolist (node approved-nodes)
       (let* ((attrs (memory-object-attributes node))
@@ -416,7 +417,11 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
           (let ((action (ignore-errors (read-from-string action-str))))
             (when action
               (setf (getf action :approved) t)
-              (inject-stimulus action)
+              (stimulus-inject (list :type :EVENT
+                                     :payload (list :sensor :approval-required
+                                                    :action action
+                                                    :approved t)
+                                     :meta (list :source :system)))
               (setf (getf (memory-object-attributes node) :TODO) "DONE")
               (setq found-any t))))))
     found-any))
@@ -427,7 +432,7 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
 #+begin_src lisp
 (defun dispatcher-flight-plan-create (blocked-action)
   "Creates a Flight Plan node for manual approval."
-  (let ((id (org-id-new)))
+  (let ((id (org-id-generate)))
     (log-message "BOUNCER: Creating flight plan node '~a'..." id)
     (list :type :REQUEST :target :emacs
           :payload (list :action :insert-node :id id