v0.8.2: cleanup + prose + structure + decomposition + budget + errors
Phase 1 — dedup + hardening (~9 items): - Remove duplicate *skill-registry* defvar from core-skills - Merge *backend-registry* into *probabilistic-backends*, delete backend-register - Remove inject-stimulus alias, standardize on stimulus-inject - Add pre-eval sandbox (skill-source-scan) blocks restricted symbols before eval - Remove dead plist-get function; remove duplicate json-alist-to-plist export - Fix read-framed-message whitespace DoS (4096-iteration max) - Add *read-eval* nil to dispatcher-approvals-process read-from-string (RCE) - Add test-op to ASDF; update .asd version 0.4.3→0.7.2 Phase 2 — prose + contracts + reorder: - Split ROADMAP: 2623→1089 lines (TODO only), CHANGELOG: 260→1528 lines (full DONE history, 14 versions reverse chron) - Add Contracts + Overview to 6 channel files + embedding-native + programming-standards + symbolic-scope - Reorder 28 .org files: Contract → Test Suite → Implementation (TDD order) - Add 7-phase inline prose to think() in core-reason - Expand USER_MANUAL: 183→461 lines (10 new sections) Phase 3 — decomposition + export organization: - Decompose think() into think-assemble-prompt, think-call-llm, think-parse-response orchestrator - Organize 188 exports into 16 grouped sections by module Phase 4 — budget enforcement + error protocol: - Per-session budget enforcement (SESSION_BUDGET_USD env var, budget-exhausted-p, guard in think-call-llm) - Error condition hierarchy (6 conditions: pipeline-error, llm-error, gate-error, budget-error, protocol-error) - Restarts in loop-process: skip-signal, use-fallback, abort-pipeline
This commit is contained in:
@@ -39,6 +39,53 @@ The 6-character hex length supports messages up to ~16MB (0xFFFFFF bytes). This
|
||||
3. Round-trip invariant: ~(read-framed-message (make-string-input-stream
|
||||
(frame-message msg)))~ equals ~msg~.
|
||||
|
||||
* Test Suite
|
||||
Verifies that the framing protocol correctly serializes and deserializes messages.
|
||||
#+begin_src lisp
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
(defpackage :passepartout-communication-tests
|
||||
(:use :cl :fiveam :passepartout)
|
||||
(:export #:communication-protocol-suite))
|
||||
(in-package :passepartout-communication-tests)
|
||||
|
||||
(def-suite communication-protocol-suite :description "Communication Protocol Suite")
|
||||
(in-suite communication-protocol-suite)
|
||||
|
||||
(test test-framing
|
||||
"Contract 1: frame-message produces correct hex length prefix."
|
||||
(let* ((msg '(:type :EVENT :payload (:action :handshake)))
|
||||
(framed (frame-message msg)))
|
||||
(is (string= "00002C" (string-upcase (subseq framed 0 6))))))
|
||||
|
||||
(test test-framing-round-trip
|
||||
"Contract 3: frame → read-frame preserves message identity."
|
||||
(let* ((msg '(:type :EVENT :payload (:action :handshake :version "1.0") :meta (:source :tui)))
|
||||
(framed (frame-message msg))
|
||||
(unframed (read-framed-message (make-string-input-stream framed))))
|
||||
(is (equal msg unframed))))
|
||||
|
||||
(test test-framing-empty-message
|
||||
"Contract 1: simple messages frame with valid hex length."
|
||||
(let* ((msg '(:type :ping))
|
||||
(framed (frame-message msg)))
|
||||
(is (> (length framed) 5))
|
||||
(is (every (lambda (c) (digit-char-p c 16)) (subseq framed 0 6)))))
|
||||
|
||||
(test test-read-framed-message
|
||||
"Contract 2: read-framed-message decodes a framed message correctly."
|
||||
(let* ((original '(:type :EVENT :payload (:text "decoded" :id 42)))
|
||||
(framed (frame-message original))
|
||||
(decoded (read-framed-message (make-string-input-stream framed))))
|
||||
(is (equal original decoded))))
|
||||
|
||||
(test test-read-framed-message-eof
|
||||
"Contract 2: read-framed-message returns :eof on incomplete stream."
|
||||
(let ((decoded (read-framed-message (make-string-input-stream "000"))))
|
||||
(is (eq :eof decoded))))
|
||||
#+end_src
|
||||
|
||||
* Implementation
|
||||
|
||||
** Package Context
|
||||
@@ -121,7 +168,9 @@ Reads a complete framed message from a TCP stream. Handles leading whitespace be
|
||||
(handler-case
|
||||
(progn
|
||||
(loop for char = (peek-char nil stream nil :eof)
|
||||
while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return)))
|
||||
for ws-count from 0
|
||||
while (and (not (eq char :eof)) (< ws-count 4096)
|
||||
(member char '(#\Space #\Newline #\Tab #\Return)))
|
||||
do (read-char stream))
|
||||
(let ((count (read-sequence length-buffer stream)))
|
||||
(if (< count 6)
|
||||
@@ -256,49 +305,3 @@ Use this function to manually verify that the daemon is alive and the framing pr
|
||||
(error (c) (format t "Error: ~a~%" c))))
|
||||
#+end_src
|
||||
|
||||
* Test Suite
|
||||
Verifies that the framing protocol correctly serializes and deserializes messages.
|
||||
#+begin_src lisp
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
(defpackage :passepartout-communication-tests
|
||||
(:use :cl :fiveam :passepartout)
|
||||
(:export #:communication-protocol-suite))
|
||||
(in-package :passepartout-communication-tests)
|
||||
|
||||
(def-suite communication-protocol-suite :description "Communication Protocol Suite")
|
||||
(in-suite communication-protocol-suite)
|
||||
|
||||
(test test-framing
|
||||
"Contract 1: frame-message produces correct hex length prefix."
|
||||
(let* ((msg '(:type :EVENT :payload (:action :handshake)))
|
||||
(framed (frame-message msg)))
|
||||
(is (string= "00002C" (string-upcase (subseq framed 0 6))))))
|
||||
|
||||
(test test-framing-round-trip
|
||||
"Contract 3: frame → read-frame preserves message identity."
|
||||
(let* ((msg '(:type :EVENT :payload (:action :handshake :version "1.0") :meta (:source :tui)))
|
||||
(framed (frame-message msg))
|
||||
(unframed (read-framed-message (make-string-input-stream framed))))
|
||||
(is (equal msg unframed))))
|
||||
|
||||
(test test-framing-empty-message
|
||||
"Contract 1: simple messages frame with valid hex length."
|
||||
(let* ((msg '(:type :ping))
|
||||
(framed (frame-message msg)))
|
||||
(is (> (length framed) 5))
|
||||
(is (every (lambda (c) (digit-char-p c 16)) (subseq framed 0 6)))))
|
||||
|
||||
(test test-read-framed-message
|
||||
"Contract 2: read-framed-message decodes a framed message correctly."
|
||||
(let* ((original '(:type :EVENT :payload (:text "decoded" :id 42)))
|
||||
(framed (frame-message original))
|
||||
(decoded (read-framed-message (make-string-input-stream framed))))
|
||||
(is (equal original decoded))))
|
||||
|
||||
(test test-read-framed-message-eof
|
||||
"Contract 2: read-framed-message returns :eof on incomplete stream."
|
||||
(let ((decoded (read-framed-message (make-string-input-stream "000"))))
|
||||
(is (eq :eof decoded))))
|
||||
#+end_src
|
||||
|
||||
Reference in New Issue
Block a user