fix(protocol): Skip leading whitespace in read-framed-message to prevent desync

fix-tui.py

@@ -0,0 +1,40 @@
+import sys
+
+filepath = "literate/tui-client.org"
+with open(filepath, "r") as f:
+    lines = f.readlines()
+
+out = []
+in_block = False
+for line in lines:
+    if ";; 3. Handle Keyboard Input" in line:
+        in_block = True
+        out.append(line)
+        out.append("            (let* ((event (get-wide-event input-win))\n")
+        out.append("                   (ch (and event (typep event 'event) (event-key event))))\n")
+        out.append("              (when ch\n")
+        out.append("                (cond\n")
+        out.append("                  ((or (eq ch #\\Newline) (eq ch #\\Return))\n")
+        out.append("                   (let ((cmd (coerce *input-buffer* 'string)))\n")
+        out.append("                     (setf (fill-pointer *input-buffer*) 0)\n")
+        out.append("                     (when (> (length cmd) 0)\n")
+        out.append("                       (let ((framed (opencortex:frame-message (format nil \"~s\" (list :type :EVENT :payload (list :sensor :chat-message :text cmd))))))\n")
+        out.append("                         (format *stream* \"~a\" framed)\n")
+        out.append("                         (finish-output *stream*)))\n")
+        out.append("                     (when (string= cmd \"/exit\") (setf *is-running* nil))))\n")
+        out.append("                  ((or (eq ch :backspace) (eq ch #\\Backspace) (eq ch #\\Rubout) (eq ch #\\Del))\n")
+        out.append("                   (when (> (length *input-buffer*) 0)\n")
+        out.append("                     (decf (fill-pointer *input-buffer*))))\n")
+        out.append("                  ((characterp ch)\n")
+        out.append("                   (vector-push-extend ch *input-buffer*))))\n")
+        continue
+    if in_block:
+        if "(clear input-win)" in line:
+            in_block = False
+            out.append(line)
+        continue
+    out.append(line)
+
+with open(filepath, "w") as f:
+    f.writelines(out)
+print("Fix applied")

literate/act.org

@@ -117,18 +117,22 @@ The final stage of the metabolic loop. It performs a "last-mile" safety check be
     ;; 2. Actuation Logic
     (case type
       (:REQUEST (dispatch-action signal signal))
+      (:LOG (dispatch-action signal signal))
       (:EVENT 
-       (when approved
-         (let* ((target (getf approved :target))
-                (result (dispatch-action approved signal)))
-           ;; If the actuator returns a signal (like :tool-output), it becomes the feedback.
-           ;; Otherwise, generate tool-output feedback for non-silent actuators.
-           (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+ (getf signal :depth 0)) 
-                                       :reply-stream (getf signal :reply-stream)
-                                       :payload (list :sensor :tool-output :result result :tool approved)))))))))
+       (if approved
+           (let* ((target (getf approved :target))
+                  (result (dispatch-action approved signal)))
+             ;; If the actuator returns a signal (like :tool-output), it becomes the feedback.
+             ;; Otherwise, generate tool-output feedback for non-silent actuators.
+             (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+ (getf signal :depth 0)) 
+                                         :reply-stream (getf 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.
+           (when (getf signal :reply-stream)
+             (dispatch-action signal signal)))))
     
     (setf (getf signal :status) :acted)
     feedback))

literate/communication.org

