passepartout: v0.5.0 hotfix 2 — daemon stable

- Restore (in-package :passepartout) to core-reason
- Move *VAULT-MEMORY* back to core-skills
- Fix ASDF and defstruct/defpackage ordering
- Increase daemon timeout to 120s
- Handshake: 0.5.0

Verified: daemon processes messages, TUI clean, gate trace works

lisp/channel-cli.lisp

@@ -0,0 +1,35 @@
+(in-package :passepartout)
+
+(defun gateway-cli-input (text)
+  "Processes raw text from the command line."
+  (inject-stimulus (list :type :EVENT 
+                         :payload (list :sensor :user-input :text text) 
+                         :meta (list :source :CLI))))
+
+(defskill :passepartout-gateway-cli
+  :priority 100
+  :trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
+  :deterministic (lambda (action ctx) (declare (ignore ctx)) action))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-gateway-cli-tests
+  (:use :cl :passepartout)
+  (:export #:cli-suite))
+
+(in-package :passepartout-gateway-cli-tests)
+
+(fiveam:def-suite cli-suite :description "Verification of the CLI Gateway")
+(fiveam:in-suite cli-suite)
+
+(fiveam:test test-gateway-cli-input-format
+  "Contract 1: gateway-cli-input injects a properly formed signal without error."
+  (handler-case
+      (progn (gateway-cli-input "hello") (fiveam:pass))
+    (error (c)
+      (fiveam:fail "gateway-cli-input crashed: ~a" c))))
+
+(handler-case
+    (progn (gateway-cli-input "test-load") (log-message "CLI: Load-time test OK"))
+  (error (c) (log-message "CLI: Load-time test FAILED: ~a" c)))

lisp/channel-discord.lisp

@@ -0,0 +1,50 @@
+(in-package :passepartout)
+(defun discord-get-token ()
+  (vault-get-secret :discord))
+
+(defun discord-send (action context)
+  "Sends a message via Discord REST API."
+  (declare (ignore context))
+  (let* ((payload (getf action :payload))
+         (meta (getf action :meta))
+         (channel-id (or (getf meta :channel-id) (getf payload :chat-id)))
+         (text (or (getf payload :text) (getf action :text)))
+         (token (discord-get-token)))
+    (when (and token channel-id text)
+      (handler-case
+          (dex:post (format nil "https://discord.com/api/v10/channels/~a/messages" channel-id)
+                    :headers '(("Authorization" . ,(format nil "Bot ~a" token))
+                               ("Content-Type" . "application/json"))
+                    :content (cl-json:encode-json-to-string
+                              `((content . ,text))))
+        (error (c) (log-message "DISCORD ERROR: ~a" c))))))
+
+(defun discord-poll ()
+  "Polls Discord via HTTP GET /channels/{id}/messages. In production,
+a WebSocket connection to the Gateway is preferred for real-time events."
+  (let* ((token (discord-get-token)))
+    (when token
+      (handler-case
+          (dolist (channel '("channel-id-here"))  ;; configured channel IDs
+            (let* ((last-id (getf (gethash "discord" *gateway-configs*) :last-update-id 0))
+                   (url (format nil "https://discord.com/api/v10/channels/~a/messages?after=~a"
+                               channel last-id))
+                   (response (dex:get url :headers
+                                       `(("Authorization" . ,(format nil "Bot ~a" token))))))
+              (let ((messages (ignore-errors
+                               (cdr (assoc :message
+                                      (cl-json:decode-json-from-string response))))))
+                (dolist (msg (and (listp messages) messages))
+                  (let* ((id (cdr (assoc :id msg)))
+                         (content (cdr (assoc :content msg)))
+                         (author (cdr (assoc :author msg)))
+                         (author-id (cdr (assoc :id author)))
+                         (is-bot (cdr (assoc :bot author))))
+                    (when (and id content (not is-bot))
+                      (setf (getf (gethash "discord" *gateway-configs*) :last-update-id) id)
+                      (unless (ignore-errors (hitl-handle-message content :discord))
+                        (stimulus-inject
+                         (list :type :EVENT
+                               :meta (list :source :discord :chat-id channel)
+                               :payload (list :sensor :user-input :text content))))))))))
+        (error (c) (log-message "DISCORD POLL ERROR: ~a" c))))))

lisp/channel-signal.lisp

@@ -0,0 +1,41 @@
+(in-package :passepartout)
+(defun signal-get-account ()
+  (vault-get-secret :signal))
+
+(defun signal-poll ()
+  "Polls Signal for new messages and injects them into the harness."
+  (let ((account (signal-get-account)))
+    (when account
+      (handler-case
+          (let* ((output (uiop:run-program (list "signal-cli" "-u" account "receive" "--json")
+                                            :output :string :error-output :string :ignore-error-status t))
+                 (lines (cl-ppcre:split "\\\\n" output)))
+            (dolist (line lines)
+              (when (and line (> (length line) 0))
+                (let* ((json (ignore-errors (cl-json:decode-json-from-string line)))
+                       (envelope (cdr (assoc :envelope json)))
+                       (source (cdr (assoc :source envelope)))
+                       (data-message (cdr (assoc :data-message envelope)))
+                       (text (cdr (assoc :message data-message))))
+                  (when (and source text)
+                    (log-message "SIGNAL: Received message from ~a" source)
+                    (unless (ignore-errors (hitl-handle-message text :signal))
+                      (stimulus-inject
+                       (list :type :EVENT
+                             :meta (list :source :signal :chat-id source)
+                             :payload (list :sensor :user-input :text text)))))))))
+        (error (c) (log-message "SIGNAL POLL ERROR: ~a" c))))))
+
+(defun signal-send (action context)
+  "Sends a message via Signal."
+  (declare (ignore context))
+  (let* ((payload (getf action :payload))
+         (meta (getf action :meta))
+         (chat-id (or (getf meta :chat-id) (getf payload :chat-id) (getf action :chat-id)))
+         (text (or (getf payload :text) (getf action :text)))
+         (account (signal-get-account)))
+    (when (and account chat-id text)
+      (handler-case
+          (uiop:run-program (list "signal-cli" "-u" account "send" "-m" text chat-id)
+                            :output :string :error-output :string)
+        (error (c) (log-message "SIGNAL ERROR: ~a" c))))))

lisp/channel-slack.lisp

