docs: add missing prose headlines in security-dispatcher.org HITL section
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s
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.
This commit is contained in:
@@ -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))
|
||||
|
||||
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user