@@ -138,10 +138,15 @@ A robust utility to read a framed message from a stream. It enforces the determi
 
 #+begin_src lisp :tangle ../src/communication.lisp
 (defun read-framed-message (stream)
-  "Reads a hex-length prefixed message from the stream securely."
+  "Reads a hex-length prefixed message from the stream securely. Skips leading whitespace."
   (let ((length-buffer (make-string 6)))
     (handler-case
         (progn
+          ;; 0. Skip leading whitespace (newlines, spaces, etc.)
+          (loop for char = (peek-char nil stream nil :eof)
+                while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return)))
+                do (read-char stream))
+
           ;; 1. Read the 6-char hex length
           (let ((count (read-sequence length-buffer stream)))
             (when (< count 6) (return-from read-framed-message :eof))

literate/loop.org

@@ -36,10 +36,16 @@ The `process-signal` function is the core metabolic processor. It iterates throu
           (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
           (return nil))
         (handler-case
-            (progn
+            (let ((parent-metadata (list :reply-stream (getf current-signal :reply-stream)
+                                         :foveal-focus (getf current-signal :foveal-focus))))
               (setf current-signal (perceive-gate current-signal))
               (setf current-signal (reason-gate current-signal))
-              (setf current-signal (act-gate current-signal)))
+              (setf current-signal (act-gate current-signal))
+              ;; Inherit metadata for the next metabolic cycle if feedback was generated.
+              (when (and current-signal (not (getf current-signal :reply-stream)))
+                (setf (getf current-signal :reply-stream) (getf parent-metadata :reply-stream)))
+              (when (and current-signal (not (getf current-signal :foveal-focus)))
+                (setf (getf current-signal :foveal-focus) (getf parent-metadata :foveal-focus))))
           (error (c)
             (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
               (harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)

literate/reason.org

@@ -40,10 +40,12 @@ The `probabilistic-call` function manages the cascade of neural providers. If th
                      (result (if model 
                                  (funcall backend-fn prompt system-prompt :model model)
                                  (funcall backend-fn prompt system-prompt))))
-                ;; If the result is valid and doesn't contain a failure log, return it.
-                (unless (or (null result) 
-                            (and (stringp result) (search ":LOG" result)))
-                  (return result))))))
+                ;; If the result is valid, return it.
+                ;; If it is an error plist from the gateway, continue the cascade but log it.
+                (cond ((and (listp result) (eq (getf result :status) :success))
+                       (return (getf result :content)))
+                      ((stringp result) (return result))
+                      (t (harness-log "PROBABILISTIC: Backend ~a failed: ~a" backend (getf result :message))))))))
         ;; Final fallback if all backends in the cascade fail.
         (list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
 #+end_src
@@ -94,11 +96,16 @@ Once a proposal is generated, it MUST pass through the deterministic gates. Ever
       (let ((trigger (skill-trigger-fn skill))
             (gate (skill-deterministic-fn skill)))
         (when (or (null trigger) (ignore-errors (funcall trigger context)))
-          (setf current-action (funcall gate current-action context))
-          ;; If any gate returns a LOG or EVENT, it has intercepted the action.
-          (when (and (listp current-action) (member (getf current-action :type) '(:LOG :EVENT :log :event)))
-            (harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
-            (return-from deterministic-verify current-action)))))
+          (let ((next-action (funcall gate current-action context)))
+            ;; Interception occurs if the gate returns a signal (LOG/EVENT) AND either:
+            ;; 1. The original action was NOT a signal (e.g. it was a REQUEST).
+            ;; 2. The gate returned a DIFFERENT signal than it was given.
+            (when (and (listp next-action) 
+                       (member (getf next-action :type) '(:LOG :EVENT :log :event))
+                       (not (eq next-action current-action)))
+              (harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
+              (return-from deterministic-verify next-action))
+            (setf current-action next-action)))))
     current-action))
 #+end_src
 

src/act.lisp