@@ -0,0 +1,45 @@
+(in-package :passepartout)
+(defun slack-get-token ()
+  (vault-get-secret :slack))
+
+(defun slack-send (action context)
+  "Sends a message via Slack Web API."
+  (declare (ignore context))
+  (let* ((payload (getf action :payload))
+         (meta (getf action :meta))
+         (channel (or (getf meta :channel-id) (getf payload :chat-id)))
+         (text (or (getf payload :text) (getf action :text)))
+         (token (slack-get-token)))
+    (when (and token channel text)
+      (handler-case
+          (dex:post "https://slack.com/api/chat.postMessage"
+                    :headers `(("Authorization" . ,(format nil "Bearer ~a" token))
+                               ("Content-Type" . "application/json; charset=utf-8"))
+                    :content (cl-json:encode-json-to-string
+                              `((channel . ,channel) (text . ,text))))
+        (error (c) (log-message "SLACK ERROR: ~a" c))))))
+
+(defun slack-poll ()
+  "Polls Slack for new messages via conversations.history."
+  (let* ((token (slack-get-token)))
+    (when token
+      (dolist (channel '("general"))  ;; configured channel IDs
+        (handler-case
+            (let* ((url (format nil "https://slack.com/api/conversations.history?channel=~a&limit=5" channel))
+                   (response (dex:get url :headers
+                                       `(("Authorization" . ,(format nil "Bearer ~a" token))))))
+              (let* ((json (ignore-errors (cl-json:decode-json-from-string response)))
+                     (ok (cdr (assoc :ok json)))
+                     (messages (cdr (assoc :messages json))))
+                (when (and ok messages (listp messages))
+                  (dolist (msg messages)
+                    (let* ((text (cdr (assoc :text msg)))
+                           (user (cdr (assoc :user msg)))
+                           (ts (cdr (assoc :ts msg))))
+                      (when (and text user (not (string= user "USLACKBOT")))
+                        (unless (ignore-errors (hitl-handle-message text :slack))
+                          (stimulus-inject
+                           (list :type :EVENT
+                                 :meta (list :source :slack :chat-id channel)
+                                 :payload (list :sensor :user-input :text text))))))))))
+          (error (c) (log-message "SLACK POLL ERROR: ~a" c)))))))

lisp/channel-telegram.lisp

@@ -0,0 +1,47 @@
+(in-package :passepartout)
+(defun telegram-get-token ()
+  (vault-get-secret :telegram))
+
+(defun telegram-poll ()
+  "Polls Telegram for new messages and injects them into the harness."
+  (let* ((token (telegram-get-token)))
+    (when token
+      (let* ((last-id (getf (gethash "telegram" *gateway-configs*) :last-update-id 0))
+             (url (format nil "https://api.telegram.org/bot~a/getUpdates?offset=~a"
+                          token (1+ last-id))))
+        (handler-case
+            (let* ((response (dex:get url))
+                   (json (cl-json:decode-json-from-string response))
+                   (updates (cdr (assoc :result json))))
+              (dolist (update updates)
+                (let* ((update-id (cdr (assoc :update--id update)))
+                       (message (cdr (assoc :message update)))
+                       (chat (cdr (assoc :chat message)))
+                       (chat-id (cdr (assoc :id chat)))
+                       (text (cdr (assoc :text message))))
+                  (setf (getf (gethash "telegram" *gateway-configs*) :last-update-id) update-id)
+                  (when (and text chat-id)
+                    (log-message "TELEGRAM: Received message from ~a" chat-id)
+                    (unless (ignore-errors (hitl-handle-message text :telegram))
+                      (stimulus-inject
+                       (list :type :EVENT
+                             :meta (list :source :telegram :chat-id (format nil "~a" chat-id))
+                             :payload (list :sensor :user-input :text text))))))))
+          (error (c) (log-message "TELEGRAM POLL ERROR: ~a" c)))))))
+
+(defun telegram-send (action context)
+  "Sends a message via Telegram."
+  (declare (ignore context))
+  (let* ((payload (getf action :payload))
+         (meta (getf action :meta))
+         (chat-id (or (getf meta :chat-id) (getf payload :chat-id) (getf action :chat-id)))
+         (text (or (getf payload :text) (getf action :text)))
+         (token (telegram-get-token)))
+    (when (and token chat-id text)
+      (handler-case
+          (let ((url (format nil "https://api.telegram.org/bot~a/sendMessage" token)))
+            (dex:post url
+                      :headers '(("Content-Type" . "application/json"))
+                      :content (cl-json:encode-json-to-string
+                                `((chat_id . ,chat-id) (text . ,text)))))
+        (error (c) (log-message "TELEGRAM ERROR: ~a" c))))))

lisp/channel-tui-main.lisp

@@ -0,0 +1,543 @@
+(in-package :passepartout.channel-tui)
+
+(defun on-key (&rest args)
+  ;; Normalize: get-char returns raw ncurses integer codes (e.g. 263 for
+  ;; backspace). Croatoan's code-key + key-name convert them to keywords
+  ;; so the cond below can use eq.
+  (let* ((raw (car args))
+         (ch (if (and (integerp raw) (> raw 255))
+                 (let* ((k (code-key raw))
+                        (name (and k (key-name k))))
+                   (or name raw))
+                 raw)))
+    (cond
+      ;; Enter
+      ((or (eq ch :enter) (eql ch 13) (eql ch 10)
+           (eql ch #\Newline) (eql ch #\Return))
+        ;; Multi-line: if buffer ends with \, strip it and insert newline
+        (if (and (st :input-buffer) (eql (first (st :input-buffer)) #\\))
+            (progn (pop (st :input-buffer))
+                   (push #\Newline (st :input-buffer))
+                   (setf (st :dirty) (list nil nil t)))
+            (let ((text (string-trim '(#\Space #\Tab) (input-string))))
+              (when (> (length text) 0)
+                (push text (st :input-history))
+                (setf (st :input-hpos) 0)
+                (setf (st :scroll-offset) 0)
+                (cond
+                  ;; /help command
+                  ((string-equal text "/help")
+                   (add-msg :system
+                    "/eval <expr>   Evaluate Lisp expression")
+                   (add-msg :system
+                    "/focus <proj>  Set project context")
+                   (add-msg :system
+                    "/scope <s>     Change scope (memex/session/project)")
+                   (add-msg :system
+                    "/unfocus       Pop context stack")
+                   (add-msg :system
+                    "/theme         Show current color theme")
+                   (add-msg :system
+                    "/help          Show this help")
+                   (add-msg :system
+                    "\\ + Enter      Multi-line input"))
+                  ;; /theme command
+                  ((string-equal text "/theme")
+                   (add-msg :system
+                    (format nil "Theme: ~a — user=~a agent=~a system=~a input=~a"
+                            *tui-theme-current-name*
+                            (getf *tui-theme* :user)
+                            (getf *tui-theme* :agent)
+                            (getf *tui-theme* :system)
+                            (getf *tui-theme* :input))
+                    (format nil "Presets: /theme dark | light | solarized | gruvbox")))
+                  ((and (>= (length text) 7)
+                        (string-equal (subseq text 0 7) "/theme "))
+                   (let ((name (string-trim '(#\Space) (subseq text 7))))
+                     (if (theme-switch name)
+                         (add-msg :system (format nil "Theme switched to ~a" name))
+                         (add-msg :system (format nil "Unknown theme '~a'. Try: dark light solarized gruvbox" name)))))
+                  ;; /eval command
+                  ((and (>= (length text) 6)
+                        (string-equal (subseq text 0 6) "/eval "))
+                   (handler-case
+                       (let* ((*read-eval* t)
+                              (*package* (find-package :passepartout.channel-tui))
+                              (r (eval (read-from-string (subseq text 6)))))
+                         (add-msg :system (format nil "=> ~s" r)))
+                     (error (c) (add-msg :system (format nil "=> ✗ ~a" c)))))
+                  ;; /focus <project> — set project context
+                  ((and (>= (length text) 7)
+                        (string-equal (subseq text 0 7) "/focus "))
+                   (let ((project (string-trim '(#\Space) (subseq text 7))))
+                     (if (and (fboundp 'focus-project) (> (length project) 0))
+                         (progn (funcall 'focus-project project nil)
+                                (add-msg :system (format nil "Focused on project: ~a" project)))
+                         (add-msg :system "Usage: /focus <project-name>"))))
+                  ;; /scope <scope> — change context scope
+                  ((and (>= (length text) 7)
+                        (string-equal (subseq text 0 7) "/scope "))
+                   (let ((scope-str (string-trim '(#\Space) (subseq text 7))))
+                     (cond
+                       ((and (fboundp 'focus-session) (string-equal scope-str "session"))
+                        (funcall 'focus-session)
+                        (add-msg :system "Scope: session"))
+                       ((and (fboundp 'focus-project) (string-equal scope-str "project"))
+                        (funcall 'focus-project nil nil)
+                        (add-msg :system "Scope: project"))
+                       ((and (fboundp 'focus-memex) (string-equal scope-str "memex"))
+                        (funcall 'focus-memex)
+                        (add-msg :system "Scope: memex"))
+                       (t (add-msg :system "Usage: /scope memex|session|project")))))
+                  ;; /unfocus — pop context
+                  ((and (>= (length text) 8)
+                        (string-equal (subseq text 0 8) "/unfocus"))
+                   (if (fboundp 'unfocus)
+                       (progn (funcall 'unfocus)
+                              (add-msg :system "Popped context"))
+                       (add-msg :system "Context manager not loaded")))
+                   ;; /quit — save history and exit
+                   ((or (string-equal text "/quit") (string-equal text "/q"))
+                    (let ((hist-file (merge-pathnames ".cache/passepartout/history"
+                                                      (user-homedir-pathname))))
+                      (uiop:ensure-all-directories-exist (list hist-file))
+                      (with-open-file (out hist-file :direction :output
+                                           :if-exists :supersede :if-does-not-exist :create)
+                        (dolist (entry (reverse (st :input-history)))
+                          (write-line entry out))))
+                    (add-msg :system "* Goodbye *")
+                    (send-daemon (list :type :event :payload '(:action :quit)))
+                    (setf (st :running) nil))
+                   ;; /reconnect — re-establish daemon connection
+                   ((string-equal text "/reconnect")
+                    (disconnect-daemon)
+                    (connect-daemon))
+                   ;; Normal message
+                  (t
+                   (add-msg :user text)
+                   (setf (st :busy) t)
+                   (send-daemon (list :type :event
+                                     :payload (list :sensor :user-input :text text)))))
+                 (setf (st :input-buffer) nil)
+                 (setf (st :cursor-pos) 0)
+                 (setf (st :dirty) (list t t t))))))
+        ;; Tab — command completion
+        ((or (eql ch 9) (eq ch :tab))
+         (let ((text (input-string)))
+           (cond
+             ((and (>= (length text) 8)
+                   (string-equal (subseq text 0 7) "/theme "))
+              (let* ((partial (subseq text 7))
+                     (names '("dark" "light" "solarized" "gruvbox"))
+                     (match (find partial names :test #'string-equal)))
+                (when match
+                  (setf (st :input-buffer) (reverse (coerce (concatenate 'string "/theme " match) 'list)))
+                  (setf (st :dirty) (list nil nil t)))))
+             ((and (> (length text) 1) (eql (char text 0) #\/))
+              (let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme" "/reconnect" "/quit"))
+                     (match (find text cmds :test
+                                  (lambda (in cmd)
+                                    (and (>= (length cmd) (length in))
+                                         (string-equal cmd in :end1 (length in)))))))
+                (when match
+                  (setf (st :input-buffer) (reverse (coerce match 'list)))
+                  (when (member match '("/eval" "/focus" "/scope") :test #'string=)
+                    (push #\Space (st :input-buffer)))
+                  (setf (st :dirty) (list nil nil t))))))))
+       ;; Backspace
+       ((or (eq ch :backspace) (eql ch 127) (eql ch 8)
+            (eql ch #\Backspace))
+        (input-delete-char)
+        (setf (st :dirty) (list nil nil t)))
+       ;; Left arrow
+       ((or (eq ch :left) (eql ch 260))
+        (when (> (or (st :cursor-pos) 0) 0)
+          (decf (st :cursor-pos))
+          (setf (st :dirty) (list nil nil t))))
+       ;; Right arrow
+       ((or (eq ch :right) (eql ch 261))
+        (when (< (or (st :cursor-pos) 0) (length (st :input-buffer)))
+          (incf (st :cursor-pos))
+          (setf (st :dirty) (list nil nil t))))
+      ;; Up arrow
+       ((or (eq ch :up) (eql ch 259))
+        (let* ((h (st :input-history)) (p (st :input-hpos)))
+          (when (and h (< p (1- (length h))))
+            (incf (st :input-hpos))
+            (setf (st :input-buffer)
+                  (reverse (coerce (nth (st :input-hpos) h) 'list)))
+            (setf (st :dirty) (list nil nil t)))))
+       ;; Down arrow
+       ((or (eq ch :down) (eql ch 258))
+        (when (> (st :input-hpos) 0)
+          (decf (st :input-hpos))
+          (let ((h (st :input-history)))
+            (setf (st :input-buffer)
+                  (if (and h (< (st :input-hpos) (length h)))
+                      (reverse (coerce (nth (st :input-hpos) h) 'list))
+                      nil))
+            (setf (st :dirty) (list nil nil t)))))
+       ;; PageUp
+       ((or (eq ch :ppage) (eql ch 339))
+        (let ((max-offset (max 0 (- (length (st :messages)) 1))))
+          (setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 5))))
+        (setf (st :dirty) (list nil t nil)))
+       ;; PageDown
+       ((or (eq ch :npage) (eql ch 338))
+        (setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 5)))
+        (setf (st :dirty) (list nil t nil)))
+       ;; Printable
+       (t
+        (let ((chr (typecase ch
+                     (character ch)
+                     (integer (code-char ch))
+                     (t nil))))
+          (when (and chr (graphic-char-p chr))
+            (input-insert-char chr)
+            (setf (st :dirty) (list nil nil t))))))))
+
+(defun on-daemon-msg (msg)
+  (let* ((payload (getf msg :payload))
+         (text (getf payload :text))
+         (action (getf payload :action))
+         (gate-trace (getf msg :gate-trace))
+         (rule-count (getf payload :rule-count))
+         (foveal-id (getf payload :foveal-id)))
+    (when rule-count (setf (st :rule-count) rule-count))
+    (when foveal-id (setf (st :foveal-id) foveal-id))
+    (cond
+      (text (setf (st :busy) nil)
+            (add-msg :agent text :gate-trace gate-trace))
+      ((eq action :handshake)
+       (add-msg :system (format nil "Connected v~a" (getf payload :version))))
+      (t (add-msg :agent (format nil "~a" msg))))))
+
+(defun send-daemon (msg)
+  (let ((s (st :stream)))
+    (when (and s (open-stream-p s))
+      (handler-case
+          (progn
+            (format s "~a" (frame-message msg))
+            (finish-output s))
+        (error () nil)))))
+
+(defun recv-daemon (s)
+  (handler-case
+      (let* ((hdr (make-string 6)) (n 0))
+        (loop while (< n 6)
+              do (let ((ch (read-char s nil)))
+                    (unless ch (return-from recv-daemon nil))
+                    (setf (char hdr n) ch) (incf n)))
+        (let* ((len (parse-integer hdr :radix 16 :junk-allowed t))
+               (buf (make-string (or len 0))))
+          (when (and len (> len 0))
+            (loop for i from 0 below len
+                  do (let ((ch (read-char s nil)))
+                        (unless ch (return-from recv-daemon nil))
+                        (setf (char buf i) ch)))
+            (let ((*read-eval* nil))
+              (read-from-string buf)))))
+    (error () nil)))
+
+(defun reader-loop (s)
+  (let ((consecutive-nils 0))
+    (loop while (and (st :running) (open-stream-p s))
+          do (let ((msg (recv-daemon s)))
+               (if msg
+                   (progn (queue-event (list :type :daemon :payload msg))
+                          (setf consecutive-nils 0))
+                   (progn (sleep 0.5)
+                          (incf consecutive-nils)
+                          (when (> consecutive-nils 10)
+                            (queue-event (list :type :disconnected))
+                            (return))))))))
+
+(defun load-history ()
+  "Load input history from disk on TUI startup."
+  (let ((hist-file (merge-pathnames ".cache/passepartout/history"
+                                    (user-homedir-pathname))))
+    (when (uiop:file-exists-p hist-file)
+      (with-open-file (in hist-file :direction :input)
+        (loop for line = (read-line in nil nil)
+              while line
+              do (push line (st :input-history))))
+      (setf (st :input-history) (nreverse (st :input-history))))))
+
+(defun connect-daemon (&optional (host "127.0.0.1") (port 9105))
+  (add-msg :system "* Connecting to daemon... *")
+  (loop for attempt from 1 to 3
+        for backoff = 0 then 3
+        do (sleep backoff)
+           (handler-case
+               (let ((s (usocket:socket-connect host port :timeout 5)))
+                 (setf (st :stream) (usocket:socket-stream s)
+                       (st :connected) t)
+                 (bt:make-thread (lambda () (reader-loop (st :stream)))
+                                :name "tui-reader")
+                 (add-msg :system (format nil "* Connected v~a *" "0.4.0"))
+                 (return-from connect-daemon t))
+             (usocket:connection-refused-error (c)
+               (when (= attempt 3)
+                 (add-msg :system (format nil "* No daemon on port ~a after ~a attempts *"
+                                         port attempt))))
+             (error (c)
+               (add-msg :system (format nil "* Connection attempt ~a failed: ~a *"
+                                        attempt c))
+               (when (= attempt 3)
+                 (add-msg :system "* TIP: run 'passepartout daemon' first *")))))
+  nil)
+
+(defun disconnect-daemon ()
+  (when (st :stream)
+    (ignore-errors (close (st :stream)))
+    (setf (st :stream) nil (st :connected) nil)
+    (add-msg :system "* Disconnected *")))
+
+(defun tui-main ()
+  (init-state)
+  (load-history)
+  (theme-load)
+  (with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
+    (let* ((h (or (height scr) 24))
+           (w (or (width scr) 80))
+           (sw (make-instance 'window :height 3 :width (- w 2) :y 0 :x 1))
+           (ch (- h 5))
+           (cw (make-instance 'window :height ch :width (- w 2) :y 3 :x 1))
+           (iw (make-instance 'window :height 1 :width (- w 2) :y (- h 1) :x 1))
+            (swank-port (or (ignore-errors
+                              (parse-integer (uiop:getenv "TUI_SWANK_PORT")))
+                            4006)))
+       (setf (function-keys-enabled-p iw) t
+             (input-blocking iw) nil
+             (st :dirty) (list t t t)
+             ;; Store windows in state for SIGWINCH handler
+             (st :scr) scr (st :sw) sw (st :cw) cw (st :iw) iw)
+       (connect-daemon)
+       (when (> swank-port 0)
+         (handler-case
+             (progn
+               (ql:quickload :swank :silent t)
+               (funcall (find-symbol "CREATE-SERVER" "SWANK")
+                        :port swank-port :dont-close t)
+               (add-msg :system
+                        (format nil "* Swank ~d  M-x slime-connect *" swank-port)))
+           (error ()
+             (add-msg :system "* Swank unavailable *"))))
+       ;; Initial render before the main loop — otherwise the screen stays
+       ;; blank until the first keystroke (get-char blocks).
+       (redraw sw cw ch iw)
+       (refresh scr)
+       (loop while (st :running) do
+        (dolist (ev (drain-queue))
+          (cond
+            ((eq (getf ev :type) :daemon)
+             (on-daemon-msg (getf ev :payload)))
+            ((eq (getf ev :type) :disconnected)
+             (setf (st :connected) nil
+                   (st :busy) nil)
+             (add-msg :system "* Connection lost — type /reconnect to retry *"))))
+        (let ((ch (get-char iw)))
+          (cond
+            ((or (not ch) (equal ch -1)) nil)
+            ;; KEY_RESIZE — terminal was resized (SIGWINCH from ncurses)
+            ((eql ch 410)
+             (let* ((new-h (or (height scr) 24))
+                    (new-w (or (width scr) 80))
+                    (new-ch (- new-h 5)))
+               (setq sw (make-instance 'window :height 3 :width (- new-w 2) :y 0 :x 1)
+                     ch new-ch
+                     cw (make-instance 'window :height new-ch :width (- new-w 2) :y 3 :x 1)
+                     iw (make-instance 'window :height 1 :width (- new-w 2) :y (- new-h 1) :x 1)
+                     w new-w
+                     h new-h)
+               (setf (function-keys-enabled-p iw) t
+                     (input-blocking iw) nil
+                     (st :dirty) (list t t t)
+                     (st :sw) sw (st :cw) cw (st :iw) iw)
+               (redraw sw cw ch iw)
+               (refresh scr)))
+            (t (on-key ch))))
+        (redraw sw cw ch iw)
+        (refresh scr)
+        (sleep 0.03))
+       (disconnect-daemon))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-tui-tests
+  (:use :cl :passepartout :passepartout.channel-tui)
+  (:export #:tui-suite))
+
+(in-package :passepartout-tui-tests)
+
+(fiveam:def-suite tui-suite :description "Verification of the TUI model and event handling")
+(fiveam:in-suite tui-suite)
+
+(fiveam:test test-init-state
+  "Contract model.1: init-state returns fresh state plist with required keys."
+  (init-state)
+  (fiveam:is (eq t (st :running)))
+  (fiveam:is (eq :chat (st :mode)))
+  (fiveam:is (eq nil (st :connected)))
+  (fiveam:is (eq nil (st :stream)))
+  (fiveam:is (eq nil (st :messages)))
+  (fiveam:is (eq 0 (st :scroll-offset)))
+  (fiveam:is (eq nil (st :busy))))
+
+(fiveam:test test-add-msg
+  "Contract model.2: add-msg appends a message with role, content, and time."
+  (init-state)
+  (add-msg :user "hello")
+  (let* ((msgs (st :messages))
+         (msg (first msgs)))
+    (fiveam:is (eq :user (getf msg :role)))
+    (fiveam:is (string= "hello" (getf msg :content)))
+    (fiveam:is (stringp (getf msg :time)))
+    (fiveam:is (= 5 (length (getf msg :time))))))
+
+(fiveam:test test-add-msg-dirty-flag
+  "Contract model.2: add-msg sets dirty flags for status and chat."
+  (init-state)
+  (setf (st :dirty) (list nil nil nil))
+  (add-msg :system "boot")
+  (let ((dirty (st :dirty)))
+    (fiveam:is (eq t (first dirty)))
+    (fiveam:is (eq t (second dirty)))
+    (fiveam:is (eq nil (third dirty)))))
+
+(fiveam:test test-queue-event-roundtrip
+  "Contract model.3: queue-event + drain-queue preserves events in order."
+  (init-state)
+  (queue-event '(:type :key :payload (:ch 13)))
+  (queue-event '(:type :daemon :payload (:text "hi")))
+  (let ((evs (drain-queue)))
+    (fiveam:is (= 2 (length evs)))
+    (fiveam:is (equal '(:type :key :payload (:ch 13)) (first evs)))
+    (fiveam:is (equal '(:type :daemon :payload (:text "hi")) (second evs)))
+    (fiveam:is (null (drain-queue)))))
+
+(fiveam:test test-on-key-enter-sends-user-message
+  "Contract 1: on-key with Enter extracts input, adds user message, clears buffer."
+  (init-state)
+  ;; Simulate typing "test"
+  (dolist (ch '(#\t #\e #\s #\t))
+    (on-key (char-code ch)))
+  (fiveam:is (string= "test" (input-string)))
+  ;; Simulate Enter key — ncurses returns 343 (KEY_ENTER) when keypad is enabled
+  (on-key 343)
+  ;; Input buffer should be cleared
+  (fiveam:is (string= "" (input-string)))
+  ;; A user message should be in the message list
+  (let ((msgs (st :messages)))
+    (fiveam:is (>= (length msgs) 1))
+    (let ((last (first msgs)))
+      (fiveam:is (eq :user (getf last :role)))
+      (fiveam:is (string= "test" (getf last :content))))))
+
+(fiveam:test test-on-key-eval-command
+  "Contract 1: on-key handles /eval command and displays result."
+  (init-state)
+  ;; Type "/eval (+ 1 2)"
+  (dolist (ch (coerce "/eval (+ 1 2)" 'list))
+    (on-key (char-code ch)))
+  (on-key 343)
+  (let ((msgs (st :messages)))
+    (fiveam:is (>= (length msgs) 1))
+    (let ((last-msg (first msgs)))
+      (fiveam:is (eq :system (getf last-msg :role)))
+      (fiveam:is (search "=> 3" (getf last-msg :content))))))
+
+(fiveam:test test-on-key-backspace
+  "Contract 1: on-key with Backspace removes last character from buffer."
+  (init-state)
+  (dolist (ch '(#\a #\b #\c))
+    (on-key (char-code ch)))
+  (fiveam:is (string= "abc" (input-string)))
+  ;; ncurses returns 263 (KEY_BACKSPACE) when keypad is enabled
+  (on-key 263)
+  (fiveam:is (string= "ab" (input-string))))
+
+(fiveam:test test-on-key-focus-command
+  "Contract 1: /focus command parses project name."
+  (init-state)
+  (dolist (ch (coerce "/focus myapp" 'list))
+    (on-key (char-code ch)))
+  (on-key 343)
+  (let ((msg (first (st :messages))))
+    (fiveam:is (eq :system (getf msg :role)))))
+
+(fiveam:test test-on-key-scope-command
+  "Contract 1: /scope command with valid argument."
+  (init-state)
+  (dolist (ch (coerce "/scope memex" 'list))
+    (on-key (char-code ch)))
+  (on-key 343)
+  (let ((msg (first (st :messages))))
+    (fiveam:is (eq :system (getf msg :role)))))
+
+(fiveam:test test-on-key-unfocus-command
+  "Contract 1: /unfocus command dispatches correctly."
+  (init-state)
+  (dolist (ch (coerce "/unfocus" 'list))
+    (on-key (char-code ch)))
+  (on-key 343)
+  (let ((msg (first (st :messages))))
+    (fiveam:is (eq :system (getf msg :role)))))
+
+(fiveam:test test-on-key-tab-completion
+  "Contract 1: Tab completes / commands when input starts with /."
+  (init-state)
+  (dolist (ch (coerce "/ev" 'list))
+    (on-key (char-code ch)))
+  (on-key 9)
+  (fiveam:is (string= "/eval " (input-string))))
+
+(fiveam:test test-on-key-tab-no-slash
+  "Contract 1: Tab does nothing when input doesn't start with /."
+  (init-state)
+  (dolist (ch (coerce "hello" 'list))
+    (on-key (char-code ch)))
+  (on-key 9)
+  (fiveam:is (string= "hello" (input-string))))
+
+(fiveam:test test-on-key-multiline
+  "Contract 1: \\ + Enter inserts newline instead of sending."
+  (init-state)
+  (dolist (ch (coerce "line1" 'list))
+    (on-key (char-code ch)))
+  (on-key (char-code #\\))
+  (on-key 343)
+  (fiveam:is (search "line1" (input-string)))
+  (fiveam:is (search (string #\Newline) (input-string))))
+
+(fiveam:test test-on-key-help
+  "Contract 1: /help displays command list."
+  (init-state)
+  (dolist (ch (coerce "/help" 'list))
+    (on-key (char-code ch)))
+  (on-key 343)
+  (let ((msgs (st :messages)))
+    (fiveam:is (>= (length msgs) 3))
+    (fiveam:is (some (lambda (m) (search "/eval" (getf m :content))) msgs))))
+
+(fiveam:test test-activity-indicator
+  "Contract model: :busy flag is set on send and cleared on agent response."
+  (init-state)
+  (fiveam:is (eq nil (st :busy)))
+  ;; Simulate sending a normal message (sets busy)
+  (dolist (ch (coerce "hello" 'list))
+    (on-key (char-code ch)))
+  (on-key 343)
+  (fiveam:is (eq t (st :busy)))
+  ;; Simulate receiving an agent response (clears busy)
+  (on-daemon-msg '(:type :event :payload (:text "hi back")))
+  (fiveam:is (eq nil (st :busy))))
+
+(fiveam:test test-theme
+  "Contract view: *tui-theme* provides color mappings."
+  (fiveam:is (eq :green (getf *tui-theme* :user)))
+  (fiveam:is (eq :white (getf *tui-theme* :agent)))
+  (fiveam:is (eq :yellow (getf *tui-theme* :system)))
+  (fiveam:is (eq :cyan (getf *tui-theme* :input)))
+  (fiveam:is (eq :white (theme-color :unknown-role))))

lisp/channel-tui-state.lisp

@@ -0,0 +1,154 @@
+(defpackage :passepartout.channel-tui
+  (:use :cl :croatoan :passepartout :usocket :bordeaux-threads)
+  (:export :tui-main :st :add-msg :now :input-string
+           :queue-event :drain-queue :init-state
+           :view-status :view-chat :view-input :redraw
+           :on-key :on-daemon-msg :send-daemon
+           :connect-daemon :disconnect-daemon
+           :*tui-theme* :theme-color))
+(in-package :passepartout.channel-tui)
+
+(defvar *state* nil)
+(defvar *event-queue* nil)
+(defvar *event-lock* (bt:make-lock "tui-event-lock"))
+
+(defvar *tui-theme*
+  ;; Roles
+  '(:user :green :agent :white :system :yellow
+    ;; Content
+    :input :cyan :timestamp :yellow :help :cyan :error :red :warning :yellow
+    ;; Status
+    :connected :green :disconnected :red :busy :magenta :idle :white
+    ;; Gate trace
+    :gate-passed :green :gate-blocked :red :gate-approval :yellow
+    ;; Tools (future use)
+    :tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white
+    ;; Display
+    :scroll-indicator :cyan :border :white :background :black
+    ;; Differentiator (v0.4.0)
+    :rule-count :cyan :focus-map :yellow
+    ;; UI
+    :dim :white :highlight :cyan :accent :green)
+  "Color theme plist. 27 semantic keys → Croatoan color values.
+See *tui-theme-presets* for named presets (dark, light, solarized, gruvbox).")
+
+(defvar *tui-theme-presets*
+  '(:dark  (:user :green :agent :white :system :yellow
+            :input :cyan :timestamp :yellow :help :cyan :error :red :warning :yellow
+            :connected :green :disconnected :red :busy :magenta :idle :white
+            :gate-passed :green :gate-blocked :red :gate-approval :yellow
+            :tool-running :magenta :tool-success :green :tool-failure :red :tool-output :white
+            :scroll-indicator :cyan :border :white :background :black
+            :rule-count :cyan :focus-map :yellow
+            :dim :white :highlight :cyan :accent :green)
+    :light (:user :blue :agent :black :system :red
+            :input :black :timestamp :yellow :help :blue :error :red :warning :yellow
+            :connected :green :disconnected :red :busy :magenta :idle :black
+            :gate-passed :green :gate-blocked :red :gate-approval :yellow
+            :tool-running :magenta :tool-success :green :tool-failure :red :tool-output :black
+            :scroll-indicator :blue :border :black :background :white
+            :rule-count :blue :focus-map :red
+            :dim :white :highlight :blue :accent :green)
+    :gruvbox (:user "#458588" :agent "#ebdbb2" :system "#fabd2f"
+              :input "#ebdbb2" :timestamp "#928374" :help "#83a598" :error "#fb4934" :warning "#fabd2f"
+              :connected "#b8bb26" :disconnected "#fb4934" :busy "#d3869b" :idle "#a89984"
+              :gate-passed "#b8bb26" :gate-blocked "#fb4934" :gate-approval "#fabd2f"
+              :tool-running "#d3869b" :tool-success "#b8bb26" :tool-failure "#fb4934" :tool-output "#ebdbb2"
+              :scroll-indicator "#83a598" :border "#a89984" :background "#282828"
+              :rule-count "#83a598" :focus-map "#fabd2f"
+              :dim "#928374" :highlight "#83a598" :accent "#b8bb26")
+    :solarized (:user "#268bd2" :agent "#839496" :system "#b58900"
+                :input "#839496" :timestamp "#93a1a1" :help "#2aa198" :error "#dc322f" :warning "#b58900"
+                :connected "#859900" :disconnected "#dc322f" :busy "#d33682" :idle "#657b83"
+                :gate-passed "#859900" :gate-blocked "#dc322f" :gate-approval "#b58900"
+                :tool-running "#d33682" :tool-success "#859900" :tool-failure "#dc322f" :tool-output "#839496"
+                :scroll-indicator "#2aa198" :border "#657b83" :background "#002b36"
+                :rule-count "#2aa198" :focus-map "#b58900"
+                :dim "#586e75" :highlight "#2aa198" :accent "#859900"))
+  "Named theme presets. /theme <name> loads one into *tui-theme*.")
+
+(defvar *tui-theme-current-name* :dark
+  "Name of the currently active theme preset.")
+
+(defun theme-save ()
+  "Persist current theme to disk."
+  (let ((path (merge-pathnames ".cache/passepartout/theme.lisp"
+                               (user-homedir-pathname))))
+    (uiop:ensure-all-directories-exist (list path))
+    (with-open-file (out path :direction :output :if-exists :supersede :if-does-not-exist :create)
+      (format out ";; Passepartout TUI theme — auto-generated~%")
+      (format out "(setf passepartout.channel-tui::*tui-theme* '~s)~%" *tui-theme*)
+      (format out "(setf passepartout.channel-tui::*tui-theme-current-name* ~s)~%" *tui-theme-current-name*))
+    t))
+
+(defun theme-load ()
+  "Load persisted theme from disk. Called at startup."
+  (let ((path (merge-pathnames ".cache/passepartout/theme.lisp"
+                               (user-homedir-pathname))))
+    (when (uiop:file-exists-p path)
+      (ignore-errors (load path)))))
+
+(defun theme-switch (name)
+  "Switch to a named theme preset. Returns the preset name or nil if not found."
+  (let* ((key (intern (string-upcase (string name)) :keyword))
+         (preset (getf *tui-theme-presets* key)))
+    (when preset
+      (setf *tui-theme* (copy-list preset)
+            *tui-theme-current-name* key)
+      (theme-save)
+      (setf (st :dirty) (list t t t))
+      key)))
+
+(defun theme-color (role)
+  "Returns the Croatoan color for a semantic role."
+  (or (getf *tui-theme* role) :white))
+
+(defun st (key) (getf *state* key))
+(defun (setf st) (val key) (setf (getf *state* key) val))
+
+(defun init-state ()
+  (setf *state*
+        (list :running t :mode :chat :connected nil :stream nil
+              :input-buffer nil :input-history nil :input-hpos 0
+              :messages (make-array 16 :adjustable t :fill-pointer 0)
+              :scroll-offset 0 :busy nil :cursor-pos 0
+              :dirty (list nil nil nil))))
+
+(defun now ()
+  (multiple-value-bind (s m h) (get-decoded-time)
+    (declare (ignore s))
+    (format nil "~2,'0d:~2,'0d" h m)))
+
+(defun input-string ()
+  (coerce (reverse (st :input-buffer)) 'string))
+
+(defun input-insert-char (ch)
+  "Insert character at cursor position into the input buffer."
+  (let* ((buf (st :input-buffer))
+         (pos (or (st :cursor-pos) 0))
+         (s (coerce (reverse buf) 'string))
+         (new (concatenate 'string (subseq s 0 pos) (string ch) (subseq s pos))))
+    (setf (st :input-buffer) (reverse (coerce new 'list)))
+    (setf (st :cursor-pos) (1+ pos))))
+
+(defun input-delete-char ()
+  "Delete character before cursor position (standard backspace)."
+  (let* ((buf (st :input-buffer))
+         (pos (or (st :cursor-pos) 0)))
+    (when (and buf (> pos 0))
+      (let* ((s (coerce (reverse buf) 'string))
+             (new (concatenate 'string (subseq s 0 (1- pos)) (subseq s pos))))
+        (setf (st :input-buffer) (reverse (coerce new 'list)))
+        (setf (st :cursor-pos) (1- pos))))))
+
+(defun add-msg (role content &key gate-trace)
+  (vector-push-extend (list :role role :content content :time (now) :gate-trace gate-trace) (st :messages))
+  (setf (st :dirty) (list t t nil)))
+
+(defun queue-event (ev)
+  (bt:with-lock-held (*event-lock*) (push ev *event-queue*)))
+
+(defun drain-queue ()
+  (bt:with-lock-held (*event-lock*)
+    (let ((evs (nreverse *event-queue*)))
+      (setf *event-queue* nil) evs)))

lisp/channel-tui-view.lisp

@@ -0,0 +1,108 @@
+(in-package :passepartout.channel-tui)
+
+(defun view-status (win)
+  (clear win)
+  (box win 0 0)
+  (add-string win
+   (format nil " Passepartout  ~a  [~a]  msgs:~a  scroll:~a  Rules:~a~a"
+           (if (st :connected) "● Connected" "○ Disconnected")
+           (string-upcase (string (st :mode)))
+           (length (st :messages))
+           (if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
+           (or (st :rule-count) 0)
+           (if (st :busy) "  …thinking" ""))
+   :y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
+  ;; Second line: Focus map
+  (let ((focus-info (or (st :foveal-id) "")))
+    (when (and focus-info (> (length focus-info) 0))
+      (add-string win (format nil " [Focus: ~a]" focus-info)
+                  :y 2 :x 1 :fgcolor (theme-color :timestamp))))
+  (add-string win (format nil " ~a" (now)) :y 2 :x 1 :fgcolor (theme-color :timestamp))
+  (refresh win))
+
+(defun word-wrap (text width)
+  "Break text into lines at word boundaries, each <= width chars.
+Returns list of trimmed strings. Single words wider than width are split."
+  (let ((lines '())
+        (pos 0)
+        (len (length text)))
+    (loop while (< pos len)
+          do (let ((end (min len (+ pos width))))
+               (cond
+                 ((>= end len)
+                  (push (string-trim '(#\Space) (subseq text pos len)) lines)
+                  (setf pos len))
+                 ((char= (char text (1- end)) #\Space)
+                  (push (string-trim '(#\Space) (subseq text pos end)) lines)
+                  (setf pos end))
+                 (t
+                  (let ((last-space (position #\Space text :from-end t :end (1+ end) :start pos)))
+                    (if (and last-space (> last-space pos))
+                        (progn
+                          (push (string-trim '(#\Space) (subseq text pos last-space)) lines)
+                          (setf pos (1+ last-space)))
+                        (progn
+                          (push (string-trim '(#\Space) (subseq text pos end)) lines)
+                          (setf pos end))))))))
+    (nreverse lines)))
+
+(defun view-chat (win h)
+  (clear win)
+  (box win 0 0)
+  (let* ((w (or (width win) 78))
+         (msgs (st :messages))
+         (total (length msgs))
+         (max-lines (- h 2))
+         (y 1))
+    ;; Count visible messages from end, accounting for word wrap
+    (let* ((msg-count 0)
+           (lines-remaining max-lines))
+      (loop for i from (1- total) downto 0
+            while (> lines-remaining 0)
+            do (let* ((msg (aref msgs i))
+                      (role (getf msg :role))
+                      (content (getf msg :content))
+                      (time (or (getf msg :time) ""))
+                      (prefix (case role (:user "⬆") (:agent "⬇") (t "  ")))
+                      (line-text (format nil "~a [~a] ~a" prefix time content))
+                      (wrapped (word-wrap line-text (- w 2)))
+                      (nlines (length wrapped)))
+                 (if (<= nlines lines-remaining)
+                     (progn (decf lines-remaining nlines) (incf msg-count))
+                     (setf lines-remaining 0))))
+      ;; Render from the correct starting message
+      (let* ((scroll-skip (st :scroll-offset))
+             (start (max 0 (- total msg-count scroll-skip))))
+        (loop for i from start below total
+              while (< y (1- h))
+              do (let* ((msg (aref msgs i))
+                        (role (getf msg :role))
+                        (content (getf msg :content))
+                        (time (or (getf msg :time) ""))
+                        (color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent))))
+                        (prefix (case role (:user "⬆") (:agent "⬇") (t "  ")))
+                        (line-text (format nil "~a [~a] ~a" prefix time content))
+                        (wrapped (word-wrap line-text (- w 2))))
+                   (dolist (line wrapped)
+                     (when (< y (1- h))
+                       (add-string win line :y y :x 1 :n (1- w) :fgcolor color)
+                        (incf y))))))))
+  (refresh win))
+
+(defun view-input (win)
+  (let* ((text (input-string))
+         (w (or (width win) 78))
+         (pos (or (st :cursor-pos) 0))
+         (display-start (max 0 (- pos (1- w))))
+         (visible (subseq text display-start (min (length text) (+ display-start w)))))
+    (clear win)
+    (add-string win (format nil "~a " visible) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
+    (setf (cursor-position win) (list 0 (min (- pos display-start) (1- w)))))
+  (refresh win))
+
+(defun redraw (sw cw ch iw)
+  (destructuring-bind (sd cd id) (st :dirty)
+    (when sd (view-status sw))
+    (when cd (view-chat cw ch))
+    (when id (view-input iw))
+    (setf (st :dirty) (list nil nil nil))))

lisp/core-package.lisp

@@ -63,6 +63,7 @@
     #:cognitive-verify
     #:backend-cascade-call
     #:json-alist-to-plist
+    #:json-alist-to-plist
     #:inject-stimulus
     #:stimulus-inject
     #:hitl-create
@@ -163,6 +164,8 @@
     #:messaging-link
     #:messaging-unlink
     #:gateway-configured-p))
+(in-package :passepartout)
+
 
 (in-package :passepartout)
 

lisp/core-pipeline.lisp

@@ -120,7 +120,8 @@
   ;; Run proactive diagnostics before starting services
   (diagnostics-startup-run)
   
-  (heartbeat-start)
+  (when (fboundp 'events-start-heartbeat)
+    (events-start-heartbeat))
   (start-daemon)
 
   #+sbcl

lisp/core-reason.lisp

@@ -1,13 +1,5 @@
 (in-package :passepartout)
-
-(defvar *probabilistic-backends* (make-hash-table :test 'equal)
-  "Maps provider keyword → handler function (prompt system-prompt &key model).")
-
-(defun register-probabilistic-backend (name fn)
-  "Register FN as the handler for provider NAME."
-  (setf (gethash name *probabilistic-backends*) fn))
-
-(defvar *backend-registry* (make-hash-table :test 'equal))
+(defvar *probabilistic-backends* (make-hash-table :test 'equal))
 
 (defvar *provider-cascade* nil)
 
@@ -15,9 +7,6 @@
 
 (defvar *consensus-enabled* nil)
 
-(defun backend-register (name fn)
-  (setf (gethash name *backend-registry*) fn))
-
 (defun backend-cascade-call (prompt &key
                                 (system-prompt "You are the Probabilistic engine.")
                                 (cascade nil)
@@ -28,7 +17,7 @@
     (dolist (backend backends (or result
                                    (list :type :LOG
                                          :payload (list :text "Neural Cascade Failure: All providers exhausted."))))
-      (let ((backend-fn (or (gethash backend *backend-registry*)
+      (let ((backend-fn (or (gethash backend *probabilistic-backends*)
                             (gethash backend *probabilistic-backends*))))
         (when backend-fn
           (log-message "PROBABILISTIC: Attempting backend ~a..." backend)
@@ -64,19 +53,15 @@
         (string-trim '(#\Space #\Newline #\Tab) cleaned))
       text))
 
-(defun plist-keywords-normalize (plist)
-  (when (listp plist)
-    (loop for (k v) on plist by #'cddr
-          collect (if (and (symbolp k) (not (keywordp k)))
-                       (intern (string k) :keyword)
-                       k)
-          collect v)))
-
 (defun think (context)
   (let* ((active-skill (find-triggered-skill context))
          (tool-belt (generate-tool-belt-prompt))
-         (global-context (context-assemble-global-awareness))
-         (system-logs (context-get-system-logs))
+        (global-context (if (fboundp 'context-assemble-global-awareness)
+                            (context-assemble-global-awareness)
+                            "No context awareness available. (symbolic-awareness skill not loaded)"))
+        (system-logs (if (fboundp 'context-get-system-logs)
+                         (context-get-system-logs)
+                         (list "No system logs available.")))
          (assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent"))
          (rejection-trace (proto-get (proto-get context :payload) :rejection-trace))
          (prompt-generator (when active-skill (skill-probabilistic-prompt active-skill)))
@@ -325,8 +310,8 @@ sorted by priority (highest first). Returns a rejection plist or the action."
 
 (test test-backend-cascade-with-mock
   "Contract 4: backend-cascade-call returns content from first successful backend."
-  (let ((passepartout::*backend-registry* (make-hash-table :test 'equal)))
-    (setf (gethash :mock-backend passepartout::*backend-registry*)
+  (let ((passepartout::*probabilistic-backends* (make-hash-table :test 'equal)))
+    (setf (gethash :mock-backend passepartout::*probabilistic-backends*)
           (lambda (prompt sp &key model)
             (declare (ignore prompt sp model))
             (list :status :success :content "mock-response")))
@@ -335,9 +320,9 @@ sorted by priority (highest first). Returns a rejection plist or the action."
 
 (test test-read-eval-rce-blocked
   "Contract 1/v0.3.1: #. reader macro in LLM output must not execute arbitrary code."
-  (let ((passepartout::*backend-registry* (make-hash-table :test 'equal))
+  (let ((passepartout::*probabilistic-backends* (make-hash-table :test 'equal))
         (passepartout::*provider-cascade* '(:mock-evil)))
-    (setf (gethash :mock-evil passepartout::*backend-registry*)
+    (setf (gethash :mock-evil passepartout::*probabilistic-backends*)
           (lambda (prompt sp &key model)
             (declare (ignore prompt sp model))
             (list :status :success :content "(#.(setf passepartout::*v031-rce-test* :PWNED))")))

lisp/core-skills.lisp

@@ -1,5 +1,7 @@
 (in-package :passepartout)
 
+(defvar *VAULT-MEMORY* (make-hash-table :test 'equal))
+
 (defun vector-cosine-similarity (v1 v2)
   "Computes cosine similarity between two vectors."
   (let* ((len1 (length v1)) (len2 (length v2)))
@@ -11,9 +13,6 @@
               (incf dot (* x y)) (incf n1 (* x x)) (incf n2 (* y y))))
           (if (or (zerop n1) (zerop n2)) 0.0 (/ dot (sqrt (* n1 n2))))))))
 
-(defun VAULT-MASK-STRING (s) (declare (ignore s)) "[MASKED]")
-(defvar *VAULT-MEMORY* (make-hash-table :test 'equal))
-
 (defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn)
 
 (defvar *skill-registry* (make-hash-table :test 'equal))
@@ -90,19 +89,19 @@ Unlike skills (which activate on triggers), standing mandates are always consult
          (all-files (append org-files lisp-files))
          (files (remove-if (lambda (f)
                              (let ((n (pathname-name f)))
-                                (or (string= n "core-defpackage")
+                                (or (string= n "core-package")
                                     (string= n "core-skills")
-                                    (string= n "core-communication")
+                                    (string= n "core-transport")
                                     (string= n "core-memory")
                                     (string= n "core-context")
-                                    (string= n "core-loop-perceive")
-                                    (string= n "core-loop-reason")
-                                    (string= n "core-loop-act")
-                                    (string= n "core-loop")
+                                    (string= n "core-perceive")
+                                    (string= n "core-reason")
+                                    (string= n "core-act")
+                                    (string= n "core-pipeline")
                                     (string= n "core-manifest")
-                                    (string= n "system-model-router")
-                                    (string= n "system-model-explorer")
-                                    (string= n "gateway-tui"))))
+                                    (string= n "neuro-router")
+                                    (string= n "neuro-explorer")
+                                    (string= n "channel-tui"))))
                            all-files))
         (adj (make-hash-table :test 'equal))
         (name-to-file (make-hash-table :test 'equal))

lisp/core-transport.lisp

@@ -62,7 +62,7 @@
   (let ((stream (usocket:socket-stream socket)))
     (handler-case
         (progn
-          (format stream "~a" (frame-message (make-hello-message "0.4.3")))
+          (format stream "~a" (frame-message (make-hello-message "0.5.0")))
           (finish-output stream)
           (loop
             (let ((msg (read-framed-message stream)))

lisp/embedding-backends.lisp

@@ -138,7 +138,7 @@ Pure Lisp, zero external dependencies, works fully offline."
                     (or (uiop:getenv "PASSEPARTOUT_DATA_DIR")
                         (namestring (merge-pathnames ".local/share/passepartout/"
                                                     (user-homedir-pathname))))))
-         (native-file (merge-pathnames "lisp/system-model-embedding-native.lisp" data-dir)))
+         (native-file (merge-pathnames "lisp/embedding-native.lisp" data-dir)))
     (handler-case
         (progn
           (load native-file :verbose nil :print nil)

lisp/gateway-messaging.lisp

@@ -6,189 +6,6 @@
 (defvar *gateway-registry* (make-hash-table :test 'equal)
   "Maps platform name to plist (:poll-fn :send-fn :default-interval)")
 
-(defun telegram-get-token ()
-  (vault-get-secret :telegram))
-
-(defun telegram-poll ()
-  "Polls Telegram for new messages and injects them into the harness."
-  (let* ((token (telegram-get-token)))
-    (when token
-      (let* ((last-id (getf (gethash "telegram" *gateway-configs*) :last-update-id 0))
-             (url (format nil "https://api.telegram.org/bot~a/getUpdates?offset=~a"
-                          token (1+ last-id))))
-        (handler-case
-            (let* ((response (dex:get url))
-                   (json (cl-json:decode-json-from-string response))
-                   (updates (cdr (assoc :result json))))
-              (dolist (update updates)
-                (let* ((update-id (cdr (assoc :update--id update)))
-                       (message (cdr (assoc :message update)))
-                       (chat (cdr (assoc :chat message)))
-                       (chat-id (cdr (assoc :id chat)))
-                       (text (cdr (assoc :text message))))
-                  (setf (getf (gethash "telegram" *gateway-configs*) :last-update-id) update-id)
-                  (when (and text chat-id)
-                    (log-message "TELEGRAM: Received message from ~a" chat-id)
-                    (unless (ignore-errors (hitl-handle-message text :telegram))
-                      (stimulus-inject
-                       (list :type :EVENT
-                             :meta (list :source :telegram :chat-id (format nil "~a" chat-id))
-                             :payload (list :sensor :user-input :text text))))))))
-          (error (c) (log-message "TELEGRAM POLL ERROR: ~a" c)))))))
-
-(defun telegram-send (action context)
-  "Sends a message via Telegram."
-  (declare (ignore context))
-  (let* ((payload (getf action :payload))
-         (meta (getf action :meta))
-         (chat-id (or (getf meta :chat-id) (getf payload :chat-id) (getf action :chat-id)))
-         (text (or (getf payload :text) (getf action :text)))
-         (token (telegram-get-token)))
-    (when (and token chat-id text)
-      (handler-case
-          (let ((url (format nil "https://api.telegram.org/bot~a/sendMessage" token)))
-            (dex:post url
-                      :headers '(("Content-Type" . "application/json"))
-                      :content (cl-json:encode-json-to-string
-                                `((chat_id . ,chat-id) (text . ,text)))))
-        (error (c) (log-message "TELEGRAM ERROR: ~a" c))))))
-
-(defun signal-get-account ()
-  (vault-get-secret :signal))
-
-(defun signal-poll ()
-  "Polls Signal for new messages and injects them into the harness."
-  (let ((account (signal-get-account)))
-    (when account
-      (handler-case
-          (let* ((output (uiop:run-program (list "signal-cli" "-u" account "receive" "--json")
-                                            :output :string :error-output :string :ignore-error-status t))
-                 (lines (cl-ppcre:split "\\\\n" output)))
-            (dolist (line lines)
-              (when (and line (> (length line) 0))
-                (let* ((json (ignore-errors (cl-json:decode-json-from-string line)))
-                       (envelope (cdr (assoc :envelope json)))
-                       (source (cdr (assoc :source envelope)))
-                       (data-message (cdr (assoc :data-message envelope)))
-                       (text (cdr (assoc :message data-message))))
-                  (when (and source text)
-                    (log-message "SIGNAL: Received message from ~a" source)
-                    (unless (ignore-errors (hitl-handle-message text :signal))
-                      (stimulus-inject
-                       (list :type :EVENT
-                             :meta (list :source :signal :chat-id source)
-                             :payload (list :sensor :user-input :text text)))))))))
-        (error (c) (log-message "SIGNAL POLL ERROR: ~a" c))))))
-
-(defun signal-send (action context)
-  "Sends a message via Signal."
-  (declare (ignore context))
-  (let* ((payload (getf action :payload))
-         (meta (getf action :meta))
-         (chat-id (or (getf meta :chat-id) (getf payload :chat-id) (getf action :chat-id)))
-         (text (or (getf payload :text) (getf action :text)))
-         (account (signal-get-account)))
-    (when (and account chat-id text)
-      (handler-case
-          (uiop:run-program (list "signal-cli" "-u" account "send" "-m" text chat-id)
-                            :output :string :error-output :string)
-        (error (c) (log-message "SIGNAL ERROR: ~a" c))))))
-
-(defun discord-get-token ()
-  (vault-get-secret :discord))
-
-(defun discord-send (action context)
-  "Sends a message via Discord REST API."
-  (declare (ignore context))
-  (let* ((payload (getf action :payload))
-         (meta (getf action :meta))
-         (channel-id (or (getf meta :channel-id) (getf payload :chat-id)))
-         (text (or (getf payload :text) (getf action :text)))
-         (token (discord-get-token)))
-    (when (and token channel-id text)
-      (handler-case
-          (dex:post (format nil "https://discord.com/api/v10/channels/~a/messages" channel-id)
-                    :headers '(("Authorization" . ,(format nil "Bot ~a" token))
-                               ("Content-Type" . "application/json"))
-                    :content (cl-json:encode-json-to-string
-                              `((content . ,text))))
-        (error (c) (log-message "DISCORD ERROR: ~a" c))))))
-
-(defun discord-poll ()
-  "Polls Discord via HTTP GET /channels/{id}/messages. In production,
-a WebSocket connection to the Gateway is preferred for real-time events."
-  (let* ((token (discord-get-token)))
-    (when token
-      (handler-case
-          (dolist (channel '("channel-id-here"))  ;; configured channel IDs
-            (let* ((last-id (getf (gethash "discord" *gateway-configs*) :last-update-id 0))
-                   (url (format nil "https://discord.com/api/v10/channels/~a/messages?after=~a"
-                               channel last-id))
-                   (response (dex:get url :headers
-                                       `(("Authorization" . ,(format nil "Bot ~a" token))))))
-              (let ((messages (ignore-errors
-                               (cdr (assoc :message
-                                      (cl-json:decode-json-from-string response))))))
-                (dolist (msg (and (listp messages) messages))
-                  (let* ((id (cdr (assoc :id msg)))
-                         (content (cdr (assoc :content msg)))
-                         (author (cdr (assoc :author msg)))
-                         (author-id (cdr (assoc :id author)))
-                         (is-bot (cdr (assoc :bot author))))
-                    (when (and id content (not is-bot))
-                      (setf (getf (gethash "discord" *gateway-configs*) :last-update-id) id)
-                      (unless (ignore-errors (hitl-handle-message content :discord))
-                        (stimulus-inject
-                         (list :type :EVENT
-                               :meta (list :source :discord :chat-id channel)
-                               :payload (list :sensor :user-input :text content))))))))))
-        (error (c) (log-message "DISCORD POLL ERROR: ~a" c))))))
-
-(defun slack-get-token ()
-  (vault-get-secret :slack))
-
-(defun slack-send (action context)
-  "Sends a message via Slack Web API."
-  (declare (ignore context))
-  (let* ((payload (getf action :payload))
-         (meta (getf action :meta))
-         (channel (or (getf meta :channel-id) (getf payload :chat-id)))
-         (text (or (getf payload :text) (getf action :text)))
-         (token (slack-get-token)))
-    (when (and token channel text)
-      (handler-case
-          (dex:post "https://slack.com/api/chat.postMessage"
-                    :headers `(("Authorization" . ,(format nil "Bearer ~a" token))
-                               ("Content-Type" . "application/json; charset=utf-8"))
-                    :content (cl-json:encode-json-to-string
-                              `((channel . ,channel) (text . ,text))))
-        (error (c) (log-message "SLACK ERROR: ~a" c))))))
-
-(defun slack-poll ()
-  "Polls Slack for new messages via conversations.history."
-  (let* ((token (slack-get-token)))
-    (when token
-      (dolist (channel '("general"))  ;; configured channel IDs
-        (handler-case
-            (let* ((url (format nil "https://slack.com/api/conversations.history?channel=~a&limit=5" channel))
-                   (response (dex:get url :headers
-                                       `(("Authorization" . ,(format nil "Bearer ~a" token))))))
-              (let* ((json (ignore-errors (cl-json:decode-json-from-string response)))
-                     (ok (cdr (assoc :ok json)))
-                     (messages (cdr (assoc :messages json))))
-                (when (and ok messages (listp messages))
-                  (dolist (msg messages)
-                    (let* ((text (cdr (assoc :text msg)))
-                           (user (cdr (assoc :user msg)))
-                           (ts (cdr (assoc :ts msg))))
-                      (when (and text user (not (string= user "USLACKBOT")))
-                        (unless (ignore-errors (hitl-handle-message text :slack))
-                          (stimulus-inject
-                           (list :type :EVENT
-                                 :meta (list :source :slack :chat-id channel)
-                                 :payload (list :sensor :user-input :text text))))))))))
-          (error (c) (log-message "SLACK POLL ERROR: ~a" c)))))))
-
 (defun gateway-registry-initialize ()
   "Registers all built-in gateway handlers."
   (setf (gethash "telegram" *gateway-registry*)

lisp/programming-lisp.lisp

@@ -149,6 +149,28 @@
   :priority 400
   :trigger (lambda (ctx) (declare (ignore ctx)) nil))
 
+(defun plist-keywords-normalize (plist)
+
+  (when (listp plist)
+
+    (loop for (k v) on plist by #'cddr
+
+          collect (if (and (symbolp k) (not (keywordp k)))
+
+                       (intern (string k) :keyword)
+
+                       k)
+
+          collect v)))
+
+(defun plist-keywords-normalize (plist)
+  (when (listp plist)
+    (loop for (k v) on plist by #'cddr
+          collect (if (and (symbolp k) (not (keywordp k)))
+                       (intern (string k) :keyword)
+                       k)
+          collect v)))
+
 (defpackage :passepartout-utils-lisp-tests
   (:use :cl :fiveam :passepartout)
   (:export #:utils-lisp-suite))

lisp/programming-literate.lisp

@@ -88,7 +88,7 @@ contents of the Lisp file. Returns T if they match, or an error message."
 (test test-block-balance-check-valid
   "Contract 2: balanced parens return T."
   (is (eq t (literate-block-balance-check
-             (merge-pathnames "org/core-loop.org"
+             (merge-pathnames "org/core-pipeline.org"
                               (uiop:ensure-directory-pathname
                                (uiop:getenv "PASSEPARTOUT_DATA_DIR")))))))
 
@@ -98,6 +98,6 @@ contents of the Lisp file. Returns T if they match, or an error message."
 
 (test test-tangle-sync-check
   "Contract 3: literate-tangle-sync-check verifies org matches tangled lisp."
-  (let ((result (literate-tangle-sync-check "org/core-loop.org" "lisp/core-loop.lisp")))
+  (let ((result (literate-tangle-sync-check "org/core-pipeline.org" "lisp/core-pipeline.lisp")))
     (is (or (eq t result) (stringp result))
         "Should return T or a mismatch description")))

lisp/programming-org.lisp

@@ -136,7 +136,7 @@ Returns the filtered content as a string."
 (defun org-headline-find-by-title (ast title)
   "Finds a headline by its title in the AST."
   (let ((props (getf ast :properties)))
-    (when (string-equal (getf props :TITLE) title)
+     (when (string-equal (getf props :TITLE) title)
       (return-from org-headline-find-by-title ast))
     (dolist (child (getf ast :contents))
       (when (listp child)
@@ -144,6 +144,22 @@ Returns the filtered content as a string."
           (when found (return-from org-headline-find-by-title found)))))
      nil))
 
+(defun org-id-get-create (ast target-id)
+  "If the headline at TARGET-ID has an :ID property, return it.
+If not, generate a new UUID, set it as the :ID property, and return it.
+TARGET-ID can be a headline's :ID or :TITLE in the AST.
+Returns nil if the headline is not found."
+  (let ((headline (or (org-headline-find-by-id ast target-id)
+                      (org-headline-find-by-title ast target-id))))
+    (when headline
+      (let* ((props (getf headline :properties))
+             (id (getf props :ID)))
+        (if id
+            id
+            (let ((new-id (org-id-format (org-id-generate))))
+              (setf (getf props :ID) new-id)
+              new-id))))))
+
 (defun org-subtree-extract (org-content heading-name)
   "Extracts a subtree by heading name from Org text. Returns the subtree
 content as a string (headline + body + children), or nil if not found."
@@ -310,3 +326,32 @@ AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...))
       (is (string= "Child 2" (getf (getf found :properties) :TITLE))))
     (let ((missing (org-headline-find-by-id ast "nonexistent")))
       (is (null missing) "Missing ID should return nil"))))
+
+(test test-org-id-get-create
+  "Contract 7: org-id-get-create returns existing ID or creates and sets a new one."
+  ;; Case 1: headline already has an ID
+  (let* ((ast (list :type :HEADLINE
+                    :properties (list :ID "id:existing" :TITLE "Has ID")
+                    :contents nil)))
+    (is (string= "id:existing" (org-id-get-create ast "id:existing"))))
+  ;; Case 2: headline exists by title but has no ID — one should be created
+  (let* ((ast (list :type :HEADLINE
+                    :properties (list :TITLE "No ID")
+                    :contents nil)))
+    (let ((new-id (org-id-get-create ast "No ID")))
+      (is (stringp new-id))
+      (is (uiop:string-prefix-p "id:" new-id))
+      ;; Verify the ID was set on the headline
+      (is (string= new-id (getf (getf ast :properties) :ID)))))
+  ;; Case 3: idempotent — calling again returns same ID
+  (let* ((ast (list :type :HEADLINE
+                    :properties (list :TITLE "Idempotent")
+                    :contents nil)))
+    (let ((id1 (org-id-get-create ast "Idempotent"))
+          (id2 (org-id-get-create ast "Idempotent")))
+      (is (string= id1 id2))))
+  ;; Case 4: headline not found returns nil
+  (let* ((ast (list :type :HEADLINE
+                    :properties (list :ID "root" :TITLE "Root")
+                    :contents nil)))
+    (is (null (org-id-get-create ast "nonexistent")))))

lisp/programming-tools.lisp

@@ -247,6 +247,203 @@
   :trigger (lambda (ctx) (declare (ignore ctx)) nil)
   :deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))
 
+(defpackage :passepartout
+  (:use :cl)
+  (:export
+   #:frame-message
+   #:read-framed-message
+    #:PROTO-GET
+    #:proto-get
+   #:*VAULT-MEMORY*
+   #:make-hello-message
+   #:validate-communication-protocol-schema
+   #:start-daemon
+   #:log-message
+   #:main
+    #:diagnostics-run-all
+    #:diagnostics-main
+    #:diagnostics-dependencies-check
+    #:diagnostics-env-check
+    #:register-provider
+    #:provider-openai-request
+    #:provider-config
+   #:run-setup-wizard
+   #:ingest-ast
+   #:memory-object-get
+   #:*memory-store*
+   #:memory-object
+   #:make-memory-object
+   #:memory-object-id
+   #:memory-object-type
+   #:memory-object-attributes
+   #:memory-object-parent-id
+   #:memory-object-children
+   #:memory-object-version
+   #:memory-object-last-sync
+   #:memory-object-vector
+   #:memory-object-content
+   #:memory-object-hash
+   #:memory-object-scope
+   #:snapshot-memory
+   #:rollback-memory
+    #:context-get-system-logs
+    #:context-assemble-global-awareness
+    #:context-awareness-assemble
+    #:context-query
+   #:push-context
+   #:pop-context
+   #:current-context
+   #:current-scope
+   #:context-stack-depth
+   #:context-save
+   #:context-load
+   #:focus-project
+   #:focus-session
+   #:focus-memex
+   #:unfocus
+   #:process-signal
+   #:loop-process
+    #:perceive-gate
+    #:loop-gate-perceive
+    #:act-gate
+    #:loop-gate-act
+    #:reason-gate
+    #:loop-gate-reason
+    #:cognitive-verify
+    #:backend-cascade-call
+    #:json-alist-to-plist
+    #:inject-stimulus
+    #:stimulus-inject
+    #:hitl-create
+    #:hitl-approve
+    #:hitl-deny
+    #:hitl-handle-message
+    #:dispatcher-check-secret-path
+    #:dispatcher-check-shell-safety
+    #:dispatcher-check-privacy-tags
+    #:dispatcher-check-network-exfil
+    #:dispatcher-gate
+    #:wildcard-match
+    #:actuator-initialize
+   #:action-dispatch
+   #:register-actuator
+   #:load-skill-from-org
+    #:skill-initialize-all
+    #:lisp-syntax-validate
+    #:defskill
+       #:*skill-registry*
+       #:*scope-resolver*
+       #:*embedding-backend*
+       #:*embedding-queue*
+       #:*embedding-provider*
+       #:embed-queue-object
+       #:embed-object
+       #:embed-all-pending
+       #:embedding-backend-hashing
+       #:embedding-backend-native
+       #:embedding-native-load-model
+       #:embedding-native-unload
+       #:embedding-native-ensure-loaded
+       #:embedding-native-get-dim
+       #:embeddings-compute
+       #:mark-vector-stale
+     #:skill
+   #:skill-name
+   #:skill-priority
+   #:skill-dependencies
+   #:skill-trigger-fn
+   #:skill-probabilistic-prompt
+   #:skill-deterministic-fn
+   #:def-cognitive-tool
+   #:*cognitive-tool-registry*
+    #:org-read-file
+    #:org-write-file
+    #:org-headline-add
+    #:org-headline-find-by-id
+    #:literate-tangle-sync-check
+    #:archivist-create-note
+    #:gateway-start
+    #:org-property-set
+    #:org-todo-set
+    #:org-id-generate
+    #:org-id-format
+    #:org-modify
+    #:lisp-validate
+    #:lisp-structural-check
+    #:lisp-syntactic-check
+    #:lisp-semantic-check
+    #:lisp-eval
+    #:lisp-format
+    #:lisp-list-definitions
+    #:lisp-extract
+    #:lisp-inject
+    #:lisp-slurp
+   #:get-oc-config-dir
+    #:get-tool-permission
+    #:set-tool-permission
+    #:check-tool-permission-gate
+    #:permission-get
+    #:permission-set
+   #:cognitive-tool
+   #:cognitive-tool-name
+   #:cognitive-tool-description
+   #:cognitive-tool-parameters
+   #:cognitive-tool-guard
+   #:cognitive-tool-body
+   #:register-probabilistic-backend
+   #:*probabilistic-backends*
+   #:*provider-cascade*
+    #:vault-get
+    #:vault-set
+    #:vault-get-secret
+    #:vault-set-secret
+    #:memory-objects-by-attribute
+    #:gateway-cli-input
+    #:repl-eval
+    #:repl-inspect
+    #:repl-list-vars
+    #:policy-compliance-check
+    #:validator-protocol-check
+    #:archivist-extract-headlines
+    #:archivist-headline-to-filename
+    #:literate-extract-lisp-blocks
+    #:literate-block-balance-check
+    #:gateway-registry-initialize
+    #:messaging-link
+    #:messaging-unlink
+    #:gateway-configured-p))
+
+(in-package :passepartout)
+
+(defun plist-get (plist key)
+  "Robust plist accessor — checks both :KEY and :key variants."
+  (let* ((s (string key))
+         (up (intern (string-upcase s) :keyword))
+         (dn (intern (string-downcase s) :keyword)))
+    (or (getf plist up) (getf plist dn))))
+
+(defvar *log-buffer* nil)
+(defvar *log-lock* (bordeaux-threads:make-lock "log-messages-lock"))
+(defvar *log-limit* 100)
+
+(defvar *skill-registry* (make-hash-table :test 'equal)
+  "Global registry of all loaded skills.")
+
+(defvar *telemetry-table* (make-hash-table :test 'equal))
+(defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock"))
+
+(defun telemetry-track (skill-name duration status)
+  "Updates performance metrics for a skill. STATUS is :success or :rejected."
+  (when skill-name
+    (bordeaux-threads:with-lock-held (*telemetry-lock*)
+      (let ((entry (or (gethash skill-name *telemetry-table*) (list :executions 0 :total-time 0 :failures 0))))
+        (incf (getf entry :executions))
+        (incf (getf entry :total-time) duration)
+        (when (eq status :rejected) (incf (getf entry :failures)))
+        (setf (gethash skill-name *telemetry-table*) entry)))))
+
+(defvar *cognitive-tool-registry* (make-hash-table :test 'equal))
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (ql:quickload :fiveam :silent t))
 

lisp/security-dispatcher.lisp

@@ -467,11 +467,11 @@ Recognized formats:
 (test test-self-build-core-protection
   "Contract v0.4.0: core-* paths are protected; write produces approval-required in SELF_BUILD_MODE."
   ;; Core paths are recognized
-  (is (passepartout::dispatcher-check-core-path "core-loop-reason.org"))
+  (is (passepartout::dispatcher-check-core-path "core-reason.org"))
   (is (passepartout::dispatcher-check-core-path "core-memory.lisp"))
-  (is (not (passepartout::dispatcher-check-core-path "gateway-tui-view.org")))
+  (is (not (passepartout::dispatcher-check-core-path "channel-tui-view.org")))
   ;; With SELF_BUILD_MODE=true, core writes produce approval-required
-  (let ((action '(:type :REQUEST :target :tool :payload (:tool "write-file" :args (:filepath "core-loop-reason.org" :content "x")))))
+  (let ((action '(:type :REQUEST :target :tool :payload (:tool "write-file" :args (:filepath "core-reason.org" :content "x")))))
     (setf (uiop:getenv "SELF_BUILD_MODE") "true")
     (let ((result (dispatcher-check action nil)))
       (is (eq :approval-required (getf result :level)))

lisp/security-vault.lisp

@@ -34,6 +34,8 @@
   :priority 600
   :trigger (lambda (ctx) (declare (ignore ctx)) nil))
 
+defvar *VAULT-MEMORY* (make-hash-table :test 'equal))
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (ql:quickload :fiveam :silent t))
 

lisp/symbolic-awareness.lisp

@@ -0,0 +1,228 @@
+(in-package :passepartout)
+
+(defun context-query (&key tag todo-state type scope)
+  "Filters the Memory based on tags, todo states, or types.
+Optional SCOPE restricts results to objects with that scope
+or :memex (global scope always visible)."
+  (let ((results nil))
+    (maphash (lambda (id obj)
+               (declare (ignore id))
+               (let* ((attrs (memory-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t))
+                 ;; Scope filter: if scope specified, only match :memex (global) or same scope
+                 (when (and scope (not (eq (memory-object-scope obj) :memex))
+                            (not (eq (memory-object-scope obj) scope)))
+                   (setf match nil))
+                 (when (and type (not (eq (memory-object-type obj) type))) (setf match nil))
+                 (when tag (unless (search tag (format nil "~a" (getf attrs :TAGS)) :test #'string-equal) (setf match nil)))
+                 (when (and todo-state (not (equal state todo-state))) (setf match nil))
+                 (when match (push obj results))))
+             *memory-store*)
+    results))
+
+(defun context-active-projects ()
+  "Returns headlines tagged as 'project' that are not yet marked DONE."
+  (remove-if (lambda (obj) (equal (getf (memory-object-attributes obj) :TODO-STATE) "DONE"))
+             (context-query :tag "project" :type :HEADLINE)))
+
+(defun context-recent-tasks () 
+  "Retrieves recently finished tasks from the store."
+  (context-query :todo-state "DONE" :type :HEADLINE))
+
+(defun context-skill-list ()
+  "Provides a sorted overview of currently loaded system capabilities."
+  (let ((results nil))
+    (maphash (lambda (name skill)
+               (declare (ignore name))
+               (push (list :name (skill-name skill) :priority (skill-priority skill) :dependencies (skill-dependencies skill)) results))
+             *skill-registry*)
+    (sort results #'> :key (lambda (x) (getf x :priority)))))
+
+(defun context-skill-source (skill-name)
+  "Reads the raw literate source of a specific skill for inspection."
+  (let* ((filename (format nil "~a.org" skill-name))
+         (data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") (namestring (merge-pathnames ".local/share/passepartout/" (user-homedir-pathname))))))
+         (org-dir (merge-pathnames "org/" data-dir))
+         (full-path (merge-pathnames filename org-dir)))
+     (if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))
+
+(defun context-skill-subtree (skill-name heading-name)
+  "Reads a specific headline subtree from a skill's Org source file.
+Returns the content under HEADING-NAME (including children) as a string,
+or nil if the heading is not found."
+  (let ((full-source (context-skill-source skill-name)))
+    (unless full-source (return-from context-skill-subtree nil))
+    (if (fboundp 'org-subtree-extract)
+        (org-subtree-extract full-source heading-name)
+        ;; Fallback: no org-subtree-extract available, return full source
+        full-source)))
+
+(defun context-logs (&optional limit)
+  "Retrieves the most recent lines from the harness's internal log."
+  (let ((log-limit (or limit (ignore-errors (parse-integer (uiop:getenv "CONTEXT_LOG_LIMIT"))) 20)))
+    (bt:with-lock-held (*log-lock*)
+      (let ((count (min log-limit (length *log-buffer*)))) 
+        (subseq *log-buffer* 0 count)))))
+
+(defun context-get-system-logs (&optional limit)
+  "Backward-compatibility alias for context-logs."
+  (context-logs limit))
+
+(defun context-object-render (obj &key (depth 1) (foveal-id nil) semantic-threshold (foveal-vector nil))
+  "Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model."
+  (let* ((id (memory-object-id obj))
+         (is-foveal (equal id foveal-id))
+         (title (or (getf (memory-object-attributes obj) :TITLE) "Untitled"))
+         (content (memory-object-content obj))
+         (children (memory-object-children obj))
+         (stars (make-string depth :initial-element #\*))
+         (obj-vector (memory-object-vector obj))
+         (threshold (or semantic-threshold (ignore-errors (read-from-string (uiop:getenv "CONTEXT_SEMANTIC_THRESHOLD"))) 0.75))
+         (similarity (if (and foveal-vector obj-vector (not is-foveal))
+                          (vector-cosine-similarity foveal-vector obj-vector)
+                         0.0))
+         (is-semantically-relevant (>= similarity threshold))
+         (should-render (or (<= depth 2) is-foveal is-semantically-relevant))
+         (output ""))
+    
+    (when should-render
+      (setf output (format nil "~a ~a~%:PROPERTIES:~%:ID: ~a~%" stars title id))
+      (when is-semantically-relevant
+        (setf output (concatenate 'string output (format nil ":SEMANTIC_SCORE: ~,2f~%" similarity))))
+      (setf output (concatenate 'string output (format nil ":END:~%")))
+      
+      (when (and content (or is-foveal is-semantically-relevant))
+        (setf output (concatenate 'string output content (string #\Newline))))
+      
+      (dolist (child-id children)
+        (let ((child-obj (memory-object-get child-id)))
+          (when child-obj
+            (let ((next-foveal (if is-foveal child-id foveal-id)))
+              (setf output (concatenate 'string output 
+                                        (context-object-render child-obj 
+                                                               :depth (1+ depth) 
+                                                               :foveal-id next-foveal
+                                                               :semantic-threshold threshold
+                                                               :foveal-vector foveal-vector))))))))
+    output))
+
+(defun context-path-resolve (path-string)
+  "Expands environment variables and strips literal quotes from a path string."
+  (let ((path (if (stringp path-string) 
+                  (string-trim '(#\" #\' #\Space) path-string)
+                  path-string)))
+    (if (and (stringp path) (search "$" path))
+        (let ((result path))
+          (ppcre:do-register-groups (var-name) ("\\$([A-Za-z0-9_]+)" path)
+            (let ((var-val (uiop:getenv var-name)))
+              (when var-val
+                (setf result (ppcre:regex-replace (format nil "\\$~a" var-name) result var-val)))))
+          result)
+        path)))
+
+(defun context-privacy-filtered-p (obj)
+  "Returns T if an org-object's :TAGS attribute matches the Dispatcher's privacy tags."
+  (let* ((attrs (memory-object-attributes obj))
+         (tags (getf attrs :TAGS))
+         (privacy-tags (and (find-package :passepartout.security-dispatcher)
+                            (symbol-value
+                             (find-symbol "*DISPATCHER-PRIVACY-TAGS*"
+                                          :passepartout.security-dispatcher)))))
+    (when (and tags privacy-tags)
+      (let ((tag-list (if (listp tags) tags (list tags))))
+        (some (lambda (tag)
+                (some (lambda (private)
+                        (string-equal (string-trim '(#\:) tag)
+                                      (string-trim '(#\:) private)))
+                      privacy-tags))
+              tag-list)))))
+
+(defun context-awareness-assemble (&optional signal)
+  "Produces a high-level skeletal outline of the current Memory for the LLM.
+Privacy-filtered objects (matching the Dispatcher's privacy tags) are excluded."
+  (let* ((foveal-id (or (getf signal :foveal-focus) 
+                         (ignore-errors (getf (getf signal :payload) :target-id))))
+         (foveal-vector (when foveal-id
+                          (memory-object-vector (memory-object-get foveal-id))))
+         (all-projects (context-active-projects))
+         (projects (remove-if #'context-privacy-filtered-p all-projects))
+         (output (format nil "GLOBAL MEMEX AWARENESS (Peripheral Vision):~%")))
+    (if projects
+        (dolist (project projects)
+          (setf output (concatenate 'string output
+                                    (context-object-render project :foveal-id foveal-id :foveal-vector foveal-vector))))
+          (setf output (concatenate 'string output "No active projects found.~%")))
+    output))
+
+(defun context-assemble-global-awareness ()
+  (context-awareness-assemble))
+
+(defskill :passepartout-symbolic-awareness
+  :priority 50
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-peripheral-vision-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:vision-suite))
+(in-package :passepartout-peripheral-vision-tests)
+
+(def-suite vision-suite :description "Verification of Foveal-Peripheral context model.")
+(in-suite vision-suite)
+
+(test test-foveal-rendering
+  "Contract 1: foveal content inline, peripheral content title-only."
+  (clrhash passepartout::*memory-store*)
+  (let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS ("project"))
+                :contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
+                             :raw-content "FOVEAL CONTENT" :contents nil)
+                            (:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node")
+                             :raw-content "PERIPHERAL CONTENT" :contents nil)))))
+    (ingest-ast ast)
+    (let ((output (context-awareness-assemble (list :foveal-focus "node-foveal"))))
+      (is (search "FOVEAL CONTENT" output))
+      (is (search "* Peripheral Node" output))
+      (is (not (search "PERIPHERAL CONTENT" output))))))
+
+(test test-awareness-budget
+  "Contract 1: all active projects appear in awareness output."
+  (clrhash passepartout::*memory-store*)
+  (ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS ("project")) :contents nil))
+  (ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS ("project")) :contents nil))
+  (let ((output (context-awareness-assemble)))
+    (is (search "Project 1" output))
+    (is (search "Project 2" output))))
+
+(test test-context-empty-memory
+  "Contract 1: empty memory produces clean output without error."
+  (clrhash passepartout::*memory-store*)
+  (let ((output (context-awareness-assemble)))
+    (is (stringp output))
+    (is (search "MEMEX" output :test #'char-equal))))
+
+(test test-context-no-foveal-focus
+  "Contract 2: without foveal focus, no inline content appears."
+  (clrhash passepartout::*memory-store*)
+  (let* ((ast '(:type :HEADLINE :properties (:ID "root" :TITLE "Root" :TAGS ("project"))
+                :contents ((:type :HEADLINE :properties (:ID "child" :TITLE "Child Node")
+                             :raw-content "CHILD CONTENT" :contents nil)))))
+    (ingest-ast ast)
+    (let ((output (context-awareness-assemble nil)))
+      (is (stringp output))
+      (is (not (search "CHILD CONTENT" output))))))
+
+(test test-semantic-retrieval-trigram
+  "Contract v0.4.0: trigram backend produces non-zero similarity for related content."
+  (let ((v1 (passepartout::embedding-backend-trigram "implement user login form"))
+        (v2 (passepartout::embedding-backend-trigram "add password authentication")))
+    (let ((sim (passepartout::vector-cosine-similarity v1 v2)))
+      (is (> sim 0.0))))
+  (let ((v3 (passepartout::embedding-backend-trigram "authentication login form handler module"))
+        (v4 (passepartout::embedding-backend-trigram "authentication login form handler fix")))
+    (let ((sim (passepartout::vector-cosine-similarity v3 v4)))
+      (is (> sim 0.75))))
+  (let ((v5 (passepartout::embedding-backend-trigram "authentication"))
+        (v6 (passepartout::embedding-backend-trigram "banana")))
+    (let ((sim (passepartout::vector-cosine-similarity v5 v6)))
+      (is (< sim 0.3)))))

lisp/symbolic-events.lisp

@@ -195,6 +195,25 @@ and registers them. Scans ~/memex/projects/ and ~/memex/system/ by default."
     (log-message "ORCHESTRATOR: Bootstrap complete (~d hooks, ~d cron jobs)"
                  hook-count cron-count)))
 
+(defun events-start-heartbeat ()
+  "Starts the background heartbeat thread. v0.5.0: extracted from core-loop."
+  (let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60))
+        (auto-save (or (ignore-errors (parse-integer (uiop:getenv "MEMORY_AUTO_SAVE_INTERVAL"))) *memory-auto-save-interval*)))
+    (setf *memory-auto-save-interval* auto-save)
+    (setf *heartbeat-save-counter* 0)
+    (setf *heartbeat-thread*
+          (bt:make-thread
+           (lambda ()
+             (loop
+               (sleep interval)
+               (incf *heartbeat-save-counter*)
+               (when (>= *heartbeat-save-counter* (/ *memory-auto-save-interval* interval))
+                 (setf *heartbeat-save-counter* 0)
+                 (save-memory-to-disk))
+               (stimulus-inject
+                  (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
+           :name "passepartout-heartbeat"))))
+
 (defskill :passepartout-system-event-orchestrator
   :priority 80
   :trigger (lambda (ctx)

lisp/system-integration-tests.lisp

@@ -0,0 +1,241 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t)
+  (ql:quickload :usocket :silent t))
+
+(defpackage :passepartout-integration-tests
+  (:use :cl :passepartout)
+  (:export #:integration-suite))
+
+(in-package :passepartout-integration-tests)
+
+(fiveam:def-suite integration-suite :description "Integration tests across process boundaries")
+(fiveam:in-suite integration-suite)
+
+(defvar *daemon-port* nil)
+
+(defun find-free-port ()
+  (let ((socket (usocket:socket-listen "127.0.0.1" 0 :reuse-address t)))
+    (unwind-protect (usocket:get-local-port socket)
+      (usocket:socket-close socket))))
+
+(defmacro with-daemon (() &body body)
+  `(let ((*daemon-port* (find-free-port)))
+     (unwind-protect
+          (progn
+            (passepartout:actuator-initialize)
+            (passepartout:skill-initialize-all)
+            (passepartout:start-daemon :port *daemon-port*)
+            (sleep 2)
+            ,@body)
+        (values)))
+
+(defun daemon-connect ()
+  (let* ((sock (usocket:socket-connect "127.0.0.1" *daemon-port*))
+         (stream (usocket:socket-stream sock)))
+    (read-framed-message stream)  ;; discard handshake
+    (values stream sock)))
+
+(defun daemon-send (stream msg)
+  (write-string (frame-message msg) stream)
+  (finish-output stream))
+
+(defun daemon-recv (stream &key (timeout 5))
+  (let ((deadline (+ (get-universal-time) timeout)))
+    (loop
+      (when (listen stream)
+        (return (read-framed-message stream)))
+      (when (> (get-universal-time) deadline) (return nil))
+      (sleep 0.1))))
+
+(fiveam:test test-daemon-starts
+  "Contract 1: daemon binds port and sends valid handshake."
+  (with-daemon ()
+    (multiple-value-bind (stream sock) (daemon-connect)
+      (is (open-stream-p stream))
+      (usocket:socket-close sock))))
+
+(fiveam:test test-pipeline-user-input
+  "Contract 2: :user-input traverses pipeline and produces a response."
+  (with-daemon ()
+    (multiple-value-bind (stream sock) (daemon-connect)
+      (unwind-protect
+           (progn
+             (daemon-send stream
+              '(:TYPE :EVENT :PAYLOAD (:SENSOR :user-input :TEXT "test")))
+             (let ((resp (daemon-recv stream :timeout 10)))
+               (is (not (null resp)) "Expected a response")))
+        (usocket:socket-close sock)))))
+
+(fiveam:test test-pipeline-heartbeat
+  "Contract 2: heartbeat signals do not crash the daemon."
+  (with-daemon ()
+    (multiple-value-bind (stream sock) (daemon-connect)
+      (unwind-protect
+           (daemon-send stream
+            '(:TYPE :EVENT :PAYLOAD (:SENSOR :heartbeat)))
+        (usocket:socket-close sock))
+      (pass))))
+
+(fiveam:test test-tcp-round-trip
+  "Contract 3: framed health-check survives TCP round-trip."
+  (with-daemon ()
+    (multiple-value-bind (stream sock) (daemon-connect)
+      (unwind-protect
+           (progn
+             (daemon-send stream '(:TYPE :health-check))
+             (let ((resp (daemon-recv stream :timeout 5)))
+               (is (not (null resp)))
+               (is (member (getf resp :type) '(:HEALTH-RESPONSE)))))
+        (usocket:socket-close sock)))))
+
+(fiveam:test test-daemon-survives-junk
+  "Contract 3: daemon does not crash on junk input."
+  (with-daemon ()
+    (multiple-value-bind (stream sock) (daemon-connect)
+      (write-string "ZZZZZZ" stream)
+      (finish-output stream)
+      (sleep 1)
+      (usocket:socket-close sock))
+    ;; Connect again to verify daemon is still alive
+    (multiple-value-bind (stream2 sock2) (daemon-connect)
+      (is (open-stream-p stream2))
+      (usocket:socket-close sock2))))
+
+(fiveam:test test-skill-registry-populated
+  "Contract 4: *skill-registry* is populated after daemon start."
+  (with-daemon ()
+    (is (hash-table-p passepartout::*skill-registry*))
+    (is (>= (hash-table-count passepartout::*skill-registry*) 1)
+        "Expected at least 1 skill in registry, got ~a"
+        (hash-table-count passepartout::*skill-registry*))))
+
+(fiveam:test test-shell-safe-echo
+  "Contract 5: safe shell command does not crash the daemon."
+  (with-daemon ()
+    (multiple-value-bind (stream sock) (daemon-connect)
+      (unwind-protect
+           (daemon-send stream
+            '(:TYPE :REQUEST :TARGET :shell
+              :PAYLOAD (:ACTION :execute :CMD "echo hello")))
+        (usocket:socket-close sock))
+      (pass))))
+
+(fiveam:test test-shell-dangerous-blocked
+  "Contract 5: rm -rf / is blocked by the security dispatcher."
+  (with-daemon ()
+    (multiple-value-bind (stream sock) (daemon-connect)
+      (unwind-protect
+           (daemon-send stream
+            '(:TYPE :REQUEST :TARGET :shell
+              :PAYLOAD (:ACTION :execute :CMD "rm -rf /")))
+        (usocket:socket-close sock))
+      (pass))))
+
+(fiveam:test test-cli-gateway-input
+  "Contract 6: text via TCP produces a response."
+  (with-daemon ()
+    (multiple-value-bind (stream sock) (daemon-connect)
+      (unwind-protect
+           (daemon-send stream
+            '(:TYPE :EVENT :META (:SOURCE :CLI)
+              :PAYLOAD (:SENSOR :user-input :TEXT "hello from CLI")))
+        (usocket:socket-close sock))
+      (pass))))
+
+(fiveam:test test-gateway-registry
+  "Contract 7: gateway-registry-initialize is available."
+  (with-daemon ()
+    (is (fboundp 'gateway-registry-initialize))
+    (gateway-registry-initialize)
+    (pass)))
+
+(defun has-api-key (env-var)
+  "Returns T if env-var is set and non-empty."
+  (let ((val (uiop:getenv env-var)))
+    (and val (> (length val) 0))))
+
+(defmacro skip-unless (env-var &body body)
+  "Execute body if env-var is set, otherwise skip the test."
+  `(if (has-api-key ,env-var)
+       (progn ,@body)
+       (progn
+         (format t "  [SKIP] ~a not set~%" ,env-var)
+         (skip "~a not set" ,env-var))))
+
+(fiveam:test test-provider-openai-request
+  "Contract Phase2: provider-openai-request returns :success with valid API key."
+  (skip-unless "OPENROUTER_API_KEY"
+    (let ((result (provider-openai-request "Say hello" "Be brief."
+                                           :provider :openrouter
+                                           :model "openrouter/auto")))
+      (is (or (eq (getf result :status) :success)
+              (eq (getf result :status) :error))
+          "Expected :success or :error, got: ~a" result))))
+
+(fiveam:test test-backend-cascade-real
+  "Contract Phase2: backend-cascade-call returns string content with real provider."
+  (skip-unless "OPENROUTER_API_KEY"
+    (let ((passepartout::*provider-cascade* '(:openrouter)))
+      (let ((result (backend-cascade-call "Say hello" :system-prompt "Be brief.")))
+        (is (stringp result) "Expected string response, got: ~a" result)))))
+
+(fiveam:test test-provider-cascade-parsing
+  "Contract Phase2: PROVIDER_CASCADE env var parses to clean keywords matching backends."
+  (provider-cascade-initialize)
+  (let ((cascade passepartout::*provider-cascade*))
+    (is (listp cascade) "Cascade must be a list")
+    (is (>= (length cascade) 1) "Cascade must have at least one entry")
+    (dolist (entry cascade)
+      (is (keywordp entry) "Entry ~s must be a keyword" entry)
+      (let ((name (symbol-name entry)))
+        (is (not (find #\" name)) "Entry ~s must not contain double-quote" entry)
+        (is (not (find #\' name)) "Entry ~s must not contain single-quote" entry)))
+    (is (some (lambda (e) (gethash e passepartout::*probabilistic-backends*)) cascade)
+        "At least one cascade entry must match a registered backend")))
+
+(fiveam:test test-messaging-link-unlink
+  "Contract Phase2: messaging-link stores token, configured-p returns T, unlink removes it."
+  (with-daemon ()
+    (messaging-link :test-platform :token "fake-token-123")
+    (is (gateway-configured-p :test-platform)
+        "Expected test-platform to be configured after linking")
+    (messaging-unlink :test-platform)
+    (is (not (gateway-configured-p :test-platform))
+        "Expected test-platform to be unconfigured after unlinking")))
+
+(fiveam:test test-gateway-configured-p-false
+  "Contract Phase2: gateway-configured-p returns nil for unknown platform."
+  (with-daemon ()
+    (is (not (gateway-configured-p :nonexistent-platform-xyz)))))
+
+(fiveam:test test-gateway-start-messaging
+  "Contract Phase2: gateway registry initializes with expected platforms."
+  (with-daemon ()
+    (gateway-registry-initialize)
+    (is (hash-table-p passepartout::*gateway-registry*))
+    (is (>= (hash-table-count passepartout::*gateway-registry*) 1))))
+
+(fiveam:test test-flight-plan-message-format
+  "Contract Phase3: dispatcher-flight-plan-create returns valid message."
+  (with-daemon ()
+    (load (merge-pathnames ".local/share/passepartout/lisp/security-dispatcher.lisp"
+                           (user-homedir-pathname)))
+    (let ((plan (dispatcher-flight-plan-create
+                 '(:TYPE :REQUEST :TARGET :shell :PAYLOAD (:CMD "sudo restart")))))
+      (is (eq :REQUEST (getf plan :type)))
+      (is (eq :emacs (getf plan :target)))
+      (is (eq :insert-node (getf (getf plan :payload) :action)))
+      (let ((attrs (getf (getf plan :payload) :attributes)))
+        (is (string= "Flight Plan: High-Risk Action" (getf attrs :TITLE)))
+        (is (string= "PLAN" (getf attrs :TODO)))
+        (is (member "FLIGHT_PLAN" (getf attrs :TAGS) :test #'string-equal))))))
+
+(fiveam:test test-emacs-daemon-connect
+  "Contract Phase3: Emacs daemon is reachable via emacsclient."
+  (handler-case
+      (let ((result (uiop:run-program '("emacsclient" "--eval" "(+ 1 2)")
+                                       :output :string
+                                       :ignore-error-status t)))
+        (is (search "3" result) "Expected '3' from emacsclient, got: ~a" result))
+    (error (c)
+      (skip "Emacs daemon not available: ~a" c)))))

lisp/system-model.lisp

@@ -1,16 +0,0 @@
-(in-package :passepartout)
-
-(defun model-request (&key prompt system-prompt (provider :openrouter) model)
-  "Central dispatcher for LLM requests."
-  (let ((backend (gethash provider *probabilistic-backends*)))
-    (if backend
-        (handler-case
-            (funcall backend prompt system-prompt :model model)
-          (error (c)
-            (list :status :error :message (format nil "~a Failure: ~a" provider c))))
-        (list :status :error :message (format nil "Provider ~a not registered" provider)))))
-
-(defskill :passepartout-system-model
-  :priority 100
-  :trigger (lambda (ctx) (getf ctx :user-input))
-  :deterministic (lambda (action ctx) (declare (ignore ctx)) action))