amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

fix(protocol): Make validator case-insensitive and normalize actuation keywords
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
Details

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-19 19:44:26 -04:00
parent 2149d81c5f
commit 5ad02f6f2e
4 changed files with 77 additions and 144 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
src/act.lisp
View File

@@ -70,10 +70,10 @@
(dispatch-action (list :TYPE :CHAT :TEXT (format nil "TOOL [~a] RESULT: ~a" tool-name result)) context))
feedback))
(error (c)
(list :type :EVENT :depth (1+ depth) :reply-stream (getf context :reply-stream)
:payload (list :sensor :tool-error :tool tool-name :message (format nil "~a" c)))))
(list :type :EVENT :depth (1+ depth) :reply-stream (getf context :reply-stream)
:payload (list :sensor :tool-error :message "Tool not found")))))
(list :TYPE :EVENT :DEPTH (1+ depth) :REPLY-STREAM (proto-get context :REPLY-STREAM)
:PAYLOAD (list :SENSOR :tool-error :tool tool-name :message (format nil "~a" c)))))
(list :TYPE :EVENT :DEPTH (1+ depth) :REPLY-STREAM (proto-get context :REPLY-STREAM)
:PAYLOAD (list :SENSOR :tool-error :message "Tool not found")))))
(defun act-gate (signal)
"Final Stage: Actuation and feedback generation."
@@ -110,7 +110,7 @@
(cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
(setf feedback result))
((and result (not (member target *silent-actuators*)))
(setf feedback (list :type :EVENT :depth (1+ (or (proto-get signal :depth) 0))
(setf feedback (list :TYPE :EVENT :depth (1+ (or (proto-get signal :depth) 0))
:reply-stream (proto-get signal :reply-stream)
:payload (list :sensor :tool-output :result result :tool approved))))))
;; If no approved action but we have a reply-stream, this might be a raw event/log stimulus.

12
src/communication-validator.lisp
View File

@@ -5,26 +5,26 @@
(unless (listp msg)
(error "Communication Protocol Schema Error: Message must be a property list (got ~s)" (type-of msg)))
(let ((type (getf msg :type)))
(let ((type (proto-get msg :type)))
(unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS))
(error "Communication Protocol Schema Error: Invalid message type '~a'" type))
(case type
(:REQUEST
(unless (getf msg :target)
(unless (proto-get msg :target)
(error "Communication Protocol Schema Error: REQUEST missing mandatory :target"))
(unless (getf msg :payload)
(unless (proto-get msg :payload)
(error "Communication Protocol Schema Error: REQUEST missing mandatory :payload")))
(:EVENT
(let ((payload (getf msg :payload)))
(let ((payload (proto-get msg :payload)))
(unless (and payload (listp payload))
(error "Communication Protocol Schema Error: EVENT missing or invalid :payload"))
(unless (or (getf payload :action) (getf payload :sensor))
(unless (or (proto-get payload :action) (proto-get payload :sensor))
(error "Communication Protocol Schema Error: EVENT payload must contain :action or :sensor"))))
(:RESPONSE
(unless (getf msg :payload)
(unless (proto-get msg :payload)
(error "Communication Protocol Schema Error: RESPONSE missing mandatory :payload"))))
t))