Amr Gharbeia
96370cc4b1
Per-tool timeouts: shell=300s, search-files=30s, eval-form=10s, unknown=120s default. Write verification: after write-file, reads back content and compares, logs mismatches. - core-act: *tool-timeouts* hash, tool-timeout, verify-write - programming-tools: verify-write call in write-file body - Act tests: +3 (timeout shell, timeout unknown, verify match) - Core: 84/84
411 lines
18 KiB
Org Mode
411 lines
18 KiB
Org Mode
#+TITLE: Stage 3: Act (act.lisp)
|
|
#+AUTHOR: Agent
|
|
#+FILETAGS: :harness:act:
|
|
#+STARTUP: content
|
|
#+PROPERTY: header-args:lisp :tangle ../lisp/core-act.lisp
|
|
|
|
* Overview: Architectural Intent
|
|
|
|
The Act stage is where cognition meets reality. After the Probabilistic engine proposes an action and the Deterministic engine verifies it, Act executes it through the appropriate actuator.
|
|
|
|
An actuator is a function that takes (action context) and performs a physical operation: send a message to the TUI, execute a shell command, call a Telegram API, write to a file. Actuators are registered in a global hash table (~*actuator-registry*~) and dispatched by name.
|
|
|
|
The key architectural choice: **actuators are not privileged**. The same dispatch mechanism that routes to :shell or :file also routes to :telegram or :signal. There is no special handling for dangerous actuators — safety is enforced at the Reason stage by the deterministic engine, not by Act. This means:
|
|
|
|
1. Adding a new actuator requires no changes to the core — just register it
|
|
2. Safety is centralized in the deterministic gates, not scattered across actuator implementations
|
|
3. Every actuator benefits from the same security checks (the Dispatcher, the Policy)
|
|
|
|
** Why Dispatch-Action Verifies Again?
|
|
|
|
The Reason stage already ran every proposed action through the deterministic engine. So why does ~loop-gate-act~ call ~cognitive-verify~ again?
|
|
|
|
Because a skill's deterministic gate runs during Reason, but between Reason and Act, the action might have been transformed by the pipeline (metadata added, format normalized). The last-mile verification catches any transformation that might have introduced an unsafe property. It's the same philosophy as "trust but verify" — the second check is cheap and catches a class of bugs that would otherwise be silent data corruption.
|
|
|
|
** Contract
|
|
|
|
1. (loop-gate-act signal): the final pipeline stage. Handles HITL
|
|
~:approval-required~ (suspends action), runs last-mile
|
|
~cognitive-verify~ on approved actions, dispatches via
|
|
~action-dispatch~, sets ~:status :acted~, returns feedback.
|
|
2. (act-gate signal): thin alias for ~loop-gate-act~.
|
|
3. (action-dispatch approved signal): routes approved actions to
|
|
registered actuators by ~:target~ keyword.
|
|
|
|
* Implementation
|
|
|
|
** Package Context
|
|
#+begin_src lisp
|
|
(in-package :passepartout)
|
|
#+end_src
|
|
|
|
** Actuator Configuration
|
|
|
|
~*actuator-default*~ determines where actions go when no explicit target is specified. Defaults to ~:cli~.
|
|
|
|
~*actuator-silent*~ lists actuator targets that don't generate tool-output feedback. For example, sending a message to the CLI or Emacs doesn't need to produce a tool-output event — the user can see the message directly. This prevents redundant feedback loops.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defvar *actuator-default* :cli
|
|
"The actuator used when no explicit target is specified.")
|
|
|
|
#+end_src
|
|
** *actuator-silent*
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defvar *actuator-silent* '(:cli :system-message :emacs)
|
|
"List of actuators that don't generate tool-output feedback.")
|
|
|
|
#+end_src
|
|
** actuator-initialize
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun actuator-initialize ()
|
|
"Register core actuators and load configuration."
|
|
(let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
|
|
(silent (uiop:getenv "SILENT_ACTUATORS")))
|
|
(when def
|
|
(setf *actuator-default* (intern (string-upcase def) :keyword)))
|
|
(when silent
|
|
(setf *actuator-silent*
|
|
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword))
|
|
(uiop:split-string silent :separator '(#\,))))))
|
|
|
|
(register-actuator :system #'action-system-execute)
|
|
(register-actuator :tool #'action-tool-execute)
|
|
|
|
(register-actuator :tui (lambda (action context)
|
|
(declare (ignore context))
|
|
(let* ((meta (getf action :meta))
|
|
(stream (getf meta :reply-stream)))
|
|
(when (and stream (open-stream-p stream))
|
|
;; Enrich response with differentiator visualization data
|
|
(setf (getf (getf action :payload) :rule-count)
|
|
(if (boundp '*hitl-pending*)
|
|
(hash-table-count *hitl-pending*)
|
|
0))
|
|
(setf (getf (getf action :payload) :foveal-id)
|
|
(getf context :foveal-id))
|
|
(format stream "~a" (frame-message action))
|
|
(finish-output stream))))))
|
|
#+end_src
|
|
|
|
** TUI Differentiator Enrichment (v0.4.0)
|
|
|
|
The TUI actuator is the last point in the pipeline before the response leaves the daemon. It enriches the action plist with fields that power the TUI's differentiator visualizations:
|
|
|
|
- ~:rule-count~ = ~(hash-table-count *hitl-pending*)~ — the number of pending HITL actions. The user watches this counter tick as they teach the agent their preferences.
|
|
- ~:foveal-id~ = the current foveal focus from the signal context — enables the TUI's focus map status line.
|
|
- ~:gate-trace~ — already attached by ~cognitive-verify~, flows through the action plist unchanged.
|
|
#+end_src
|
|
|
|
** Action Dispatch (action-dispatch)
|
|
|
|
Routes an approved action to its registered actuator. The target is resolved in priority order:
|
|
|
|
1. The explicit ~:target~ field on the action
|
|
2. The source of the original signal (reply to the sender)
|
|
3. The default actuator (~:cli~)
|
|
|
|
Heartbeats are silently dropped here — they should never generate an actuation.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun action-dispatch (action context)
|
|
"Route an approved action to its registered actuator."
|
|
(let ((payload (proto-get action :payload)))
|
|
(when (eq (proto-get payload :sensor) :heartbeat)
|
|
(return-from action-dispatch nil))
|
|
|
|
(when (and action (listp action))
|
|
(let* ((meta (proto-get context :meta))
|
|
(source (proto-get meta :source))
|
|
(raw-target (or (proto-get action :target) source *actuator-default*))
|
|
(target (intern (string-upcase (string raw-target)) :keyword))
|
|
;; If target is :SYSTEM and we have a live reply-stream, route to :TUI instead
|
|
(actual-target (if (and (eq target :system)
|
|
(getf meta :reply-stream)
|
|
(ignore-errors (open-stream-p (getf meta :reply-stream))))
|
|
:tui
|
|
target))
|
|
(actuator-fn (gethash actual-target *actuator-registry*)))
|
|
(when (and meta (null (getf action :meta)))
|
|
(setf (getf action :meta) meta))
|
|
(if actuator-fn
|
|
(funcall actuator-fn action context)
|
|
(log-message "ACT ERROR: No actuator registered for '~s'" actual-target))))))
|
|
#+end_src
|
|
|
|
** System Actuator (action-system-execute)
|
|
|
|
Handles internal harness commands: ~:eval~ (execute arbitrary Lisp) and ~:message~ (log to the harness log). This is how the deterministic engine communicates results back to the user.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun action-system-execute (action context)
|
|
"Execute internal harness commands."
|
|
(declare (ignore context))
|
|
(let* ((payload (getf action :payload))
|
|
(cmd (getf payload :action)))
|
|
(case cmd
|
|
(:eval
|
|
(eval (let ((*read-eval* nil)) (read-from-string (getf payload :code)))))
|
|
(:message
|
|
(log-message "ACT [System]: ~a" (getf payload :text)))
|
|
(t
|
|
(log-message "ACT ERROR [System]: Unknown command '~s'" cmd)))))
|
|
#+end_src
|
|
|
|
** Tool Actuator (action-tool-execute)
|
|
|
|
Executes a registered cognitive tool. Cognitive tools are registered via ~def-cognitive-tool~ in the package.lisp and are the primary way the LLM interacts with the outside world.
|
|
|
|
The function handles:
|
|
- Tool dispatch by name (case-insensitive lookup)
|
|
- Argument normalization (if the arguments are nested in a list, they're flattened)
|
|
- Result formatting (structured results are sent back to the source)
|
|
- Error handling (tool errors produce ~:tool-error~ events, not crashes)
|
|
|
|
The tool's return value is packed into a ~:tool-output~ event and fed back into the pipeline, where it becomes the next perception. This is how the agent "sees" the result of its actions.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun action-tool-execute (action context)
|
|
"Execute a registered cognitive tool."
|
|
(let* ((payload (getf action :payload))
|
|
(tool-name (getf payload :tool))
|
|
(tool-args (getf payload :args))
|
|
(depth (getf context :depth 0))
|
|
(meta (getf context :meta))
|
|
(source (getf meta :source))
|
|
(tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
|
|
;; v0.7.2: snapshot before destructive tool execution
|
|
(when (and tool (not (cognitive-tool-read-only-p tool)))
|
|
(undo-snapshot))
|
|
(if tool
|
|
(handler-case
|
|
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))
|
|
(result (funcall (cognitive-tool-body tool) clean-args)))
|
|
(when source
|
|
(action-dispatch (list :TYPE :REQUEST :TARGET source
|
|
:PAYLOAD (list :ACTION :MESSAGE :TEXT (tool-result-format tool-name result)))
|
|
context))
|
|
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
|
|
:PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name)))
|
|
(error (c)
|
|
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
|
|
:PAYLOAD (list :SENSOR :tool-error :TOOL tool-name :MESSAGE (format nil "~a" c)))))
|
|
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
|
|
:PAYLOAD (list :SENSOR :tool-error :MESSAGE (format nil "Tool '~a' not found" tool-name))))))
|
|
#+end_src
|
|
|
|
** v0.7.2 — Tool Execution Hardening
|
|
#+begin_src lisp
|
|
(defvar *tool-timeouts* (make-hash-table :test 'equal)
|
|
"Per-tool timeout in seconds. Default 120s.")
|
|
|
|
;; Defaults: shell=300s, search-files=30s, eval-form=10s
|
|
(setf (gethash "shell" *tool-timeouts*) 300)
|
|
(setf (gethash "search-files" *tool-timeouts*) 30)
|
|
(setf (gethash "eval-form" *tool-timeouts*) 10)
|
|
|
|
(defun tool-timeout (tool-name)
|
|
"Return timeout for tool-name, default 120 seconds."
|
|
(gethash (string-downcase (string tool-name)) *tool-timeouts* 120))
|
|
|
|
(defun verify-write (filepath expected-content)
|
|
"Verify that FILEPATH contains EXPECTED-CONTENT after write.
|
|
Returns T on match, logs and returns NIL on mismatch or read error."
|
|
(handler-case
|
|
(let ((actual (uiop:read-file-string filepath)))
|
|
(if (string= expected-content actual)
|
|
t
|
|
(progn
|
|
(log-message "WRITE-VERIFY: Mismatch in ~a" filepath)
|
|
nil)))
|
|
(error (c)
|
|
(log-message "WRITE-VERIFY: Cannot read ~a: ~a" filepath c)
|
|
nil)))
|
|
#+end_src
|
|
|
|
** Tool Result Formatting (tool-result-format)
|
|
|
|
Converts a tool's return value into a human-readable string for display to the user. Handles structured results (plists with ~:status~, ~:content~, ~:message~) and plain values.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun tool-result-format (tool-name result)
|
|
"Format a tool result for display."
|
|
(if (listp result)
|
|
(let ((status (getf result :status))
|
|
(content (getf result :content))
|
|
(msg (getf result :message)))
|
|
(cond
|
|
((and (eq status :success) content) (format nil "~a" content))
|
|
((and (eq status :error) msg) (format nil "ERROR [~a]: ~a" tool-name msg))
|
|
(t (format nil "TOOL [~a] RESULT: ~s" tool-name result))))
|
|
(format nil "TOOL [~a] RESULT: ~a" tool-name result)))
|
|
#+end_src
|
|
|
|
** Act Gate (Stage 3)
|
|
|
|
The final stage of the metabolic pipeline. It receives a signal that has been reasoned (has an ~:approved-action~) and dispatches it.
|
|
|
|
The gate runs a last-mile deterministic check on the approved action before execution. This catches any issues introduced during pipeline processing (e.g., metadata added by Perceive that changes the action's format).
|
|
|
|
After dispatch, the gate captures any feedback produced by the actuation (tool output, error events) and returns it to the loop for the next cognitive cycle.
|
|
|
|
*** loop-gate-act
|
|
|
|
The main act pipeline stage.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun loop-gate-act (signal)
|
|
"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 (Emacs) and HITL entry (all gateways).
|
|
(when (and approved
|
|
(eq (getf approved :level) :approval-required))
|
|
(let* ((payload (getf approved :payload))
|
|
(blocked-action (getf payload :action))
|
|
(hitl (hitl-create blocked-action)))
|
|
(log-message "ACT: Action requires approval — creating Flight Plan + HITL (~a)" (getf hitl :token))
|
|
(dispatcher-flight-plan-create blocked-action)
|
|
(setf (getf signal :status) :suspended)
|
|
(action-dispatch (list :target source
|
|
:payload (list :text (getf hitl :message)))
|
|
signal)
|
|
(setf approved nil)
|
|
(setf feedback nil)))
|
|
(when approved
|
|
(let* ((original-type (getf approved :type))
|
|
(verified (cognitive-verify approved signal)))
|
|
(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)
|
|
(setf feedback verified))
|
|
(progn
|
|
(setf (getf signal :approved-action) verified)
|
|
(setf approved verified)))))
|
|
|
|
(case type
|
|
(:REQUEST (action-dispatch signal signal))
|
|
(:LOG (action-dispatch signal signal))
|
|
(:EVENT
|
|
(if approved
|
|
(let* ((target (getf approved :target))
|
|
(result (action-dispatch approved signal)))
|
|
(cond
|
|
((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
|
|
(setf feedback result))
|
|
((and result (not (member target *actuator-silent*)))
|
|
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
|
|
:payload (list :sensor :tool-output :result result :tool approved))))))
|
|
(when source (action-dispatch signal signal)))))
|
|
(setf (getf signal :status) :acted)
|
|
feedback))
|
|
#+end_src
|
|
|
|
*** act-gate (backward-compatibility alias)
|
|
|
|
The pipeline gate was originally named ~act-gate~. Code that still
|
|
uses the old name can call this alias. New code should call
|
|
~loop-gate-act~.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun act-gate (signal)
|
|
(loop-gate-act signal))
|
|
#+end_src
|
|
|
|
* Test Suite
|
|
Verifies that the act gate correctly processes an approved action and sets the signal status to ~:acted~.
|
|
#+begin_src lisp
|
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
(ql:quickload :fiveam :silent t))
|
|
|
|
(defpackage :passepartout-pipeline-act-tests
|
|
(:use :cl :fiveam :passepartout)
|
|
(:export #:pipeline-act-suite))
|
|
|
|
(in-package :passepartout-pipeline-act-tests)
|
|
|
|
(def-suite pipeline-act-suite :description "Test suite for Act pipeline")
|
|
(in-suite pipeline-act-suite)
|
|
|
|
(test test-loop-gate-act-basic
|
|
"Contract 1: approved action reaches :acted status via loop-gate-act."
|
|
(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)))
|
|
(is (eq :acted (getf signal :status)))
|
|
(is (null result))))
|
|
|
|
(test test-loop-gate-act-no-approved-action
|
|
"Contract 1: signal with no approved-action still reaches :acted status."
|
|
(clrhash passepartout::*skill-registry*)
|
|
(let* ((signal (list :type :EVENT :status nil :depth 0)))
|
|
(loop-gate-act signal)
|
|
(is (eq :acted (getf signal :status)))))
|
|
|
|
(test test-loop-gate-act-last-mile-reject
|
|
"Contract 1: last-mile cognitive-verify rejection blocks approved-action."
|
|
(clrhash passepartout::*skill-registry*)
|
|
(passepartout::defskill :mock-blocker
|
|
:priority 50
|
|
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
|
:deterministic (lambda (action ctx)
|
|
(declare (ignore ctx action))
|
|
(list :type :LOG :payload (list :text "Last-mile block"))))
|
|
(let* ((signal (list :type :EVENT :status nil :depth 0
|
|
:approved-action '(:type :REQUEST :target :cli :payload (:text "blocked")))))
|
|
(loop-gate-act signal)
|
|
(is (eq :acted (getf signal :status)))
|
|
(is (null (getf signal :approved-action)))))
|
|
|
|
(test test-loop-gate-act-preserves-meta
|
|
"Contract 1: signal metadata is not mutated by loop-gate-act."
|
|
(clrhash passepartout::*skill-registry*)
|
|
(let* ((meta '(:source :tui :session "s1"))
|
|
(signal (list :type :EVENT :status nil :depth 0 :meta meta
|
|
:approved-action '(:target :cli :payload (:text "test")))))
|
|
(loop-gate-act signal)
|
|
(is (equal meta (getf signal :meta)))))
|
|
|
|
(test test-action-dispatch-routes
|
|
"Contract 3: action-dispatch routes to registered actuators without crashing."
|
|
(actuator-initialize)
|
|
(let ((result (action-dispatch '(:type :REQUEST :target :system :payload (:action :eval :code "(+ 1 2)"))
|
|
'(:type :EVENT :depth 0))))
|
|
(is (numberp result) "eval should return a number")))
|
|
|
|
(test test-tool-timeout-shell
|
|
"Contract v0.7.2: shell timeout is 300 seconds."
|
|
(is (= 300 (passepartout::tool-timeout "shell"))))
|
|
|
|
(test test-tool-timeout-unknown
|
|
"Contract v0.7.2: unknown tool gets default 120s."
|
|
(is (= 120 (passepartout::tool-timeout "nonexistent-tool"))))
|
|
|
|
(test test-verify-write-match
|
|
"Contract v0.7.2: verify-write returns T on match."
|
|
(let ((path "/tmp/passepartout-verify-test.org")
|
|
(content "test content"))
|
|
(with-open-file (f path :direction :output :if-exists :supersede)
|
|
(write-string content f))
|
|
(unwind-protect
|
|
(is (passepartout::verify-write path content))
|
|
(ignore-errors (delete-file path)))))
|
|
#+end_src |