#+TITLE: Communication Protocol (communication.lisp)
#+AUTHOR: Agent
#+FILETAGS: :harness:protocol:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/core-transport.lisp

* Overview: Architectural Intent

The Communication Protocol defines how Passepartout speaks to the outside world. It sits between the metabolic loop and the network, providing framed, length-prefixed message transport over TCP.

Every message is an S-expression (plist) prefixed with a 6-character hex length:

  00002C(:TYPE :EVENT :PAYLOAD (:ACTION :handshake :VERSION "0.4.0"))

This is a deliberate rejection of JSON, Protocol Buffers, or any other serialization format. The message format is Lisp-native because:

1. The agent generates and consumes these messages inside the cognitive loop — no serialization layer needed
2. The format is human-readable and trivially debuggable with a text editor
3. The length prefix prevents framing attacks (no "read until newline" ambiguity)

** Why Length-Prefixed Framing?

A naive TCP protocol that reads until newline fails when:
- A message contains a newline character (which Lisp plists can)
- A message is split across TCP packets (read returns partial data)
- A malicious client sends an infinite stream without newlines

The length prefix solves all three problems. The reader reads exactly 6 characters (the hex length), then reads exactly that many additional characters. No ambiguous termination, no partial message handling, no newline worries.

The 6-character hex length supports messages up to ~16MB (0xFFFFFF bytes). This is sufficient for any single message the agent would produce. Larger payloads should be split across multiple messages.

** Contract

1. (frame-message msg): serializes a plist message to a length-prefixed
   string. The first 6 characters are the hex-encoded payload length.
2. (read-framed-message stream): reads a framed message from a stream,
   returning the deserialized plist. Consumes exactly the length-prefixed
   bytes.
3. Round-trip invariant: ~(read-framed-message (make-string-input-stream
   (frame-message msg)))~ equals ~msg~.

* Implementation

** Package Context
#+begin_src lisp
(in-package :passepartout)
#+end_src

** Protocol Accessor (proto-get)

Case-insensitive property list accessor used throughout the pipeline.
Returns the value associated with KEY in PLIST by interning a keyword.

;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun proto-get (plist key)
  "Look up KEY in PLIST with case-insensitive keyword normalization."
  (let ((key-upcase (string-upcase (string key))))
    (loop for (k v) on plist by #'cddr
          when (and (keywordp k)
                    (string-equal (string k) key-upcase))
            do (return v))))
#+end_src

** Actuator Registry

The global registry mapping target keywords (~:cli~, ~:telegram~, ~:signal~, etc.) to their physical actuator functions. Extensible at runtime — skills can register new actuators via ~register-actuator~.

#+begin_src lisp
(defvar *actuator-registry* (make-hash-table :test 'equalp)
  "Global registry mapping target keywords to their physical actuator functions.")

(defun register-actuator (name fn) 
  "Registers an actuator function. Actuators receive: (ACTION CONTEXT)."
  (let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword))))
    (setf (gethash key *actuator-registry*) fn)))
#+end_src

** Message Framing

Three functions handle the full message lifecycle: sanitize (strip non-serializable state), frame (serialize + prefix), and read (parse from stream).

*** Sanitize Protocol Message

Strips transient runtime state (~:reply-stream~, ~:socket~, ~:stream~) from a message plist before sending it over the network. These are Lisp stream objects that cannot be serialized and have no meaning to the remote end.

#+begin_src lisp
(defun protocol-message-sanitize (msg)
  "Recursively strips non-serializable objects from a protocol plist."
  (if (and msg (listp msg))
      (let ((clean nil))
        (loop for (k v) on msg by #'cddr
              do (unless (member k '(:reply-stream :socket :stream))
                   (push k clean)
                   (push (if (listp v) (protocol-message-sanitize v) v) clean)))
        (nreverse clean))
      msg))
#+end_src

*** Frame Message

Serializes a plist to a length-prefixed string: 6-character hex length followed by the ~prin1~ representation.

#+begin_src lisp
(defun frame-message (msg)
  "Serializes a message plist and prefixes it with a 6-character hex length."
  (let* ((sanitized (protocol-message-sanitize msg))
         (payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized)))
         (len (length payload)))
    (format nil "~6,'0x~a" len payload)))
#+end_src

*** Read Framed Message

Reads a complete framed message from a TCP stream. Handles leading whitespace between messages, partial reads, and malformed length headers gracefully. Returns the parsed S-expression, or ~:eof~ if the stream is closed, or ~:error~ if the message is malformed.

#+begin_src lisp
(defun read-framed-message (stream)
  "Reads a hex-length prefixed S-expression from the stream securely."
  (let ((length-buffer (make-string 6)))
    (handler-case
        (progn
          (loop for char = (peek-char nil stream nil :eof)
                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)
                :eof
                (let ((len (ignore-errors (parse-integer length-buffer :radix 16))))
                  (if (not len)
                      :error
                      (let ((msg-buffer (make-string len)))
                        (read-sequence msg-buffer stream)
                        (let ((*read-eval* nil))
                          (handler-case (read-from-string msg-buffer)
                            (error () :error)))))))))
      (error () :error))))
#+end_src

** Server Listener (daemon-start)

The TCP server that accepts connections from CLI and TUI clients. Each connection gets a dedicated thread (~client-handle-connection~).