@@ -84,18 +84,22 @@
     ;; 2. Actuation Logic
     (case type
       (:REQUEST (dispatch-action signal signal))
+      (:LOG (dispatch-action signal signal))
       (:EVENT 
-       (when approved
-         (let* ((target (getf approved :target))
-                (result (dispatch-action approved signal)))
-           ;; If the actuator returns a signal (like :tool-output), it becomes the feedback.
-           ;; Otherwise, generate tool-output feedback for non-silent actuators.
-           (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+ (getf signal :depth 0)) 
-                                       :reply-stream (getf signal :reply-stream)
-                                       :payload (list :sensor :tool-output :result result :tool approved)))))))))
+       (if approved
+           (let* ((target (getf approved :target))
+                  (result (dispatch-action approved signal)))
+             ;; If the actuator returns a signal (like :tool-output), it becomes the feedback.
+             ;; Otherwise, generate tool-output feedback for non-silent actuators.
+             (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+ (getf signal :depth 0)) 
+                                         :reply-stream (getf 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.
+           (when (getf signal :reply-stream)
+             (dispatch-action signal signal)))))
     
     (setf (getf signal :status) :acted)
     feedback))

src/communication.lisp

@@ -67,10 +67,15 @@
                        :capabilities '(:auth :swank :org-ast))))
 
 (defun read-framed-message (stream)
-  "Reads a hex-length prefixed message from the stream securely."
+  "Reads a hex-length prefixed message from the stream securely. Skips leading whitespace."
   (let ((length-buffer (make-string 6)))
     (handler-case
         (progn
+          ;; 0. Skip leading whitespace (newlines, spaces, etc.)
+          (loop for char = (peek-char nil stream nil :eof)
+                while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return)))
+                do (read-char stream))
+
           ;; 1. Read the 6-char hex length
           (let ((count (read-sequence length-buffer stream)))
             (when (< count 6) (return-from read-framed-message :eof))

src/loop.lisp

@@ -15,10 +15,16 @@
           (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
           (return nil))
         (handler-case
-            (progn
+            (let ((parent-metadata (list :reply-stream (getf current-signal :reply-stream)
+                                         :foveal-focus (getf current-signal :foveal-focus))))
               (setf current-signal (perceive-gate current-signal))
               (setf current-signal (reason-gate current-signal))
-              (setf current-signal (act-gate current-signal)))
+              (setf current-signal (act-gate current-signal))
+              ;; Inherit metadata for the next metabolic cycle if feedback was generated.
+              (when (and current-signal (not (getf current-signal :reply-stream)))
+                (setf (getf current-signal :reply-stream) (getf parent-metadata :reply-stream)))
+              (when (and current-signal (not (getf current-signal :foveal-focus)))
+                (setf (getf current-signal :foveal-focus) (getf parent-metadata :foveal-focus))))
           (error (c)
             (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
               (harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)

src/reason.lisp

@@ -20,10 +20,12 @@
                      (result (if model 
                                  (funcall backend-fn prompt system-prompt :model model)
                                  (funcall backend-fn prompt system-prompt))))
-                ;; If the result is valid and doesn't contain a failure log, return it.
-                (unless (or (null result) 
-                            (and (stringp result) (search ":LOG" result)))
-                  (return result))))))
+                ;; If the result is valid, return it.
+                ;; If it is an error plist from the gateway, continue the cascade but log it.
+                (cond ((and (listp result) (eq (getf result :status) :success))
+                       (return (getf result :content)))
+                      ((stringp result) (return result))
+                      (t (harness-log "PROBABILISTIC: Backend ~a failed: ~a" backend (getf result :message))))))))
         ;; Final fallback if all backends in the cascade fail.
         (list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
 
@@ -64,11 +66,16 @@
       (let ((trigger (skill-trigger-fn skill))
             (gate (skill-deterministic-fn skill)))
         (when (or (null trigger) (ignore-errors (funcall trigger context)))
-          (setf current-action (funcall gate current-action context))
-          ;; If any gate returns a LOG or EVENT, it has intercepted the action.
-          (when (and (listp current-action) (member (getf current-action :type) '(:LOG :EVENT :log :event)))
-            (harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
-            (return-from deterministic-verify current-action)))))
+          (let ((next-action (funcall gate current-action context)))
+            ;; Interception occurs if the gate returns a signal (LOG/EVENT) AND either:
+            ;; 1. The original action was NOT a signal (e.g. it was a REQUEST).
+            ;; 2. The gate returned a DIFFERENT signal than it was given.
+            (when (and (listp next-action) 
+                       (member (getf next-action :type) '(:LOG :EVENT :log :event))
+                       (not (eq next-action current-action)))
+              (harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
+              (return-from deterministic-verify next-action))
+            (setf current-action next-action)))))
     current-action))
 
 (defun reason-gate (signal)

test-events.lisp

@@ -0,0 +1,23 @@
+(require :asdf)
+(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))
+(ql:quickload :croatoan)
+(in-package :cl-user)
+(defun main ()
+  (with-open-file (f "event2.log" :direction :output :if-exists :supersede)
+    (croatoan:with-screen (scr :input-echoing nil :input-blocking nil)
+      (let* ((h (croatoan:height scr))
+             (w (croatoan:width scr))
+             (input-win (make-instance 'croatoan:window :height 1 :width w :position (list (- h 1) 0))))
+        (setf (croatoan:function-keys-enabled-p input-win) t)
+        (setf (croatoan:input-blocking input-win) nil)
+        (loop
+          (let* ((event (croatoan:get-wide-event input-win))
+                 (ch (and event (typep event 'croatoan:event) (croatoan:event-key event))))
+            (when ch
+              (format f "Got: ~S (type: ~S)~%" ch (type-of ch))
+              (finish-output f)
+              (when (or (eq ch #\q) (eq ch :q))
+                (return))))
+          (sleep 0.05))))))
+(main)
+(sb-ext:exit)

test-input.lisp

@@ -0,0 +1,27 @@
+(require :asdf)
+(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))
+(ql:quickload :croatoan)
+(in-package :cl-user)
+(defun main ()
+  (with-open-file (f "test-input.log" :direction :output :if-exists :supersede)
+    (format f "Starting...~%")
+    (finish-output f)
+    (croatoan:with-screen (scr :input-echoing nil :input-blocking nil :cursor-visible t)
+      (let* ((h (croatoan:height scr))
+             (w (croatoan:width scr))
+             (input-win (make-instance 'croatoan:window :height 1 :width w :position (list (- h 1) 0)))
+             (buf (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t)))
+        (setf (croatoan:input-blocking input-win) nil)
+        (loop
+          (let ((ch (croatoan:get-char input-win)))
+            (when ch
+              (format f "Got: ~S~%" ch)
+              (finish-output f)
+              (return)))
+          (croatoan:clear input-win)
+          (croatoan:add-string input-win (concatenate 'string "> " (coerce buf 'string)))
+          (croatoan:move input-win 0 (+ 2 (length buf)))
+          (croatoan:refresh input-win)
+          (sleep 0.05))))))
+(main)
+(sb-ext:exit)

test-keys.lisp

@@ -0,0 +1,22 @@
+(require :asdf)
+(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))
+(ql:quickload :croatoan)
+(in-package :cl-user)
+(defun main ()
+  (with-open-file (f "key.log" :direction :output :if-exists :supersede)
+    (croatoan:with-screen (scr :input-echoing nil :input-blocking nil)
+      (let* ((h (croatoan:height scr))
+             (w (croatoan:width scr))
+             (input-win (make-instance 'croatoan:window :height 1 :width w :position (list (- h 1) 0))))
+        (setf (croatoan:function-keys-enabled-p input-win) t)
+        (setf (croatoan:input-blocking input-win) nil)
+        (loop
+          (let ((ch (croatoan:get-char input-win)))
+            (when ch
+              (format f "Got: ~S (type: ~S) (code: ~S)~%" ch (type-of ch) (and (characterp ch) (char-code ch)))
+              (finish-output f)
+              (when (or (eq ch #\q) (eq ch :q))
+                (return))))
+          (sleep 0.05))))))
+(main)
+(sb-ext:exit)

test-output.txt

@@ -0,0 +1,5 @@
+To load "croatoan":
+  Load 1 ASDF system:
+    croatoan
+; Loading "croatoan"
+................