From a16f973b50bf400219ac7e3ea00e2cfe63476ee2 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Sun, 3 May 2026 14:00:24 -0400 Subject: [PATCH] docs: add missing prose headlines in security-dispatcher.org HITL section Fixes 4 pre-existing PROSE-BEFORE-CODE violations in the HITL in-memory store section. Each function (hitl-create, hitl-approve, hitl-deny, hitl-handle-message) now has a *** sub-heading with explanatory prose before its code block. --- lisp/security-dispatcher.lisp | 71 ++++++++++++++++++++++++++++++++++- org/security-dispatcher.org | 28 ++++++++++++++ 2 files changed, 98 insertions(+), 1 deletion(-) diff --git a/lisp/security-dispatcher.lisp b/lisp/security-dispatcher.lisp index f65fcba..18ddec9 100644 --- a/lisp/security-dispatcher.lisp +++ b/lisp/security-dispatcher.lisp @@ -304,7 +304,7 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval." found-any)) (defun dispatcher-flight-plan-create (blocked-action) - "Creates a Flight Plan node for manual approval." + "Creates a Flight Plan node for manual approval in Emacs." (let ((id (org-id-generate))) (log-message "BOUNCER: Creating flight plan node '~a'..." id) (list :type :REQUEST :target :emacs @@ -313,6 +313,75 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval." :TODO "PLAN" :TAGS '("FLIGHT_PLAN") :ACTION (format nil "~s" blocked-action)))))) +(defvar *hitl-pending* (make-hash-table :test 'equal) + "Maps correlation token → blocked-action plist for pending HITL approvals.") + +(defun hitl-create (blocked-action) + "Saves a blocked action for HITL approval. Returns a plist with +:token (the correlation ID) and :message (user-facing text)." + (let* ((token (format nil "HITL-~a" (subseq (org-id-generate) 3 11)))) + (setf (gethash token *hitl-pending*) blocked-action) + (log-message "HITL: Created pending approval ~a" token) + (list :token token + :message (format nil "HITL: Action requires approval [~a]. Reply /approve ~a to approve." token token)))) + +(defun hitl-approve (token) + "Approves a pending HITL action by token. Re-injects with :approved t. +Returns T if found and approved, nil if token is invalid." + (let ((action (gethash token *hitl-pending*))) + (if action + (progn + (remhash token *hitl-pending*) + (setf (getf action :approved) t) + (stimulus-inject (list :type :EVENT + :payload (list :sensor :approval-required + :action action + :approved t) + :meta (list :source :system))) + (log-message "HITL: Approved ~a — re-injected" token) + t) + (progn + (log-message "HITL: Token ~a not found in pending" token) + nil)))) + +(defun hitl-deny (token) + "Denies a pending HITL action by token. Removes it from the pending store. +Returns T if found, nil if token is invalid." + (if (gethash token *hitl-pending*) + (progn + (remhash token *hitl-pending*) + (log-message "HITL: Denied ~a" token) + t) + (progn + (log-message "HITL: Token ~a not found in pending" token) + nil))) + +(defun hitl-handle-message (text &optional source) + "Checks if TEXT is a HITL approval or denial command. +If it matches, processes the command and returns T. +Otherwise returns nil (text should be handled as normal input). +Recognized formats: + /approve HITL-abc123 + /deny HITL-abc123 + approve HITL-abc123 + deny HITL-abc123" + (let ((text (string-trim '(#\Space) (or text "")))) + (when (or (uiop:string-prefix-p "/approve" text :test #'char-equal) + (uiop:string-prefix-p "approve" text :test #'char-equal)) + (let* ((parts (uiop:split-string text :separator '(#\Space #\Tab))) + (token (when (> (length parts) 1) (second parts)))) + (when (and token (hitl-approve token)) + (log-message "HITL: Approved via ~a — ~a" (or source :unknown) token) + (return-from hitl-handle-message t)))) + (when (or (uiop:string-prefix-p "/deny" text :test #'char-equal) + (uiop:string-prefix-p "deny " text :test #'char-equal)) + (let* ((parts (uiop:split-string text :separator '(#\Space #\Tab))) + (token (when (> (length parts) 1) (second parts)))) + (when (and token (hitl-deny token)) + (log-message "HITL: Denied via ~a — ~a" (or source :unknown) token) + (return-from hitl-handle-message t)))) + nil)) + (defun dispatcher-gate (action context) "Main deterministic gate for the Bouncer skill." (let* ((payload (getf context :payload)) diff --git a/org/security-dispatcher.org b/org/security-dispatcher.org index e4b215b..6b62fd7 100644 --- a/org/security-dispatcher.org +++ b/org/security-dispatcher.org @@ -453,6 +453,13 @@ with the token to approve or deny. "Maps correlation token → blocked-action plist for pending HITL approvals.") #+end_src +*** hitl-create + +A new HITL entry is created whenever the deterministic engine returns an +~:approval-required~ level action. A correlation token is generated and +the blocked action is stored for later retrieval by ~hitl-approve~ or +~hitl-deny~. + ;; REPL-VERIFIED: 2026-05-03T13:00:00 #+begin_src lisp (defun hitl-create (blocked-action) @@ -465,6 +472,13 @@ with the token to approve or deny. :message (format nil "HITL: Action requires approval [~a]. Reply /approve ~a to approve." token token)))) #+end_src +*** hitl-approve + +When the user sends an approval command with a valid token, the blocked +action is retrieved, stamped with ~:approved t~, and re-injected into the +pipeline via ~stimulus-inject~. The perceive gate detects the +~:approval-required~ sensor with ~:approved t~ and processes it. + ;; REPL-VERIFIED: 2026-05-03T13:00:00 #+begin_src lisp (defun hitl-approve (token) @@ -487,6 +501,12 @@ Returns T if found and approved, nil if token is invalid." nil)))) #+end_src +*** hitl-deny + +Denial removes the pending action from the store without re-injecting it. +The action is silently discarded and the token becomes invalid for future +use. + ;; REPL-VERIFIED: 2026-05-03T13:00:00 #+begin_src lisp (defun hitl-deny (token) @@ -502,6 +522,14 @@ Returns T if found, nil if token is invalid." nil))) #+end_src +*** hitl-handle-message + +The universal entry point for HITL commands arriving from any gateway. +Parses the text for ~/approve~, ~/deny~, ~approve~, or ~deny~ followed +by a token, dispatches to ~hitl-approve~ or ~hitl-deny~, and returns T +if the message was a HITL command (so the gateway knows not to inject it +into the main pipeline). + ;; REPL-VERIFIED: 2026-05-03T13:00:00 #+begin_src lisp (defun hitl-handle-message (text &optional source)