The daemon sends a handshake message on connection, then enters a read loop, injecting each received message into the metabolic loop via ~stimulus-inject~. The ~:health-check~ message type is handled inline (not sent to the cognitive loop) so that health checks work even when the agent is busy.

#+begin_src lisp
(defvar *daemon-socket* nil)
(defvar *daemon-port* nil "The port the daemon is actually listening on (may differ from default if 9105 was in use).")

(defun client-handle-connection (socket)
  "Handles a single TUI/CLI client connection in a dedicated thread."
  (let ((stream (usocket:socket-stream socket)))
    (handler-case
        (progn
          (format stream "~a" (frame-message (make-hello-message "0.7.2")))
          (finish-output stream)
          (loop
            (let ((msg (read-framed-message stream)))
              (cond
                ((eq msg :eof) (return))
                ((eq msg :error) (return))
                ((eq (getf msg :type) :health-check)
                 (let ((health-msg (list :type :health-response 
                                         :status (or (and (boundp 'passepartout::*system-health*) 
                                                         (symbol-value 'passepartout::*system-health*))
                                                     :unknown)
                                         :checked-p (or (and (boundp 'passepartout::*health-check-ran*)
                                                             (symbol-value 'passepartout::*health-check-ran*))
                                                     nil))))
                   (format stream "~a" (frame-message health-msg))
                   (finish-output stream)))
                (t (stimulus-inject msg :stream stream))))))
      (error (c) (log-message "CLIENT ERROR: ~a" c)))
    (ignore-errors (usocket:socket-close socket))))

(defun start-daemon (&key (port 9105) (max-retries 10))
  "Starts the network listener for TUI/CLI clients.
If PORT is taken, tries subsequent ports up to PORT+MAX-RETRIES."
  (loop for attempt from 0 below max-retries
        for p = (+ port attempt)
        do (handler-case
               (progn
                 (setf *daemon-socket* (usocket:socket-listen "127.0.0.1" p :reuse-address t))
                 (log-message "DAEMON: Listening on localhost:~a" p)
                 (setf *daemon-port* p)
                 (bt:make-thread
                  (lambda ()
                    (loop
                      (let ((client-socket (usocket:socket-accept *daemon-socket*)))
                        (when client-socket
                          (bt:make-thread (lambda () (client-handle-connection client-socket))
                                         :name "passepartout-client-handler")))))
                  :name "passepartout-server-listener")
                 (return p))
             (usocket:address-in-use-error ()
               (when (= attempt (1- max-retries))
                 (log-message "DAEMON: All ports ~d-~d in use — giving up" port (+ port max-retries -1))
                 (error "No available port for daemon"))
               (log-message "DAEMON: Port ~d in use, trying ~d..." p (1+ p))))))
#+end_src

** Handshake Logic

The first message sent to every new connection. The client can use this to verify the protocol version and the daemon's capabilities.

#+begin_src lisp
(defun make-hello-message (version)
  "Constructs the standard HELLO handshake message."
  (list :TYPE :EVENT 
        :PAYLOAD (list :ACTION :handshake 
                       :VERSION version 
                       :CAPABILITIES '(:AUTH :ORG-AST))))
#+end_src

** Structural Validation

Validates that an incoming message has the minimum required structure: a plist with a valid ~:type~ field. Used by the protocol validator skill to reject malformed messages before they enter the cognitive loop.

#+begin_src lisp
(in-package :passepartout)

(defun protocol-schema-validate (msg)
  "Strict structural validation for incoming protocol messages."
  (unless (listp msg) (error "Message must be a plist"))
  (let ((type (proto-get msg :type)))
    (unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS))
      (error "Invalid message type '~a'" type))
    t))
#+end_src

** Backward-Compatibility Alias

;; REPL-VERIFIED: 2026-05-03T14:00:00
#+begin_src lisp
(defun validate-communication-protocol-schema (msg)
  "Backward-compatibility alias for protocol-schema-validate."
  (protocol-schema-validate msg))
#+end_src

** Protocol Smoke Test (manual for REPL evaluation)

Use this function to manually verify that the daemon is alive and the framing protocol works end-to-end. It connects to a running daemon, reads the HELLO handshake, sends a "hi" message, and reads the response.

#+begin_src lisp :tangle no
(defun test-daemon-protocol ()
  (handler-case
      (let* ((socket (usocket:socket-connect "127.0.0.1" 9105))
             (stream (usocket:socket-stream socket)))
        (format t "Connected.~%")
        (let* ((len-buf (make-string 6))
               (count (read-sequence len-buf stream)))
          (when (= count 6)
            (let* ((len (parse-integer len-buf :radix 16))
                   (msg-buf (make-string len)))
              (read-sequence msg-buf stream)
              (format t "HELLO: ~a~%" msg-buf))))
        (let* ((msg '(:TYPE :EVENT :META (:SOURCE :tui) :PAYLOAD (:SENSOR :user-input :TEXT "hi")))
               (framed (frame-message msg)))
          (format stream "~a" framed)
          (finish-output stream)
          (let* ((len-buf (make-string 6))
                 (count (read-sequence len-buf stream)))
            (when (= count 6)
              (let* ((len (parse-integer len-buf :radix 16))
                     (msg-buf (make-string len)))
                (read-sequence msg-buf stream)
                (format t "Response: ~a~%" msg-buf)))))
        (usocket:socket-close socket))
    (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