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

rename gateway-* → system-model-* + gateway-messaging, de-ollama, add system-model-explorer

Browse Source 
- Rename gateway-provider → system-model-provider (generic :local provider, no hardcoded ollama)
- Rename gateway-llm → system-model (model-request dispatcher)
- Rename system-embedding-gateway → system-model-embedding
- Rename gateway-manager → gateway-messaging (public api renamed to messaging-*)
- Add system-model-explorer (model discovery via OpenRouter API, cached, per-slot recommendations)
- Fix skill loader export: replace prefix-matching with fbound/boundp-based export (20 skills now export)
- Add model-router to skill-loader exclusion list (loaded via CLI)
- De-ollama: remove hardcoded assumed-available patterns from provider pipeline
- Default cascade: cloud-only (openrouter, openai, groq, gemini, deepseek, nvidia, anthropic)
- Env example: add LOCAL_BASE_URL, fix cascade order
- All org files updated with architectural prose (literate programming)
This commit is contained in:
Amr Gharbeia
2026-05-04 09:58:59 -04:00
parent 7dad50910f
commit 908936d4d3
32 changed files with 889 additions and 919 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
.env.example
View File

@@ -19,21 +19,25 @@ DEEPSEEK_API_KEY="your_deepseek_key_here"
NVIDIA_API_KEY="your_nvidia_nim_key_here"
# Cascade order (first available provider wins)
PROVIDER_CASCADE="openrouter,openai,anthropic,groq,gemini-api,ollama"
# Default (if unset): openrouter,openai,anthropic,groq,gemini-api,deepseek,nvidia
PROVIDER_CASCADE="openrouter,openai,anthropic,groq,gemini,deepseek"
# =============================================================================
# LOCAL LLM (Ollama - runs offline)
# LOCAL LLM (generic OpenAI-compatible endpoint)
# =============================================================================
# Set this to the base URL of any local OpenAI-compatible server
# (llama.cpp, Ollama, vLLM, LM Studio, etc.)
LOCAL_BASE_URL="localhost:8080"
# Ollama host (legacy: falls back to LOCAL_BASE_URL if not set)
OLLAMA_HOST="localhost:11434"
# llama.cpp backend (for local GGUF models)
LLAMA_HOST="localhost:8080"
# =============================================================================
# VECTOR EMBEDDINGS (semantic search)
# =============================================================================
EMBEDDING_PROVIDER="ollama" # "ollama" or "llama.cpp"
EMBEDDING_PROVIDER="hashing" # "hashing" (local, no deps), "local", or "openai"
EMBEDDING_MODEL="nomic-embed-text" # model name for embeddings
EMBEDDING_BASE_URL="https://api.openai.com/v1" # for :openai provider
# =============================================================================
# MESSAGING GATEWAYS (optional)

2
README.org
View File

@@ -49,7 +49,7 @@ See [[file:docs/USER_MANUAL.org][User Manual]] for the full guide.
- [[file:org/core-memory.org][Memory]] — Single-address-space object store with Merkle-tree integrity and snapshot rollback
- [[file:org/core-skills.org][Skill Engine]] — 20 hot-reloadable skills loaded at boot, each an independent Org file
- [[file:org/gateway-tui.org][TUI]] — Croatoan-based terminal interface connected via framed TCP protocol
- [[file:org/gateway-llm.org][LLM Routing]] — Cascade dispatch through multiple providers with tier-based model selection
- [[file:org/system-model.org][LLM Dispatch]] — Central dispatch for model inference requests
* Project Documentation

59
docs/ARCHITECTURE.org
View File

@@ -6,10 +6,10 @@
Passepartout divides cognition along two axes: **Foreground vs Background** (initiated by the user vs running autonomously) and **Probabilistic vs Deterministic** (LLM-driven vs pure Lisp logic).
| | Probabilistic (LLM) | Deterministic (Lisp) |
|----------------|--------------------|---------------------|
| **Foreground** | Chat responses, task execution, code generation | Shell execution, file I/O, safety gates, dispatcher checks |
| **Background** | Scribe distillation, vector embedding, autonomous decisions | Heartbeat, cron jobs, memory auto-save, gateway polling |
| | Probabilistic (LLM) | Deterministic (Lisp) |
|----------------+-------------------------------------------------------------+------------------------------------------------------------|
| **Foreground** | Chat responses, task execution, code generation | Shell execution, file I/O, safety gates, dispatcher checks |
| **Background** | Scribe distillation, vector embedding, autonomous decisions | Heartbeat, cron jobs, memory auto-save, gateway polling |
The Probabilistic engine proposes. The Deterministic engine verifies and executes. No proposal from the LLM touches a file, runs a command, or sends a message without passing through at least one deterministic gate.
@@ -19,27 +19,28 @@ The project is organized into ~org/~ (source of truth) and ~lisp/~ (generated by
** Core pipeline (loaded by ASDF, committed to git)
| File | Purpose |
|------|---------|
| ~org/core-defpackage.org~ | Package definition and export list |
| ~org/core-skills.org~ | Skill engine: ~defskill~ macro, topological sorter, jailed loading |
| ~org/core-communication.org~ | Framed TCP protocol, actuator registry, daemon server |
| ~org/core-memory.org~ | ~memory-object~ struct, Merkle hashing, snapshots, persistence |
| ~org/core-context.org~ | Foveal-peripheral rendering, context assembly for LLM |
| ~org/core-loop-perceive.org~ | Stage 1: normalize raw signals into pipeline format |
| ~org/core-loop-reason.org~ | Stage 2: LLM proposal + deterministic verification |
| ~org/core-loop-act.org~ | Stage 3: dispatch approved actions to actuators |
| ~org/core-loop.org~ | Orchestration: process-signal, heartbeat, main entry point |
| ~org/system-diagnostics.org~ | Boot-time health check, doctor CLI |
| File | Purpose |
|------------------------------+--------------------------------------------------------------------|
| ~org/core-defpackage.org~ | Package definition and export list |
| ~org/core-skills.org~ | Skill engine: ~defskill~ macro, topological sorter, jailed loading |
| ~org/core-communication.org~ | Framed TCP protocol, actuator registry, daemon server |
| ~org/core-memory.org~ | ~memory-object~ struct, Merkle hashing, snapshots, persistence |
| ~org/core-context.org~ | Foveal-peripheral rendering, context assembly for LLM |
| ~org/core-loop-perceive.org~ | Stage 1: normalize raw signals into pipeline format |
| ~org/core-loop-reason.org~ | Stage 2: LLM proposal + deterministic verification |
| ~org/core-loop-act.org~ | Stage 3: dispatch approved actions to actuators |
| ~org/core-loop.org~ | Orchestration: process-signal, heartbeat, main entry point |
| ~org/system-diagnostics.org~ | Boot-time health check, doctor CLI |
** Skills (loaded at runtime by the skill engine)
| Category | Files | Purpose |
|----------|-------|---------|
| **gateway-** | ~gateway-cli~, ~gateway-llm~, ~gateway-manager~, ~gateway-provider~, ~gateway-tui~ | External communication channels |
| **security-** | ~security-dispatcher~, ~security-policy~, ~security-permissions~, ~security-vault~, ~security-validator~ | Safety and authorization |
| **programming-** | ~programming-lisp~, ~programming-org~, ~programming-standards~, ~programming-literate~, ~programming-repl~ | Lisp and Org tooling |
| **system-** | ~system-config~, ~system-archivist~, ~system-self-improve~, ~system-memory~, ~system-actuator-shell~, ~system-event-orchestrator~ | Background services |
| Category | Files | Purpose |
|------------------+-----------------------------------------------------------------------------------------------------------------------------------+---------------------------------|
| **gateway-** | ~gateway-cli~, ~gateway-messaging~, ~gateway-tui~ | External communication channels |
| **system-model-** | ~system-model-provider~, ~system-model~, ~system-model-router~, ~system-model-embedding~, ~system-model-explorer~ | LLM infrastructure |
| **security-** | ~security-dispatcher~, ~security-policy~, ~security-permissions~, ~security-vault~, ~security-validator~ | Safety and authorization |
| **programming-** | ~programming-lisp~, ~programming-org~, ~programming-standards~, ~programming-literate~, ~programming-repl~ | Lisp and Org tooling |
| **system-** | ~system-config~, ~system-archivist~, ~system-self-improve~, ~system-memory~, ~system-actuator-shell~, ~system-event-orchestrator~ | Background services |
* Pipeline Flow
@@ -63,14 +64,14 @@ A depth counter prevents infinite loops. If a signal's depth exceeds 10, it is s
* Skill Lifecycle
1. **Discovery:** ~skill-initialize-all~ scans the skills directory, globs for ~*.lisp~ files (excluding ~core-*~ files which are loaded by ASDF)
2. **Sorting:** ~skill-topological-sort~ orders skills by their ~#+DEPENDS_ON:~ declarations
3. **Loading:** Each skill is loaded into a jailed package (~passepartout.skills.<skill-name>~). The loader removes ~in-package~ forms, evaluates the remaining code in the jailed package, and exports symbols matching the skill's short name to ~passepartout~
4. **Registration:** The skill's ~defskill~ call creates a ~skill~ struct in ~*skill-registry*~, registering its trigger function, probabilistic prompt generator, deterministic gate, and system-prompt augment
5. **Triggering:** On each cognitive cycle, ~skill-triggered-find~ iterates the registry and returns the highest-priority skill whose trigger matches the context
6. **Hot-reload:** A skill can be replaced at runtime by loading a new version into its jailed package — no restart needed
1. *Discovery:* ~skill-initialize-all~ scans the skills directory, globs for ~*.lisp~ files (excluding ~core-*~ files which are loaded by ASDF)
2. *Sorting:* ~skill-topological-sort~ orders skills by their ~#+DEPENDS_ON:~ declarations
3. *Loading:* Each skill is loaded into a jailed package (~passepartout.skills.<skill-name>~). The loader removes ~in-package~ forms, evaluates the remaining code in the jailed package, and exports symbols matching the skill's short name to ~passepartout~
4. *Registration* The skill's ~defskill~ call creates a ~skill~ struct in ~*skill-registry*~, registering its trigger function, probabilistic prompt generator, deterministic gate, and system-prompt augment
5. *Triggering:* On each cognitive cycle, ~skill-triggered-find~ iterates the registry and returns the highest-priority skill whose trigger matches the context
6. *Hot-reload:* A skill can be replaced at runtime by loading a new version into its jailed package — no restart needed
* Protocol Format
* Communication protocol Format
All communication between the daemon and its gateways (TUI, CLI, Emacs) uses length-prefixed plists over TCP:

2
docs/ROADMAP.org
View File

@@ -211,7 +211,7 @@ CLOSED: [2026-05-03 Sun 10:42]
- State "DONE" from "TODO" [2026-05-03 Sun 10:42]
:END:
=vault-get-secret= and =vault-set-secret= are exported from =core-defpackage=
and called from =gateway-manager.org= (lines 36, 86, 180) but never defined.
and called from =gateway-messaging.org= (lines 36, 86, 180) but never defined.
=gateway-link= crashes at runtime. Add one-line wrappers in =security-vault.org=
that delegate to the existing =vault-get=/=vault-set= with ~:type :secret~.

4
lisp/core-communication.lisp
View File

@@ -113,6 +113,10 @@
(error "Invalid message type '~a'" type))
t))
(defun validate-communication-protocol-schema (msg)
"Backward-compatibility alias for protocol-schema-validate."
(protocol-schema-validate msg))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))

4
lisp/core-defpackage.lisp
View File

@@ -24,7 +24,9 @@
#:run-setup-wizard
#:skill-gateway-register
#:skill-gateway-link
#:gateway-manager-main
#:messaging-list-print
#:messaging-link
#:messaging-unlink
#:ingest-ast
#:memory-object-get
#:list-objects-by-type

114
lisp/core-loop-reason.lisp
View File

@@ -1,5 +1,12 @@
(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 *provider-cascade* nil)
@@ -15,30 +22,33 @@
(system-prompt "You are the Probabilistic engine.")
(cascade nil)
(context nil))
(let ((backends (or cascade *provider-cascade*)))
(or (dolist (backend backends)
(let ((backend-fn (gethash backend *backend-registry*)))
(when backend-fn
(log-message "PROBABILISTIC: Attempting backend ~a..." backend)
(let* ((model-val (when *model-selector*
(funcall *model-selector* backend context))))
(if (eq model-val :skip)
(log-message "PROBABILISTIC: Skipping ~a (filtered)" backend)
(let* ((model (if model-val model-val nil))
(result (if model
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt))))
(cond ((and (listp result) (eq (getf result :status) :success))
(return (getf result :content)))
((stringp result)
(return result))
(t
(log-message "PROBABILISTIC: Backend ~a failed: ~a"
backend (getf result :message)))))))))))
(list :type :LOG
:payload (list :text "Neural Cascade Failure: All providers exhausted."))))
(defun markdown-strip (text)
(let ((backends (or cascade *provider-cascade*))
(result nil))
(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*)
(gethash backend *probabilistic-backends*))))
(when backend-fn
(log-message "PROBABILISTIC: Attempting backend ~a..." backend)
(let* ((model (and *model-selector*
(funcall *model-selector* backend context)))
(skip (eq model :skip))
(r (unless skip
(if (and model (not skip))
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt)))))
(when skip
(log-message "PROBABILISTIC: Skipping ~a (filtered)" backend))
(cond ((and (listp r) (eq (getf r :status) :success))
(setf result (getf r :content))
(return result))
((stringp r)
(setf result r)
(return result))
(t
(log-message "PROBABILISTIC: Backend ~a failed: ~a"
backend (getf r :message))))))))))(defun markdown-strip (text)
(if (and text (stringp text))
(let ((cleaned text))
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
@@ -84,40 +94,52 @@
assistant-name reflection-feedback tool-belt global-context system-logs
(or skill-augments ""))))
(let* ((thought (backend-cascade-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (markdown-strip thought)))
(cleaned (if (and (listp thought) (getf thought :type))
(format nil "~a" (getf (getf thought :payload) :text))
(markdown-strip thought))))
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
(handler-case
(let ((parsed (read-from-string cleaned)))
(if (listp parsed)
(plist-keywords-normalize parsed)
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(let ((parsed (read-from-string cleaned)))
(if (listp parsed)
(let ((normalized (plist-keywords-normalize parsed)))
;; Ensure explanation is present in the payload for policy gate
(let ((payload (proto-get normalized :payload)))
(if (and payload (proto-get payload :explanation))
normalized
(let ((new-payload (list* :EXPLANATION "Generated by the Probabilistic engine."
(if (listp payload) payload nil))))
(list* :PAYLOAD new-payload
(loop for (k v) on normalized by #'cddr
unless (eq k :PAYLOAD)
collect k collect v))))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine."))))))
(defun cognitive-verify (proposed-action context)
"Runs all registered deterministic gates against the proposed action.
Returns either a rejection plist (for :LOG or :EVENT errors) or the
modified action (for approval-required or pass)."
"Runs all registered deterministic gates against the proposed action,
sorted by priority (highest first). Returns a rejection plist or the action."
(let ((current-action (copy-tree proposed-action))
(approval-needed nil)
(approval-action nil))
(approval-action nil)
(gates nil))
;; Collect gates sorted by priority (highest first)
(maphash (lambda (name skill)
(declare (ignore name))
(when (skill-deterministic-fn skill)
(let ((gate (skill-deterministic-fn skill)))
(when gate
(let ((result (funcall gate current-action context)))
(cond
;; Approval-required: remember it and continue checking
((eq (getf result :level) :approval-required)
(setf approval-needed t
approval-action (getf (getf result :payload) :action)))
;; Hard rejection: return immediately
((member (getf result :type) '(:LOG :EVENT))
(return-from cognitive-verify result))
;; Normal: update action
(t (setf current-action result))))))))
(push (cons (skill-priority skill) (skill-deterministic-fn skill)) gates)))
*skill-registry*)
(setf gates (sort gates #'> :key #'car))
(dolist (gate-pair gates)
(let ((result (funcall (cdr gate-pair) current-action context)))
(cond
((eq (getf result :level) :approval-required)
(setf approval-needed t
approval-action (getf (getf result :payload) :action)))
((member (getf result :type) '(:LOG :EVENT))
(return-from cognitive-verify result))
((and (listp result) result)
(setf current-action result)))))
(if approval-needed
(list :type :EVENT :level :approval-required
:payload (list :sensor :approval-required

72
lisp/core-skills.lisp
View File

@@ -97,7 +97,9 @@
(string= n "core-loop")
(string= n "core-manifest")
(string= n "security-dispatcher")
(string= n "system-embedding-gateway"))))
(string= n "system-model-router")
(string= n "system-model-embedding")
(string= n "system-model-explorer"))))
all-files))
(adj (make-hash-table :test 'equal))
(name-to-file (make-hash-table :test 'equal))
@@ -206,26 +208,22 @@
(log-message "LOADER: Evaluating code for '~a' in package ~a" skill-base-name (package-name *package*))
(eval (read-from-string (format nil "(progn ~a)" lisp-code))))
(let* ((target-pkg (find-package :passepartout))
(raw-name (string-upcase skill-base-name))
(short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name)
(subseq raw-name 10)
raw-name)))
(log-message "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name)))
(let ((target-pkg (find-package :passepartout))
(exported 0)
(seen (make-hash-table :test 'equal)))
(do-symbols (sym (find-package pkg-name))
(when (eq (symbol-package sym) (find-package pkg-name))
(let ((sn (symbol-name sym)))
(when (or (uiop:string-prefix-p raw-name sn)
(uiop:string-prefix-p short-name sn)
(string-equal sn "DIAGNOSTICS-MAIN")
(string-equal sn "DIAGNOSTICS-RUN-ALL")
(string-equal sn "SETUP-WIZARD-RUN"))
(log-message "LOADER: Exporting ~a to :PASSEPARTOUT" sn)
(let ((existing (find-symbol sn target-pkg)))
(when (and existing (not (eq existing sym)))
(unintern existing target-pkg)))
(import sym target-pkg)
(export sym target-pkg))))))
(when (and (eq (symbol-package sym) (find-package pkg-name))
(or (fboundp sym) (boundp sym))
(not (gethash (symbol-name sym) seen)))
(setf (gethash (symbol-name sym) seen) t)
(incf exported)
(let ((existing (find-symbol (symbol-name sym) target-pkg)))
(when (and existing (not (eq existing sym)))
(unintern existing target-pkg)))
(import sym target-pkg)
(export sym target-pkg)))
(log-message "LOADER: Exported ~a symbols from ~a to :PASSEPARTOUT"
exported (package-name (find-package pkg-name))))
(setf (skill-entry-status entry) :ready)))
t)
@@ -251,26 +249,22 @@
(loop for form = (read s nil :eof) until (eq form :eof)
do (handler-case (eval form)
(error (c) (log-message "LOADER WARNING in '~a': ~a" skill-base-name c))))))
(let* ((target-pkg (find-package :passepartout))
(raw-name (string-upcase skill-base-name))
(short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name)
(subseq raw-name 10)
raw-name)))
(log-message "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name)))
(let ((target-pkg (find-package :passepartout))
(exported 0)
(seen (make-hash-table :test 'equal)))
(do-symbols (sym (find-package pkg-name))
(when (eq (symbol-package sym) (find-package pkg-name))
(let ((sn (symbol-name sym)))
(when (or (uiop:string-prefix-p raw-name sn)
(uiop:string-prefix-p short-name sn)
(string-equal sn "DIAGNOSTICS-MAIN")
(string-equal sn "DIAGNOSTICS-RUN-ALL")
(string-equal sn "SETUP-WIZARD-RUN"))
(log-message "LOADER: Exporting ~a to :PASSEPARTOUT" sn)
(let ((existing (find-symbol sn target-pkg)))
(when (and existing (not (eq existing sym)))
(unintern existing target-pkg)))
(import sym target-pkg)
(export sym target-pkg))))))
(when (and (eq (symbol-package sym) (find-package pkg-name))
(or (fboundp sym) (boundp sym))
(not (gethash (symbol-name sym) seen)))
(setf (gethash (symbol-name sym) seen) t)
(incf exported)
(let ((existing (find-symbol (symbol-name sym) target-pkg)))
(when (and existing (not (eq existing sym)))
(unintern existing target-pkg)))
(import sym target-pkg)
(export sym target-pkg)))
(log-message "LOADER: Exported ~a symbols from ~a to :PASSEPARTOUT"
exported (package-name (find-package pkg-name))))
(setf (skill-entry-status entry) :ready))
(error (c)
(log-message "LOADER ERROR in skill '~a': ~a" skill-base-name c)

43
lisp/gateway-llm.lisp
View File

@@ -1,43 +0,0 @@
(defun gateway-llm-request (&key prompt system-prompt (provider :ollama) 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-gateway-llm
:priority 100
:trigger (lambda (ctx) (getf ctx :user-input))
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-llm-gateway-tests
(:use :cl :passepartout)
(:export #:llm-gateway-suite))
(in-package :passepartout-llm-gateway-tests)
(fiveam:def-suite llm-gateway-suite :description "Tests for the LLM Gateway skill")
(fiveam:in-suite llm-gateway-suite)
(fiveam:test test-llm-gateway-timeout
"Tier 2 Chaos: Verify that LLM Gateway handles connection failures gracefully."
(let ((old-host (uiop:getenv "OLLAMA_HOST")))
(unwind-protect
(progn
(setf (uiop:getenv "OLLAMA_HOST") "localhost:1")
(let ((fn (or (find-symbol "GATEWAY-LLM-REQUEST" :passepartout.gateway-llm)
(find-symbol "GATEWAY-LLM-REQUEST" :passepartout))))
(if fn
(let ((result (funcall fn :prompt "hello" :provider :ollama)))
(fiveam:is (eq (getf result :status) :error))
(fiveam:is (uiop:string-prefix-p "Ollama Failure" (getf result :message))))
(fiveam:fail "Could not find EXECUTE-LLM-REQUEST symbol"))))
(if old-host
(setf (uiop:getenv "OLLAMA_HOST") old-host)
(sb-posix:unsetenv "OLLAMA_HOST")))))

60
lisp/gateway-manager.lisp → lisp/gateway-messaging.lisp
View File

@@ -1,8 +1,8 @@
(defvar *gateway-configs* (make-hash-table :test 'equal)
"Maps platform name → plist (:token :thread :interval :enabled)")
"Maps platform name to plist (:token :thread :interval :enabled)")
(defvar *gateway-registry* (make-hash-table :test 'equal)
"Maps platform name → plist (:poll-fn :send-fn :default-interval)")
"Maps platform name to plist (:poll-fn :send-fn :default-interval)")
(defun telegram-get-token ()
(vault-get-secret :telegram))
@@ -25,14 +25,14 @@
(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))))))
(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."
@@ -43,7 +43,6 @@
(text (or (getf payload :text) (getf action :text)))
(token (telegram-get-token)))
(when (and token chat-id text)
(log-message "TELEGRAM: Sending message to ~a..." chat-id)
(handler-case
(let ((url (format nil "https://api.telegram.org/bot~a/sendMessage" token)))
(dex:post url
@@ -62,7 +61,7 @@
(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)))
(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)))
@@ -70,13 +69,13 @@
(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))))))))
(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)
@@ -88,7 +87,6 @@
(text (or (getf payload :text) (getf action :text)))
(account (signal-get-account)))
(when (and account chat-id text)
(log-message "SIGNAL: Sending message to ~a..." chat-id)
(handler-case
(uiop:run-program (list "signal-cli" "-u" account "send" "-m" text chat-id)
:output :string :error-output :string)
@@ -117,7 +115,7 @@
(getf config :thread)
(bt:thread-alive-p (getf config :thread)))))
(defun gateway-link (platform token)
(defun messaging-link (platform token)
"Links a platform with a token and starts polling."
(let ((platform-lc (string-downcase platform)))
(unless (gethash platform-lc *gateway-registry*)
@@ -125,7 +123,7 @@
platform (loop for k being the hash-keys of *gateway-registry* collect k)))
(when (or (null token) (zerop (length token)))
(error "Token cannot be empty"))
(log-message "GATEWAY: Linking to ~a..." platform-lc)
(log-message "MESSAGING: Linking to ~a..." platform-lc)
(gateway-unlink platform-lc)
(let* ((registry-entry (gethash platform-lc *gateway-registry*))
(interval (or (getf registry-entry :default-interval) 5)))
@@ -133,16 +131,16 @@
(list :token token :interval interval :enabled t))
(vault-set-secret (intern (string-upcase platform-lc) :keyword) token)
(gateway-start platform-lc)
(log-message "GATEWAY: Successfully linked ~a" platform-lc)
(log-message "MESSAGING: Successfully linked ~a" platform-lc)
(format t "Successfully linked ~a gateway. Token stored securely.~%" platform-lc)
t)))
(defun gateway-unlink (platform)
(defun messaging-unlink (platform)
"Unlinks a platform and stops its polling thread."
(let ((platform-lc (string-downcase platform)))
(gateway-stop platform-lc)
(remhash platform-lc *gateway-configs*)
(log-message "GATEWAY: Unlinked ~a" platform-lc)
(log-message "MESSAGING: Unlinked ~a" platform-lc)
(format t "Successfully unlinked ~a gateway.~%" platform-lc)
t))
@@ -162,7 +160,7 @@
(funcall poll-fn))
(sleep interval)))
:name (format nil "passepartout-~a-gateway" platform-lc)))
(log-message "GATEWAY: Started ~a polling (interval: ~as)" platform-lc interval)))))))))
(log-message "MESSAGING: Started ~a polling (interval: ~as)" platform-lc interval))))))))
(defun gateway-stop (platform)
"Stops the polling thread for a gateway."
@@ -170,11 +168,11 @@
(let ((config (gethash platform-lc *gateway-configs*)))
(when (and config (getf config :thread))
(when (bt:thread-alive-p (getf config :thread))
(log-message "GATEWAY: Stopping ~a polling thread" platform-lc)
(log-message "MESSAGING: Stopping ~a polling thread" platform-lc)
(bt:destroy-thread (getf config :thread))))
(setf (getf config :thread) nil))))
(defun gateway-list ()
(defun messaging-list ()
"Returns a list of all gateways with their status."
(loop for platform being the hash-keys of *gateway-registry*
collect (let ((configured (gateway-configured-p platform))
@@ -183,11 +181,11 @@
:configured configured
:active active))))
(defun gateway-list-print ()
(defun messaging-list-print ()
"Prints a formatted table of gateways."
(format t "~%")
(format t " ~20@A ~12@A ~10@A~%" "PLATFORM" "CONFIGURED" "STATUS")
(dolist (gw (gateway-list))
(dolist (gw (messaging-list))
(format t " ~20@A ~12@A ~10@A~%"
(getf gw :platform)
(if (getf gw :configured) "yes" "no")
@@ -208,7 +206,7 @@
(register-actuator :telegram #'telegram-send)
(register-actuator :signal #'signal-send)
(defskill :passepartout-gateway-manager
(defskill :passepartout-gateway-messaging
:priority 150
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

4
lisp/system-archivist.lisp
View File

@@ -213,10 +213,10 @@ Returns a list of link target strings."
(pushnew target links :test #'string=)))
links))
(defun archivist-run (context)
(defun archivist-run (action context)
"Runs the archivist maintenance cycle. Checks Scribe and Gardener schedules
and dispatches as needed. Called by the deterministic gate."
(declare (ignore context))
(declare (ignore action context))
(let ((now (get-universal-time)))
;; Scribe runs every 6 hours (21600 seconds)
(when (>= (- now *archivist-last-scribe*) 21600)

123
lisp/system-embedding-gateway.lisp
View File

@@ -1,123 +0,0 @@
(in-package :passepartout)
(defvar *embedding-queue* nil
"List of object IDs pending embedding.")
(defvar *embedding-provider* :hashing
"Active embedding provider: :hashing, :ollama, :openai.")
(defun embeddings-tokenize (text)
"Split TEXT into lowercase word tokens, strip punctuation, discard short."
(let ((clean (cl-ppcre:regex-replace-all "[^a-zA-Z0-9 ]"
(string-downcase (or text "")) " ")))
(remove-if (lambda (w) (< (length w) 2))
(uiop:split-string clean :separator '(#\Space #\Tab #\Newline)))))
(defun embeddings-hash-word (word dim)
"Hash WORD to an index in [0, DIM)."
(let ((hash 2166136261))
(loop for c across word
do (setf hash (logxor hash (char-code c)))
(setf hash (mod (* hash 16777619) #x100000000)))
(mod hash dim)))
(defun embeddings-hash-vector (text &key (dimensions 384))
"Compute a hashing-trick vector for TEXT."
(let* ((tokens (embeddings-tokenize text))
(vec (make-array dimensions :initial-element 0.0d0 :element-type 'double-float)))
(dolist (token tokens)
(let* ((idx (embeddings-hash-word token dimensions))
(sign (if (evenp (char-code (char token 0))) 1 -1)))
(incf (aref vec idx) (coerce sign 'double-float))))
(let ((norm (sqrt (loop for i below dimensions sum (expt (aref vec i) 2)))))
(if (> norm 0.0d0)
(loop for i below dimensions collect (/ (aref vec i) norm))
(loop for i below dimensions collect 0.0d0)))))
(defun embeddings-compute (text &key (dimensions 384))
"Compute embedding vector for TEXT.
Tries *embedding-backend* first, falls back to hashing trick."
(when *embedding-backend*
(handler-case
(let ((result (funcall *embedding-backend* text)))
(when (and result (listp result) (> (length result) 0))
(return-from embeddings-compute result)))
(error (c)
(log-message "EMBEDDING: Backend failed (~a), fallback to hashing" c))))
(embeddings-hash-vector text :dimensions dimensions))
(defun embedding-backend-ollama (text)
"Generate embeddings via Ollama /api/embeddings."
(let* ((url (or (uiop:getenv "OLLAMA_URL") "http://localhost:11434"))
(model (or (uiop:getenv "EMBEDDING_MODEL") "nomic-embed-text"))
(response (dex:post (format nil "~a/api/embeddings" url)
:content (json:encode-json-to-string
`((:model . ,model) (:prompt . ,text)))
:headers '(("Content-Type" . "application/json")))))
(when response
(let* ((json (json:decode-json-from-string response))
(embedding (cdr (assoc :embedding json))))
(when embedding
(coerce embedding 'list))))))
(defun embed-queue-object (obj)
"Queue OBJ for embedding if it lacks a vector."
(when (and obj (not (memory-object-vector obj)))
(pushnew (memory-object-id obj) *embedding-queue* :test 'string=)))
(defun embed-object (obj)
"Generate and store embedding vector for OBJ."
(let* ((attrs (memory-object-attributes obj))
(title (or (getf attrs :TITLE) ""))
(text (or (memory-object-content obj) ""))
(raw-tags (getf attrs :TAGS))
(tag-list (if (listp raw-tags) raw-tags nil))
(tags (if tag-list (format nil "~{~a~^ ~}" tag-list) ""))
(combined (format nil "~a ~a ~a" title text tags))
(vec (embeddings-compute combined)))
(setf (memory-object-vector obj) vec)
(log-message "EMBEDDING: Vector for ~a (~d dims)" (memory-object-id obj) (length vec))
vec))
(defun embed-all-pending ()
"Process all pending embeddings. Returns count."
(let ((count 0))
;; Drain queue
(let ((pending *embedding-queue*))
(setf *embedding-queue* nil)
(dolist (id pending)
(let ((obj (gethash id *memory-store*)))
(when (and obj (not (memory-object-vector obj)))
(handler-case
(progn (embed-object obj) (incf count))
(error (c)
(log-message "EMBEDDING: Failed ~a: ~a" id c)))))))
;; Fallback: scan store for objects without vectors
(when (= count 0)
(maphash (lambda (id obj)
(declare (ignore id))
(unless (memory-object-vector obj)
(handler-case
(progn (embed-object obj) (incf count))
(error (c)
(log-message "EMBEDDING: Failed ~a: ~a"
(memory-object-id obj) c)))))
*memory-store*))
(when (> count 0)
(log-message "EMBEDDING: Batch processed ~d objects" count))
count))
(defun embeddings-init (&key (provider *embedding-provider*))
"Init embedding provider from EMBEDDING_PROVIDER env var."
(let* ((env (uiop:getenv "EMBEDDING_PROVIDER"))
(selected (or (and env (intern (string-upcase env) :keyword))
provider)))
(setf *embedding-provider* selected)
(setf *embedding-backend*
(case selected
(:ollama #'embedding-backend-ollama)
(t nil)))
(log-message "EMBEDDING: Provider ~a, backend=~a" selected *embedding-backend*)
selected))
(embeddings-init)

87
lisp/system-model-embedding.lisp Normal file
View File

@@ -0,0 +1,87 @@
(in-package :passepartout)
(defvar *embedding-provider* :hashing
"Active embedding provider: :hashing, :local, :openai.")
(defvar *embedding-queue* nil
"Queue of text objects awaiting embedding.")
(defvar *embedding-batch-size* 10
"Maximum texts per embedding API call.")
(defun embedding-backend-local (text)
"Generate embeddings via a local OpenAI-compatible endpoint."
(let* ((url (or (uiop:getenv "LOCAL_BASE_URL") (format nil "http://~a" (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))))
(model (or (uiop:getenv "EMBEDDING_MODEL") "nomic-embed-text"))
(body (cl-json:encode-json-to-string
`((model . ,model) (input . ,text)))))
(handler-case
(let* ((response (dex:post (format nil "~a/api/embeddings" url)
:headers '(("Content-Type" . "application/json"))
:content body :connect-timeout 5 :read-timeout 30))
(json (cl-json:decode-json-from-string response))
(data (car (cdr (assoc :data json)))))
(or (cdr (assoc :embedding data))
(list :error "No embedding in response")))
(error (c)
(list :error (format nil "Embedding failed: ~a" c))))))
(defun embedding-backend-openai (text)
"Generate embeddings via OpenAI compatible /v1/embeddings endpoint."
(let* ((api-key (uiop:getenv "OPENAI_API_KEY"))
(base-url (or (uiop:getenv "EMBEDDING_BASE_URL") "https://api.openai.com/v1"))
(model (or (uiop:getenv "EMBEDDING_MODEL") "text-embedding-3-small"))
(body (cl-json:encode-json-to-string
`((model . ,model) (input . ,text)))))
(handler-case
(let* ((response (dex:post (format nil "~a/embeddings" base-url)
:headers `(("Content-Type" . "application/json")
("Authorization" . ,(format nil "Bearer ~a" api-key)))
:content body :connect-timeout 5 :read-timeout 30))
(json (cl-json:decode-json-from-string response))
(data (car (cdr (assoc :data json)))))
(or (cdr (assoc :embedding data))
(list :error "No embedding in response")))
(error (c)
(list :error (format nil "OpenAI Embedding failed: ~a" c))))))
(defun embedding-backend-hashing (text)
"Fallback: produces a deterministic vector from the text hash."
(let* ((digest (ironclad:digest-sequence :sha256 (babel:string-to-octets text)))
(vec (make-array 8 :element-type 'single-float :initial-element 0.0)))
(dotimes (i (min (length digest) 8))
(setf (aref vec i) (float (/ (aref digest i) 255.0) 0.0)))
vec))
(defun embed-object (text)
"Embed a single text string using the active backend."
(let* ((selected (or *embedding-provider* :hashing))
(backend (case selected
(:local #'embedding-backend-local)
(:openai #'embedding-backend-openai)
(t #'embedding-backend-hashing))))
(if backend
(progn
(log-message "EMBEDDING: Provider ~a, backend=~a" selected backend)
(funcall backend text))
(progn
(log-message "EMBEDDING: No backend for provider ~a, using hashing" selected)
(embedding-backend-hashing text)))))
(defun embed-queue-object (object)
"Queue a text object for async embedding."
(push object *embedding-queue*)
(log-message "EMBEDDING: Queued object"))
(defun embed-all-pending ()
"Drain the embedding queue, batch-process all queued objects."
(let ((batch (nreverse *embedding-queue*)))
(setf *embedding-queue* nil)
(dolist (item batch)
(handler-case
(let ((text (if (stringp item) item (format nil "~a" item))))
(embed-object text))
(error (c)
(log-message "EMBEDDING: Failed to embed object: ~a" c))))))
(log-message "EMBEDDING: Gateway loaded with provider ~a" *embedding-provider*)

63
lisp/system-model-explorer.lisp Normal file
View File

@@ -0,0 +1,63 @@
(in-package :passepartout)
(defvar *model-cache* (make-hash-table :test 'equal)
"Cache: provider keyword -> (timestamp . model-list)")
(defvar *model-cache-ttl* 300
"Cache TTL in seconds (default 5 min)")
(defun model-explorer-fetch-openrouter ()
"Query OpenRouter /api/v1/models and return parsed model list."
(handler-case
(let* ((raw (dex:get "https://openrouter.ai/api/v1/models" :connect-timeout 10 :read-timeout 20))
(json (cl-json:decode-json-from-string raw))
(data (cdr (assoc :data json))))
(mapcar (lambda (m)
(let ((pricing (cdr (assoc :pricing m))))
(list :id (cdr (assoc :id m))
:name (cdr (assoc :name m))
:context (cdr (assoc :context_length m))
:free (and pricing
(string= "0" (cdr (assoc :prompt pricing)))
(string= "0" (cdr (assoc :completion pricing)))))))
data))
(error (c)
(log-message "MODEL-EXPLORER: OpenRouter API error: ~a" c)
nil)))
(defun model-explorer-fetch (provider)
"Fetch available models for PROVIDER. Returns list of (:id :name :context :free) plists."
(let ((cached (gethash provider *model-cache*)))
(when (and cached (< (- (get-universal-time) (car cached)) *model-cache-ttl*))
(return-from model-explorer-fetch (cdr cached))))
(let ((models (case provider
(:openrouter (model-explorer-fetch-openrouter))
(t nil))))
(when models
(setf (gethash provider *model-cache*)
(cons (get-universal-time) models)))
models))
(defun model-explorer-list-free ()
"Return all free models from cache or fetch."
(remove-if-not (lambda (m) (getf m :free)) (model-explorer-fetch :openrouter)))
(defun model-explorer-recommend (slot)
"Return recommended models for SLOT (:code, :chat, :plan, :background)."
(case slot
(:code
'((:id "qwen/qwen3-coder:free" :name "Qwen3 Coder 480B" :context 262000 :free t :note "Top-tier code MoE, 35B active")
(:id "poolside/laguna-m.1:free" :name "Laguna M.1" :context 131072 :free t :note "Flagship coding agent")
(:id "openai/gpt-oss-120b:free" :name "gpt-oss-120b" :context 131072 :free t :note "117B MoE open-weight coding")))
(:plan
'((:id "openrouter/owl-alpha" :name "Owl Alpha" :context 1048756 :free t :note "Agentic, tool use, reasoning")
(:id "nousresearch/hermes-3-llama-3.1-405b:free" :name "Hermes 3 405B" :context 131072 :free t :note "405B generalist, strong planning")
(:id "minimax/minimax-m2.5:free" :name "MiniMax M2.5" :context 196608 :free t :note "SOTA productivity, long context")))
(:chat
'((:id "meta-llama/llama-3.3-70b-instruct:free" :name "Llama 3.3 70B" :context 65536 :free t :note "Strong multilingual generalist")
(:id "google/gemma-4-31b-it:free" :name "Gemma 4 31B" :context 262144 :free t :note "Dense 31B, thinking mode, long context")
(:id "mistralai/mistral-nemo:free" :name "Mistral Nemo" :context 32768 :free t :note "Fast, good for casual conversation")))
(:background
'((:id "meta-llama/llama-3.2-3b-instruct:free" :name "Llama 3.2 3B" :context 131072 :free t :note "Small, fast, efficient")
(:id "liquid/lfm-2.5-1.2b-instruct:free" :name "LFM 2.5 1.2B" :context 32768 :free t :note "Ultra-compact, edge-ready")))
(t '((:id "meta-llama/llama-3.3-70b-instruct:free" :name "Llama 3.3 70B" :context 65536 :free t :note "Safe fallback")))))

28
lisp/gateway-provider.lisp → lisp/system-model-provider.lisp
View File

@@ -1,36 +1,42 @@
(defparameter *provider-configs*
'((:ollama . (:base-url nil :key-env nil :default-model "llama3"))
'((:local . (:base-url nil :key-env nil :url-env "LOCAL_BASE_URL" :default-model "llama3"))
(:openrouter . (:base-url "https://openrouter.ai/api/v1" :key-env "OPENROUTER_API_KEY" :default-model "openrouter/auto"))
(:openai . (:base-url "https://api.openai.com/v1" :key-env "OPENAI_API_KEY" :default-model "gpt-4o-mini"))
(:anthropic . (:base-url "https://api.anthropic.com/v1" :key-env "ANTHROPIC_API_KEY" :default-model "claude-3-5-sonnet-20241022"))
(:groq . (:base-url "https://api.groq.com/openai/v1" :key-env "GROQ_API_KEY" :default-model "llama-3.1-70b-versatile"))
(:gemini . (:base-url "https://generativelanguage.googleapis.com/v1beta/openai" :key-env "GEMINI_API_KEY" :default-model "gemini-2.0-flash"))
(:deepseek . (:base-url "https://api.deepseek.com/v1" :key-env "DEEPSEEK_API_KEY" :default-model "deepseek-chat"))
(:nvidia . (:base-url "https://integrate.api.nvidia.com/v1" :key-env "NVIDIA_API_KEY" :default-model "meta/llama-3.1-405b-instruct"))))
(:nvidia . (:base-url "https://integrate.api.nvidia.com/v1" :key-env "NVIDIA_API_KEY" :default-model "meta/llama-3.1-405b-instruct"))
(:ollama . (:base-url nil :key-env nil :url-env "OLLAMA_HOST" :default-model "llama3"))))
(defun provider-config (provider)
"Returns the configuration plist for a provider keyword."
(cdr (assoc provider *provider-configs*)))
(defun provider-available-p (provider)
"Checks if a provider is configured. Ollama is always considered available."
"Checks if a provider is configured. Checks API key or URL env vars."
(let* ((config (provider-config provider))
(key-env (getf config :key-env))
(url-env (getf config :url-env))
(base-url (getf config :base-url)))
(cond ((eq provider :ollama) t)
(key-env (let ((key (uiop:getenv key-env))) (and key (> (length key) 0))))
(cond (key-env (let ((key (uiop:getenv key-env))) (and key (> (length key) 0))))
(url-env (let ((url (uiop:getenv url-env))) (and url (> (length url) 0))))
(base-url t))))
(defun provider-openai-request (prompt system-prompt &key model (provider :ollama))
(defun provider-openai-request (prompt system-prompt &key model (provider :openrouter))
"Executes a request against any OpenAI-compatible API endpoint."
(let* ((config (provider-config provider))
(base-url (getf config :base-url))
(key-env (getf config :key-env))
(url-env (getf config :url-env))
(default-model (getf config :default-model))
(api-key (when key-env (uiop:getenv key-env)))
(model-id (or model default-model))
(url (if (eq provider :ollama)
(format nil "http://~a/v1/chat/completions" (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))
(url (if url-env
(let ((host (uiop:getenv url-env)))
(if host
(format nil "http://~a/v1/chat/completions" host)
(format nil "~a/chat/completions" base-url)))
(format nil "~a/chat/completions" base-url)))
(headers `(("Content-Type" . "application/json")
,@(when api-key `(("Authorization" . ,(format nil "Bearer ~a" api-key))))
@@ -71,11 +77,13 @@
(setf *provider-cascade*
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword))
(uiop:split-string cascade-str :separator '(#\,))))
(setf *provider-cascade* (mapcar #'car *provider-configs*)))))
(setf *provider-cascade* (mapcar #'car (remove-if (lambda (e)
(member (car e) '(:local :ollama)))
*provider-configs*))))))
(provider-register-all)
(provider-cascade-initialize)
(defskill :passepartout-gateway-provider
(defskill :passepartout-system-model-provider
:priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

14
lisp/system-model-router.lisp
View File

@@ -1,7 +1,7 @@
(in-package :passepartout)
(defvar *model-cascade-code* nil
"Cascade for :code tasks: ((:ollama . \"model\") ...)")
"Cascade for :code tasks: ((:provider . \"model\") ...)")
(defvar *model-cascade-plan* nil
"Cascade for :plan tasks.")
@@ -12,8 +12,8 @@
(defvar *model-cascade-background* nil
"Cascade for background tasks (heartbeat, delegation).")
(defvar *local-backends* '(:ollama :llama-cpp)
"Backend keywords considered local (privacy-safe).")
(defvar *local-backends* nil
"Backend keywords considered local (privacy-safe). Set via LOCAL_BACKENDS env var.")
(defun model-classify-complexity (text)
"Classify TEXT into :code, :plan, or :chat."
@@ -53,7 +53,7 @@ Returns model name or :skip."
;; Quadrant: background tasks use background cascade
(if (member sensor '(:heartbeat :delegation :tool-output :loop-error))
(let ((entry (car (or *model-cascade-background*
'((:ollama . "phi-2"))))))
'((:openrouter . "meta-llama/llama-3.2-3b-instruct:free"))))))
(cdr entry))
;; Foreground: classify complexity, use slot cascade
(let* ((slot (model-classify-complexity text))
@@ -62,8 +62,8 @@ Returns model name or :skip."
(:plan *model-cascade-plan*)
(t *model-cascade-chat*)))
(entry (model-cascade-find
(or cascade '((:ollama . "qwen2.5:14b"))) backend)))
(if entry (cdr entry) :skip)))))
(or cascade '((:openrouter . "meta-llama/llama-3.3-70b-instruct:free"))) backend)))
(if entry (cdr entry) nil)))))
(defun model-router-init ()
"Read env vars and wire model-select into *model-selector*."
@@ -79,7 +79,7 @@ Returns model name or :skip."
(if env
(mapcar (lambda (s) (intern (string-upcase (string-trim " " s)) :keyword))
(uiop:split-string env :separator '(#\,)))
'(:ollama :llama-cpp)))))
nil))))
(setf *model-selector* #'model-select)
(log-message "MODEL-ROUTER: Initialized, selector=~a" *model-selector*))

16
lisp/system-model.lisp Normal file
View File

@@ -0,0 +1,16 @@
(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))

9
org/core-communication.org
View File

@@ -205,6 +205,15 @@ Validates that an incoming message has the minimum required structure: a plist w
t))
#+end_src
** Backward-Compatibility Alias
;; REPL-VERIFIED: 2026-05-03T14:00:00
#+begin_src lisp
(defun validate-communication-protocol-schema (msg)
"Backward-compatibility alias for protocol-schema-validate."
(protocol-schema-validate msg))
#+end_src
** Protocol Smoke Test (manual for REPL evaluation)
Use this function to manually verify that the daemon is alive and the framing protocol works end-to-end. It connects to a running daemon, reads the HELLO handshake, sends a "hi" message, and reads the response.

145
org/core-loop-reason.org
View File

@@ -43,7 +43,21 @@ This is not a cosmetic choice. It means the reasoning pipeline can generate, mod
(in-package :passepartout)
#+end_src
** Probabilistic Engine State
** Probabilistic Backend Registry
~*probabilistic-backends*~ is a hash table mapping provider keywords to
their handler functions. Populated by ~register-probabilistic-backend~.
Skills like system-model-provider register into this table at boot time.
;; REPL-VERIFIED: 2026-05-03T14:00:00
#+begin_src lisp
(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))
#+end_src
The probabilistic engine maintains four pieces of global state that control how LLM requests are dispatched:
@@ -107,52 +121,33 @@ This is deliberately resilient. The system should never crash because an LLM pro
(system-prompt "You are the Probabilistic engine.")
(cascade nil)
(context nil))
(let ((backends (or cascade *provider-cascade*)))
(or (dolist (backend backends)
(let ((backend-fn (gethash backend *backend-registry*)))
(when backend-fn
(log-message "PROBABILISTIC: Attempting backend ~a..." backend)
(let* ((model-val (when *model-selector*
(funcall *model-selector* backend context))))
(if (eq model-val :skip)
(log-message "PROBABILISTIC: Skipping ~a (filtered)" backend)
(let* ((model (if model-val model-val nil))
(result (if model
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt))))
(cond ((and (listp result) (eq (getf result :status) :success))
(return (getf result :content)))
((stringp result)
(return result))
(t
(log-message "PROBABILISTIC: Backend ~a failed: ~a"
backend (getf result :message)))))))))))
(list :type :LOG
:payload (list :text "Neural Cascade Failure: All providers exhausted."))))
#+end_src
** Cognitive Proposal Generation (think)
The ~think~ function is where the creative brain does its work. It assembles the full context for the LLM: the system identity, the available tools, the current global context from memory, the recent system logs, and any rejection trace from a previous failed proposal. It also collects augment strings from any skill that has registered a ~system-prompt-augment~ function.
A note on the augment system: skills can contribute context-specific mandates to the LLM prompt. For example, the REPL skill injects the "prototype in the REPL first" mandate when the context suggests the agent is editing Lisp code. This keeps domain-specific instructions out of the harness while still ensuring they appear in the prompt when relevant.
The LLM's response is expected to be a plist. If it is, it gets parsed and normalized. If it's a string that starts with ~(~ or ~[~, it's read as Lisp data. If it's neither, it falls back to a REQUEST with a MESSAGE action — the raw text.
** Pre-processing: strip markdown from LLM output
LLMs often wrap structured output in markdown code fences:
```lisp
(:TYPE :REQUEST ...)
```
This function strips the fences so the reader can parse the plist.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun markdown-strip (text)
(let ((backends (or cascade *provider-cascade*))
(result nil))
(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*)
(gethash backend *probabilistic-backends*))))
(when backend-fn
(log-message "PROBABILISTIC: Attempting backend ~a..." backend)
(let* ((model (and *model-selector*
(funcall *model-selector* backend context)))
(skip (eq model :skip))
(r (unless skip
(if (and model (not skip))
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt)))))
(when skip
(log-message "PROBABILISTIC: Skipping ~a (filtered)" backend))
(cond ((and (listp r) (eq (getf r :status) :success))
(setf result (getf r :content))
(return result))
((stringp r)
(setf result r)
(return result))
(t
(log-message "PROBABILISTIC: Backend ~a failed: ~a"
backend (getf r :message))))))))))(defun markdown-strip (text)
(if (and text (stringp text))
(let ((cleaned text))
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
@@ -219,13 +214,25 @@ The system prompt assembly order — identity, tools, context, logs, mandates
assistant-name reflection-feedback tool-belt global-context system-logs
(or skill-augments ""))))
(let* ((thought (backend-cascade-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (markdown-strip thought)))
(cleaned (if (and (listp thought) (getf thought :type))
(format nil "~a" (getf (getf thought :payload) :text))
(markdown-strip thought))))
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
(handler-case
(let ((parsed (read-from-string cleaned)))
(if (listp parsed)
(plist-keywords-normalize parsed)
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(let ((parsed (read-from-string cleaned)))
(if (listp parsed)
(let ((normalized (plist-keywords-normalize parsed)))
;; Ensure explanation is present in the payload for policy gate
(let ((payload (proto-get normalized :payload)))
(if (and payload (proto-get payload :explanation))
normalized
(let ((new-payload (list* :EXPLANATION "Generated by the Probabilistic engine."
(if (listp payload) payload nil))))
(list* :PAYLOAD new-payload
(loop for (k v) on normalized by #'cddr
unless (eq k :PAYLOAD)
collect k collect v))))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine."))))))
#+end_src
@@ -245,29 +252,29 @@ This architecture makes safety compositional: each skill adds one constraint. Th
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun cognitive-verify (proposed-action context)
"Runs all registered deterministic gates against the proposed action.
Returns either a rejection plist (for :LOG or :EVENT errors) or the
modified action (for approval-required or pass)."
"Runs all registered deterministic gates against the proposed action,
sorted by priority (highest first). Returns a rejection plist or the action."
(let ((current-action (copy-tree proposed-action))
(approval-needed nil)
(approval-action nil))
(approval-action nil)
(gates nil))
;; Collect gates sorted by priority (highest first)
(maphash (lambda (name skill)
(declare (ignore name))
(when (skill-deterministic-fn skill)
(let ((gate (skill-deterministic-fn skill)))
(when gate
(let ((result (funcall gate current-action context)))
(cond
;; Approval-required: remember it and continue checking
((eq (getf result :level) :approval-required)
(setf approval-needed t
approval-action (getf (getf result :payload) :action)))
;; Hard rejection: return immediately
((member (getf result :type) '(:LOG :EVENT))
(return-from cognitive-verify result))
;; Normal: update action
(t (setf current-action result))))))))
(push (cons (skill-priority skill) (skill-deterministic-fn skill)) gates)))
*skill-registry*)
(setf gates (sort gates #'> :key #'car))
(dolist (gate-pair gates)
(let ((result (funcall (cdr gate-pair) current-action context)))
(cond
((eq (getf result :level) :approval-required)
(setf approval-needed t
approval-action (getf (getf result :payload) :action)))
((member (getf result :type) '(:LOG :EVENT))
(return-from cognitive-verify result))
((and (listp result) result)
(setf current-action result)))))
(if approval-needed
(list :type :EVENT :level :approval-required
:payload (list :sensor :approval-required

72
org/core-skills.org
View File

@@ -192,7 +192,9 @@ Both ~.org~ and ~.lisp~ files are included. For each skill, the ~.org~ file supp
(string= n "core-loop")
(string= n "core-manifest")
(string= n "security-dispatcher")
(string= n "system-embedding-gateway"))))
(string= n "system-model-router")
(string= n "system-model-embedding")
(string= n "system-model-explorer"))))
all-files))
(adj (make-hash-table :test 'equal))
(name-to-file (make-hash-table :test 'equal))
@@ -315,26 +317,22 @@ The validation step is critical: invalid Lisp in an org block would crash the lo
(log-message "LOADER: Evaluating code for '~a' in package ~a" skill-base-name (package-name *package*))
(eval (read-from-string (format nil "(progn ~a)" lisp-code))))
(let* ((target-pkg (find-package :passepartout))
(raw-name (string-upcase skill-base-name))
(short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name)
(subseq raw-name 10)
raw-name)))
(log-message "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name)))
(let ((target-pkg (find-package :passepartout))
(exported 0)
(seen (make-hash-table :test 'equal)))
(do-symbols (sym (find-package pkg-name))
(when (eq (symbol-package sym) (find-package pkg-name))
(let ((sn (symbol-name sym)))
(when (or (uiop:string-prefix-p raw-name sn)
(uiop:string-prefix-p short-name sn)
(string-equal sn "DIAGNOSTICS-MAIN")
(string-equal sn "DIAGNOSTICS-RUN-ALL")
(string-equal sn "SETUP-WIZARD-RUN"))
(log-message "LOADER: Exporting ~a to :PASSEPARTOUT" sn)
(let ((existing (find-symbol sn target-pkg)))
(when (and existing (not (eq existing sym)))
(unintern existing target-pkg)))
(import sym target-pkg)
(export sym target-pkg))))))
(when (and (eq (symbol-package sym) (find-package pkg-name))
(or (fboundp sym) (boundp sym))
(not (gethash (symbol-name sym) seen)))
(setf (gethash (symbol-name sym) seen) t)
(incf exported)
(let ((existing (find-symbol (symbol-name sym) target-pkg)))
(when (and existing (not (eq existing sym)))
(unintern existing target-pkg)))
(import sym target-pkg)
(export sym target-pkg)))
(log-message "LOADER: Exported ~a symbols from ~a to :PASSEPARTOUT"
exported (package-name (find-package pkg-name))))
(setf (skill-entry-status entry) :ready)))
t)
@@ -368,26 +366,22 @@ The same jailed package and symbol export process applies.
(loop for form = (read s nil :eof) until (eq form :eof)
do (handler-case (eval form)
(error (c) (log-message "LOADER WARNING in '~a': ~a" skill-base-name c))))))
(let* ((target-pkg (find-package :passepartout))
(raw-name (string-upcase skill-base-name))
(short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name)
(subseq raw-name 10)
raw-name)))
(log-message "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name)))
(let ((target-pkg (find-package :passepartout))
(exported 0)
(seen (make-hash-table :test 'equal)))
(do-symbols (sym (find-package pkg-name))
(when (eq (symbol-package sym) (find-package pkg-name))
(let ((sn (symbol-name sym)))
(when (or (uiop:string-prefix-p raw-name sn)
(uiop:string-prefix-p short-name sn)
(string-equal sn "DIAGNOSTICS-MAIN")
(string-equal sn "DIAGNOSTICS-RUN-ALL")
(string-equal sn "SETUP-WIZARD-RUN"))
(log-message "LOADER: Exporting ~a to :PASSEPARTOUT" sn)
(let ((existing (find-symbol sn target-pkg)))
(when (and existing (not (eq existing sym)))
(unintern existing target-pkg)))
(import sym target-pkg)
(export sym target-pkg))))))
(when (and (eq (symbol-package sym) (find-package pkg-name))
(or (fboundp sym) (boundp sym))
(not (gethash (symbol-name sym) seen)))
(setf (gethash (symbol-name sym) seen) t)
(incf exported)
(let ((existing (find-symbol (symbol-name sym) target-pkg)))
(when (and existing (not (eq existing sym)))
(unintern existing target-pkg)))
(import sym target-pkg)
(export sym target-pkg)))
(log-message "LOADER: Exported ~a symbols from ~a to :PASSEPARTOUT"
exported (package-name (find-package pkg-name))))
(setf (skill-entry-status entry) :ready))
(error (c)
(log-message "LOADER ERROR in skill '~a': ~a" skill-base-name c)

63
org/gateway-llm.org
View File

@@ -1,63 +0,0 @@
#+TITLE: SKILL: LLM Gateway (org-skill-llm-gateway.org)
#+AUTHOR: Agent
#+FILETAGS: :skill:llm:gateway:
#+PROPERTY: header-args:lisp :tangle ../lisp/gateway-llm.lisp
* Overview
The LLM Gateway dispatches inference requests to the registered probabilistic backends. It receives a prompt and system prompt, looks up the provider's registered function from ~*probabilistic-backends*~, calls it with the given model, and returns the result. This is the thin routing layer that sits between the reason pipeline and the provider-specific implementations in the unified-llm-backend skill.
* Implementation
** Request Execution (gateway-llm-request)
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun gateway-llm-request (&key prompt system-prompt (provider :ollama) 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)))))
#+end_src
** Skill Registration
#+begin_src lisp
(defskill :passepartout-gateway-llm
:priority 100
:trigger (lambda (ctx) (getf ctx :user-input))
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))
#+end_src
* Test Suite
#+begin_src lisp :tangle ../lisp/gateway-llm.lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-llm-gateway-tests
(:use :cl :passepartout)
(:export #:llm-gateway-suite))
(in-package :passepartout-llm-gateway-tests)
(fiveam:def-suite llm-gateway-suite :description "Tests for the LLM Gateway skill")
(fiveam:in-suite llm-gateway-suite)
(fiveam:test test-llm-gateway-timeout
"Tier 2 Chaos: Verify that LLM Gateway handles connection failures gracefully."
(let ((old-host (uiop:getenv "OLLAMA_HOST")))
(unwind-protect
(progn
(setf (uiop:getenv "OLLAMA_HOST") "localhost:1")
(let ((fn (or (find-symbol "GATEWAY-LLM-REQUEST" :passepartout.gateway-llm)
(find-symbol "GATEWAY-LLM-REQUEST" :passepartout))))
(if fn
(let ((result (funcall fn :prompt "hello" :provider :ollama)))
(fiveam:is (eq (getf result :status) :error))
(fiveam:is (uiop:string-prefix-p "Ollama Failure" (getf result :message))))
(fiveam:fail "Could not find EXECUTE-LLM-REQUEST symbol"))))
(if old-host
(setf (uiop:getenv "OLLAMA_HOST") old-host)
(sb-posix:unsetenv "OLLAMA_HOST")))))
#+end_src

183
org/gateway-manager.org → org/gateway-messaging.org
View File

@@ -1,52 +1,38 @@
#+TITLE: SKILL: Gateway Manager (org-skill-gateway-manager.org)
#+TITLE: SKILL: Gateway Messaging (org-skill-gateway-messaging.org)
#+AUTHOR: Agent
#+FILETAGS: :skill:gateway:manager:
#+PROPERTY: header-args:lisp :tangle ../lisp/gateway-manager.lisp
#+FILETAGS: :skill:gateway:messaging:
#+PROPERTY: header-args:lisp :tangle ../lisp/gateway-messaging.lisp
* Architectural Intent
The Gateway Manager is the unified interface for all external messaging platforms. It handles Telegram, Signal, and any future gateway through a common pattern: a registry of poll/send function pairs, a configuration hash table for tokens and intervals, and a background thread per gateway that polls for new messages.
~gateway-messaging~ bridges Passepartout to external messaging platforms — Telegram, Signal, and any future service that speaks HTTP or has a CLI.
Each gateway follows the same lifecycle:
1. **Register** — the gateway's poll and send functions are registered in ~*gateway-registry*~
2. **Link** — the user provides a token; it's stored in the vault and a polling thread is started
3. **Poll** — the thread calls the poll function on an interval, injecting received messages into the pipeline
4. **Unlink** — the thread is destroyed, the config is removed
5. **Act** — when the agent needs to send a message, it dispatches to the gateway's send function via the generic actuator mechanism
Each gateway follows the same pattern:
1. **Registration** — a poll function and a send function are registered in ~*gateway-registry*~ by name ("telegram", "signal")
2. **Linking** — the user provides a token (Telegram bot token) or account name (Signal CLI); it's stored in the vault and a polling thread starts
3. **Polling** — the background thread calls the poll function every N seconds; inbound messages are injected into the daemon as ~:EVENT~ signals via ~stimulus-inject~
4. **Sending** — when ~telegram-send~ or ~signal-send~ is invoked as an actuator (registered via ~register-actuator~), it formats the message and pushes it through the platform's API
The gateway management functions (~messaging-link~, ~messaging-unlink~, ~messaging-list~, ~messaging-list-print~) are what the CLI's =passepartout gateway= subcommand calls. The old ~gateway-manager~ skill had ~gateway-link~/~gateway-unlink~/~gateway-list~ printed with the same signatures; the rename to ~messaging-*~ aligns the public API with the skill name while keeping the internal engine functions (~gateway-start~, ~gateway-stop~) as-is since they're implementation details.
This replaces the old ~gateway-manager~ skill. The Telegram/Signal platform code is unchanged; only the management entry points and the defskill name changed.
* Implementation
** Platform state — configs
Storage for active gateway connections: tokens, polling threads, and intervals.
;; REPL-VERIFIED: 2026-05-03T13:00:00
** Data
#+begin_src lisp
(defvar *gateway-configs* (make-hash-table :test 'equal)
"Maps platform name → plist (:token :thread :interval :enabled)")
#+end_src
"Maps platform name to plist (:token :thread :interval :enabled)")
** Platform state — registry
Registration of available gateway implementations: each platform registers its poll and send functions here.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defvar *gateway-registry* (make-hash-table :test 'equal)
"Maps platform name → plist (:poll-fn :send-fn :default-interval)")
"Maps platform name to plist (:poll-fn :send-fn :default-interval)")
#+end_src
** Telegram Implementation
When a Telegram message arrives, the gateway first checks whether it is a
HITL approval/denial command via ~hitl-handle-message~. If consumed,
the message never enters the cognitive pipeline. Otherwise, it is injected
as a normal ~:user-input~ event via ~stimulus-inject~.
;; REPL-VERIFIED: 2026-05-03T13:00:00
** Telegram
#+begin_src lisp
(defun telegram-get-token ()
(vault-get-secret :telegram))
#+end_src
** telegram-poll
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun telegram-poll ()
"Polls Telegram for new messages and injects them into the harness."
(let* ((token (telegram-get-token)))
@@ -65,19 +51,15 @@ as a normal ~:user-input~ event via ~stimulus-inject~.
(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))))))
(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)))))))
#+end_src
** telegram-send
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun telegram-send (action context)
"Sends a message via Telegram."
(declare (ignore context))
@@ -87,7 +69,6 @@ as a normal ~:user-input~ event via ~stimulus-inject~.
(text (or (getf payload :text) (getf action :text)))
(token (telegram-get-token)))
(when (and token chat-id text)
(log-message "TELEGRAM: Sending message to ~a..." chat-id)
(handler-case
(let ((url (format nil "https://api.telegram.org/bot~a/sendMessage" token)))
(dex:post url
@@ -96,22 +77,12 @@ as a normal ~:user-input~ event via ~stimulus-inject~.
`((chat_id . ,chat-id) (text . ,text)))))
(error (c) (log-message "TELEGRAM ERROR: ~a" c))))))
#+end_src
#+end_src
** Signal Implementation
Signal messages follow the same pattern as Telegram: ~hitl-handle-message~
is called first, and only non-HITL messages are injected into the pipeline.
;; REPL-VERIFIED: 2026-05-03T13:00:00
** Signal
#+begin_src lisp
(defun signal-get-account ()
(vault-get-secret :signal))
#+end_src
** signal-poll
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun signal-poll ()
"Polls Signal for new messages and injects them into the harness."
(let ((account (signal-get-account)))
@@ -119,7 +90,7 @@ is called first, and only non-HITL messages are injected into the pipeline.
(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)))
(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)))
@@ -127,19 +98,15 @@ is called first, and only non-HITL messages are injected into the pipeline.
(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))))))))
(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))))))
#+end_src
** signal-send
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun signal-send (action context)
"Sends a message via Signal."
(declare (ignore context))
@@ -149,16 +116,13 @@ is called first, and only non-HITL messages are injected into the pipeline.
(text (or (getf payload :text) (getf action :text)))
(account (signal-get-account)))
(when (and account chat-id text)
(log-message "SIGNAL: Sending message to ~a..." chat-id)
(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))))))
#+end_src
#+end_src
** Gateway Registry Initialization
;; REPL-VERIFIED: 2026-05-03T13:00:00
** Registry initialization
#+begin_src lisp
(defun gateway-registry-initialize ()
"Registers all built-in gateway handlers."
@@ -170,24 +134,12 @@ is called first, and only non-HITL messages are injected into the pipeline.
(list :poll-fn #'signal-poll
:send-fn #'signal-send
:default-interval 5)))
#+end_src
** Core gateway functions
*** Configuration check (gateway-configured-p)
Returns T if a platform has a stored token in ~*gateway-configs*~.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun gateway-configured-p (platform)
"Returns T if a platform has a stored token."
(let ((config (gethash platform *gateway-configs*)))
(and config (getf config :token))))
#+end_src
*** Active check (gateway-active-p)
Returns T if a platform's polling thread is alive.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun gateway-active-p (platform)
"Returns T if a platform's polling thread is alive."
(let ((config (gethash platform *gateway-configs*)))
@@ -196,11 +148,9 @@ Returns T if a platform's polling thread is alive.
(bt:thread-alive-p (getf config :thread)))))
#+end_src
*** Link a gateway (gateway-link)
The main entry point for linking. Validates the registry entry, stores the token in the vault, starts the polling thread, and updates the config.
;; REPL-VERIFIED: 2026-05-03T13:00:00
** Gateway management (link/unlink)
#+begin_src lisp
(defun gateway-link (platform token)
(defun messaging-link (platform token)
"Links a platform with a token and starts polling."
(let ((platform-lc (string-downcase platform)))
(unless (gethash platform-lc *gateway-registry*)
@@ -208,7 +158,7 @@ The main entry point for linking. Validates the registry entry, stores the token
platform (loop for k being the hash-keys of *gateway-registry* collect k)))
(when (or (null token) (zerop (length token)))
(error "Token cannot be empty"))
(log-message "GATEWAY: Linking to ~a..." platform-lc)
(log-message "MESSAGING: Linking to ~a..." platform-lc)
(gateway-unlink platform-lc)
(let* ((registry-entry (gethash platform-lc *gateway-registry*))
(interval (or (getf registry-entry :default-interval) 5)))
@@ -216,28 +166,21 @@ The main entry point for linking. Validates the registry entry, stores the token
(list :token token :interval interval :enabled t))
(vault-set-secret (intern (string-upcase platform-lc) :keyword) token)
(gateway-start platform-lc)
(log-message "GATEWAY: Successfully linked ~a" platform-lc)
(log-message "MESSAGING: Successfully linked ~a" platform-lc)
(format t "Successfully linked ~a gateway. Token stored securely.~%" platform-lc)
t)))
#+end_src
*** Unlink a gateway (gateway-unlink)
Stops the polling thread and removes the config entry.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun gateway-unlink (platform)
(defun messaging-unlink (platform)
"Unlinks a platform and stops its polling thread."
(let ((platform-lc (string-downcase platform)))
(gateway-stop platform-lc)
(remhash platform-lc *gateway-configs*)
(log-message "GATEWAY: Unlinked ~a" platform-lc)
(log-message "MESSAGING: Unlinked ~a" platform-lc)
(format t "Successfully unlinked ~a gateway.~%" platform-lc)
t))
#+end_src
*** Start polling (gateway-start)
Creates a background thread that calls the platform's poll function on an interval. The thread checks the ~:enabled~ flag on each cycle so it can be stopped cleanly via ~gateway-stop~.
;; REPL-VERIFIED: 2026-05-03T13:00:00
** Polling thread management
#+begin_src lisp
(defun gateway-start (platform)
"Starts the polling thread for a linked gateway."
@@ -255,29 +198,22 @@ Creates a background thread that calls the platform's poll function on an interv
(funcall poll-fn))
(sleep interval)))
:name (format nil "passepartout-~a-gateway" platform-lc)))
(log-message "GATEWAY: Started ~a polling (interval: ~as)" platform-lc interval)))))))))
#+end_src
(log-message "MESSAGING: Started ~a polling (interval: ~as)" platform-lc interval))))))))
*** Stop polling (gateway-stop)
Destroys the polling thread and nulls the thread reference.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun gateway-stop (platform)
"Stops the polling thread for a gateway."
(let ((platform-lc (string-downcase platform)))
(let ((config (gethash platform-lc *gateway-configs*)))
(when (and config (getf config :thread))
(when (bt:thread-alive-p (getf config :thread))
(log-message "GATEWAY: Stopping ~a polling thread" platform-lc)
(log-message "MESSAGING: Stopping ~a polling thread" platform-lc)
(bt:destroy-thread (getf config :thread))))
(setf (getf config :thread) nil))))
#+end_src
*** List gateways (gateway-list)
Returns a list of plists, one per registered platform, with :platform, :configured, and :active keys.
;; REPL-VERIFIED: 2026-05-03T13:00:00
** Listing
#+begin_src lisp
(defun gateway-list ()
(defun messaging-list ()
"Returns a list of all gateways with their status."
(loop for platform being the hash-keys of *gateway-registry*
collect (let ((configured (gateway-configured-p platform))
@@ -285,17 +221,12 @@ Returns a list of plists, one per registered platform, with :platform, :configur
(list :platform platform
:configured configured
:active active))))
#+end_src
*** Print gateways (gateway-list-print)
Formats ~gateway-list~ for display in the CLI.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun gateway-list-print ()
(defun messaging-list-print ()
"Prints a formatted table of gateways."
(format t "~%")
(format t " ~20@A ~12@A ~10@A~%" "PLATFORM" "CONFIGURED" "STATUS")
(dolist (gw (gateway-list))
(dolist (gw (messaging-list))
(format t " ~20@A ~12@A ~10@A~%"
(getf gw :platform)
(if (getf gw :configured) "yes" "no")
@@ -306,9 +237,7 @@ Formats ~gateway-list~ for display in the CLI.
(format t "~%"))
#+end_src
*** Start all configured gateways (gateway-start-all)
Called during boot to start all gateways that have tokens stored in their configs.
;; REPL-VERIFIED: 2026-05-03T13:00:00
** Boot
#+begin_src lisp
(defun gateway-start-all ()
"Called at boot to start all configured gateways."
@@ -319,23 +248,15 @@ Called during boot to start all gateways that have tokens stored in their config
(gateway-start platform)))))
#+end_src
** Actuator Registration
Register :telegram and :signal as actuators for outbound messages.
** Registration and boot
#+begin_src lisp
(register-actuator :telegram #'telegram-send)
(register-actuator :signal #'signal-send)
#+end_src
** Skill Registration
#+begin_src lisp
(defskill :passepartout-gateway-manager
(defskill :passepartout-gateway-messaging
:priority 150
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src
** Initialization
Initialize registry and start configured gateways on skill load.
#+begin_src lisp
(gateway-registry-initialize)
(gateway-start-all)
#+end_src
#+end_src

4
org/security-vault.org
View File

@@ -43,9 +43,9 @@ The *Credentials Vault* provides secure in-memory storage for sensitive API keys
#+end_src
#+end_src
** Secret Wrappers (gateway-manager)
** Secret Wrappers (gateway-messaging)
Thin wrappers that match the export names used by =gateway-manager=.
Thin wrappers that match the export names used by =gateway-messaging=.
Delegates to the existing =vault-get=/=vault-set= with ~:type :secret~.
;; REPL-VERIFIED: 2026-05-03T13:00:00

4
org/system-archivist.org
View File

@@ -290,10 +290,10 @@ Triggered by heartbeat events, runs Scribe and Gardener on alternating schedules
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun archivist-run (context)
(defun archivist-run (action context)
"Runs the archivist maintenance cycle. Checks Scribe and Gardener schedules
and dispatches as needed. Called by the deterministic gate."
(declare (ignore context))
(declare (ignore action context))
(let ((now (get-universal-time)))
;; Scribe runs every 6 hours (21600 seconds)
(when (>= (- now *archivist-last-scribe*) 21600)

232
org/system-embedding-gateway.org
View File

@@ -1,232 +0,0 @@
#+TITLE: SKILL: Embedding Gateway (org-skill-embedding-gateway.org)
#+AUTHOR: Agent
#+FILETAGS: :system:memory:embeddings:
#+PROPERTY: header-args:lisp :tangle ../lisp/system-embedding-gateway.lisp
* Overview
Provider-agnostic vector embedding gateway. Generates dense vectors for
~memory-object~ entries via a pluggable backend, enabling semantic similarity
search. Designed for thin harness: the core (core-context) knows how to USE
vectors but not how to GENERATE them — that lives here.
Backends are configured via ~EMBEDDING_PROVIDER~:
- ~:hashing~ (default) — FNV-1a hashing trick, no external dependencies
- ~:ollama~ — POST /api/embeddings to a local Ollama instance
Newly ingested objects are queued for embedding via ~embed-queue-object~.
The ~embed-all-pending~ function drains the queue on heartbeat ticks, with
a store-wide scan as fallback for objects ingested before the skill loaded.
* Implementation
** Package Context
#+begin_src lisp
(in-package :passepartout)
#+end_src
** Embedding Queue
Pending object IDs to embed. Populated by ~embed-queue-object~.
;; REPL-VERIFIED: 2026-05-03T14:00:00
#+begin_src lisp
(defvar *embedding-queue* nil
"List of object IDs pending embedding.")
#+end_src
** Provider Selection
~*embedding-provider*~ tracks the active provider keyword. Set at load time
from the ~EMBEDDING_PROVIDER~ env var.
;; REPL-VERIFIED: 2026-05-03T14:00:00
#+begin_src lisp
(defvar *embedding-provider* :hashing
"Active embedding provider: :hashing, :ollama, :openai.")
#+end_src
** Text Tokenizer
Splits text into lowercase word tokens for the hashing trick.
;; REPL-VERIFIED: 2026-05-03T14:00:00
#+begin_src lisp
(defun embeddings-tokenize (text)
"Split TEXT into lowercase word tokens, strip punctuation, discard short."
(let ((clean (cl-ppcre:regex-replace-all "[^a-zA-Z0-9 ]"
(string-downcase (or text "")) " ")))
(remove-if (lambda (w) (< (length w) 2))
(uiop:split-string clean :separator '(#\Space #\Tab #\Newline)))))
#+end_src
** Hashing Trick
FNV-1a hash to a fixed-dimension bucket. Produces dense ±1 vectors from
vocabulary co-occurrence patterns without any training or external services.
;; REPL-VERIFIED: 2026-05-03T14:00:00
#+begin_src lisp
(defun embeddings-hash-word (word dim)
"Hash WORD to an index in [0, DIM)."
(let ((hash 2166136261))
(loop for c across word
do (setf hash (logxor hash (char-code c)))
(setf hash (mod (* hash 16777619) #x100000000)))
(mod hash dim)))
#+end_src
** embeddings-hash-vector
;; REPL-VERIFIED: 2026-05-03T14:00:00
#+begin_src lisp
(defun embeddings-hash-vector (text &key (dimensions 384))
"Compute a hashing-trick vector for TEXT."
(let* ((tokens (embeddings-tokenize text))
(vec (make-array dimensions :initial-element 0.0d0 :element-type 'double-float)))
(dolist (token tokens)
(let* ((idx (embeddings-hash-word token dimensions))
(sign (if (evenp (char-code (char token 0))) 1 -1)))
(incf (aref vec idx) (coerce sign 'double-float))))
(let ((norm (sqrt (loop for i below dimensions sum (expt (aref vec i) 2)))))
(if (> norm 0.0d0)
(loop for i below dimensions collect (/ (aref vec i) norm))
(loop for i below dimensions collect 0.0d0)))))
#+end_src
** Embedding Compute
Top-level embedding function. Tries the configured backend first, falls back
to the hashing trick. Registered as ~*embedding-backend*~ for provider
pluggability.
;; REPL-VERIFIED: 2026-05-03T14:00:00
#+begin_src lisp
(defun embeddings-compute (text &key (dimensions 384))
"Compute embedding vector for TEXT.
Tries *embedding-backend* first, falls back to hashing trick."
(when *embedding-backend*
(handler-case
(let ((result (funcall *embedding-backend* text)))
(when (and result (listp result) (> (length result) 0))
(return-from embeddings-compute result)))
(error (c)
(log-message "EMBEDDING: Backend failed (~a), fallback to hashing" c))))
(embeddings-hash-vector text :dimensions dimensions))
#+end_src
** Ollama Backend
Calls ~POST /api/embeddings~ on a local Ollama instance. Configurable via
~OLLAMA_URL~ (default http://localhost:11434) and ~EMBEDDING_MODEL~ (default
nomic-embed-text).
;; REPL-VERIFIED: 2026-05-03T14:00:00
#+begin_src lisp
(defun embedding-backend-ollama (text)
"Generate embeddings via Ollama /api/embeddings."
(let* ((url (or (uiop:getenv "OLLAMA_URL") "http://localhost:11434"))
(model (or (uiop:getenv "EMBEDDING_MODEL") "nomic-embed-text"))
(response (dex:post (format nil "~a/api/embeddings" url)
:content (json:encode-json-to-string
`((:model . ,model) (:prompt . ,text)))
:headers '(("Content-Type" . "application/json")))))
(when response
(let* ((json (json:decode-json-from-string response))
(embedding (cdr (assoc :embedding json))))
(when embedding
(coerce embedding 'list))))))
#+end_src
** Queue Object
~embed-queue-object~ adds an object to the pending queue if it lacks a
vector. Call from the perceive gate after ~ingest-ast~.
;; REPL-VERIFIED: 2026-05-03T14:00:00
#+begin_src lisp
(defun embed-queue-object (obj)
"Queue OBJ for embedding if it lacks a vector."
(when (and obj (not (memory-object-vector obj)))
(pushnew (memory-object-id obj) *embedding-queue* :test 'string=)))
#+end_src
** Embed Single Object
Generates and stores a vector for a single memory object.
;; REPL-VERIFIED: 2026-05-03T14:00:00
#+begin_src lisp
(defun embed-object (obj)
"Generate and store embedding vector for OBJ."
(let* ((attrs (memory-object-attributes obj))
(title (or (getf attrs :TITLE) ""))
(text (or (memory-object-content obj) ""))
(raw-tags (getf attrs :TAGS))
(tag-list (if (listp raw-tags) raw-tags nil))
(tags (if tag-list (format nil "~{~a~^ ~}" tag-list) ""))
(combined (format nil "~a ~a ~a" title text tags))
(vec (embeddings-compute combined)))
(setf (memory-object-vector obj) vec)
(log-message "EMBEDDING: Vector for ~a (~d dims)" (memory-object-id obj) (length vec))
vec))
#+end_src
** Batch Process
Drains the queue and (if queue was empty) scans the store for remaining
objects without vectors. Returns count of newly embedded objects.
;; REPL-VERIFIED: 2026-05-03T14:00:00
#+begin_src lisp
(defun embed-all-pending ()
"Process all pending embeddings. Returns count."
(let ((count 0))
;; Drain queue
(let ((pending *embedding-queue*))
(setf *embedding-queue* nil)
(dolist (id pending)
(let ((obj (gethash id *memory-store*)))
(when (and obj (not (memory-object-vector obj)))
(handler-case
(progn (embed-object obj) (incf count))
(error (c)
(log-message "EMBEDDING: Failed ~a: ~a" id c)))))))
;; Fallback: scan store for objects without vectors
(when (= count 0)
(maphash (lambda (id obj)
(declare (ignore id))
(unless (memory-object-vector obj)
(handler-case
(progn (embed-object obj) (incf count))
(error (c)
(log-message "EMBEDDING: Failed ~a: ~a"
(memory-object-id obj) c)))))
*memory-store*))
(when (> count 0)
(log-message "EMBEDDING: Batch processed ~d objects" count))
count))
#+end_src
** Initialization
Reads ~EMBEDDING_PROVIDER~ env var and configures the backend.
;; REPL-VERIFIED: 2026-05-03T14:00:00
#+begin_src lisp
(defun embeddings-init (&key (provider *embedding-provider*))
"Init embedding provider from EMBEDDING_PROVIDER env var."
(let* ((env (uiop:getenv "EMBEDDING_PROVIDER"))
(selected (or (and env (intern (string-upcase env) :keyword))
provider)))
(setf *embedding-provider* selected)
(setf *embedding-backend*
(case selected
(:ollama #'embedding-backend-ollama)
(t nil)))
(log-message "EMBEDDING: Provider ~a, backend=~a" selected *embedding-backend*)
selected))
(embeddings-init)
#+end_src

123
org/system-model-embedding.org Normal file
View File

@@ -0,0 +1,123 @@
#+TITLE: SKILL: Embedding Gateway (org-skill-embedding-gateway.org)
#+AUTHOR: Agent
#+FILETAGS: :skill:system:embedding:
#+PROPERTY: header-args:lisp :tangle ../lisp/system-model-embedding.lisp
* Architectural Intent
~system-model-embedding~ converts text into vector representations for semantic search and memory retrieval. It provides three backends:
- ~:local~ — any OpenAI-compatible ~/api/embeddings~ endpoint (Ollama, vLLM, etc.)
- ~:openai~ — the OpenAI ~/v1/embeddings~ API with an API key
- ~:hashing~ — a zero-dependency fallback that produces deterministic vectors from SHA-256 hashes. No server, no config, works offline.
The embedding queue (~embed-queue-object~ / ~embed-all-pending~) decouples document indexing from the main loop. On each heartbeat tick, ~embed-all-pending~ drains the queue and embeds all accumulated objects. This prevents indexing traffic from blocking conversational responses.
The default provider is ~:hashing~ — useful for bootstrapping with zero configuration and for deployments where embedding quality isn't critical. Switch to ~:local~ or ~:openai~ when you have an embedding server available.
This replaces the old ~system-embedding-gateway~ with the same logic but renamed to ~system-model-embedding~ to live alongside the other ~system-model-*~ skills.
* Implementation
** State
#+begin_src lisp
(in-package :passepartout)
(defvar *embedding-provider* :hashing
"Active embedding provider: :hashing, :local, :openai.")
(defvar *embedding-queue* nil
"Queue of text objects awaiting embedding.")
(defvar *embedding-batch-size* 10
"Maximum texts per embedding API call.")
#+end_src
** Local backend (OpenAI-compatible)
#+begin_src lisp
(defun embedding-backend-local (text)
"Generate embeddings via a local OpenAI-compatible endpoint."
(let* ((url (or (uiop:getenv "LOCAL_BASE_URL") (format nil "http://~a" (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))))
(model (or (uiop:getenv "EMBEDDING_MODEL") "nomic-embed-text"))
(body (cl-json:encode-json-to-string
`((model . ,model) (input . ,text)))))
(handler-case
(let* ((response (dex:post (format nil "~a/api/embeddings" url)
:headers '(("Content-Type" . "application/json"))
:content body :connect-timeout 5 :read-timeout 30))
(json (cl-json:decode-json-from-string response))
(data (car (cdr (assoc :data json)))))
(or (cdr (assoc :embedding data))
(list :error "No embedding in response")))
(error (c)
(list :error (format nil "Embedding failed: ~a" c))))))
#+end_src
** OpenAI backend
#+begin_src lisp
(defun embedding-backend-openai (text)
"Generate embeddings via OpenAI compatible /v1/embeddings endpoint."
(let* ((api-key (uiop:getenv "OPENAI_API_KEY"))
(base-url (or (uiop:getenv "EMBEDDING_BASE_URL") "https://api.openai.com/v1"))
(model (or (uiop:getenv "EMBEDDING_MODEL") "text-embedding-3-small"))
(body (cl-json:encode-json-to-string
`((model . ,model) (input . ,text)))))
(handler-case
(let* ((response (dex:post (format nil "~a/embeddings" base-url)
:headers `(("Content-Type" . "application/json")
("Authorization" . ,(format nil "Bearer ~a" api-key)))
:content body :connect-timeout 5 :read-timeout 30))
(json (cl-json:decode-json-from-string response))
(data (car (cdr (assoc :data json)))))
(or (cdr (assoc :embedding data))
(list :error "No embedding in response")))
(error (c)
(list :error (format nil "OpenAI Embedding failed: ~a" c))))))
#+end_src
** Hashing fallback
#+begin_src lisp
(defun embedding-backend-hashing (text)
"Fallback: produces a deterministic vector from the text hash."
(let* ((digest (ironclad:digest-sequence :sha256 (babel:string-to-octets text)))
(vec (make-array 8 :element-type 'single-float :initial-element 0.0)))
(dotimes (i (min (length digest) 8))
(setf (aref vec i) (float (/ (aref digest i) 255.0) 0.0)))
vec))
#+end_src
** Object embedding and queuing
#+begin_src lisp
(defun embed-object (text)
"Embed a single text string using the active backend."
(let* ((selected (or *embedding-provider* :hashing))
(backend (case selected
(:local #'embedding-backend-local)
(:openai #'embedding-backend-openai)
(t #'embedding-backend-hashing))))
(if backend
(progn
(log-message "EMBEDDING: Provider ~a, backend=~a" selected backend)
(funcall backend text))
(progn
(log-message "EMBEDDING: No backend for provider ~a, using hashing" selected)
(embedding-backend-hashing text)))))
(defun embed-queue-object (object)
"Queue a text object for async embedding."
(push object *embedding-queue*)
(log-message "EMBEDDING: Queued object"))
(defun embed-all-pending ()
"Drain the embedding queue, batch-process all queued objects."
(let ((batch (nreverse *embedding-queue*)))
(setf *embedding-queue* nil)
(dolist (item batch)
(handler-case
(let ((text (if (stringp item) item (format nil "~a" item))))
(embed-object text))
(error (c)
(log-message "EMBEDDING: Failed to embed object: ~a" c))))))
(log-message "EMBEDDING: Gateway loaded with provider ~a" *embedding-provider*)
#+end_src

137
org/system-model-explorer.org Normal file
View File

@@ -0,0 +1,137 @@
#+TITLE: SKILL: Model Explorer (org-skill-model-explorer.org)
#+AUTHOR: Agent
#+FILETAGS: :skill:model:explorer:discovery:
#+PROPERTY: header-args:lisp :tangle ../lisp/system-model-explorer.lisp
* Architectural Intent
~system-model-explorer~ answers two questions the config screen needs: "What models does my provider offer?" and "Which one should I use for this task?"
It opens a thin pipe to OpenRouter's /api/v1/models endpoint (no API key needed for the model list), parses the JSON into a uniform set of plists, and caches the result. The TUI's model dropdowns and recommendation cards all read from this cache.
Recommended models are curated per task slot — code generation needs different capabilities than casual chat or background summarization. The recommendations are not hardcoded provider hooks; they're hand-picked from the OpenRouter free tier as a sensible default. Users can override via the TUI config screen, which replaces the picked model IDs into their cascade.
* Implementation
** Cache
#+begin_src lisp
(in-package :passepartout)
(defvar *model-cache* (make-hash-table :test 'equal)
"Cache: provider keyword -> (timestamp . model-list)")
(defvar *model-cache-ttl* 300
"Cache TTL in seconds (default 5 min)")
#+end_src
** OpenRouter fetch
#+begin_src lisp
(defun model-explorer-fetch-openrouter ()
"Query OpenRouter /api/v1/models and return parsed model list."
(handler-case
(let* ((raw (dex:get "https://openrouter.ai/api/v1/models" :connect-timeout 10 :read-timeout 20))
(json (cl-json:decode-json-from-string raw))
(data (cdr (assoc :data json))))
(mapcar (lambda (m)
(let ((pricing (cdr (assoc :pricing m))))
(list :id (cdr (assoc :id m))
:name (cdr (assoc :name m))
:context (cdr (assoc :context_length m))
:free (and pricing
(string= "0" (cdr (assoc :prompt pricing)))
(string= "0" (cdr (assoc :completion pricing)))))))
data))
(error (c)
(log-message "MODEL-EXPLORER: OpenRouter API error: ~a" c)
nil)))
#+end_src
** Generic fetch with cache
#+begin_src lisp
(defun model-explorer-fetch (provider)
"Fetch available models for PROVIDER. Returns list of (:id :name :context :free) plists."
(let ((cached (gethash provider *model-cache*)))
(when (and cached (< (- (get-universal-time) (car cached)) *model-cache-ttl*))
(return-from model-explorer-fetch (cdr cached))))
(let ((models (case provider
(:openrouter (model-explorer-fetch-openrouter))
(t nil))))
(when models
(setf (gethash provider *model-cache*)
(cons (get-universal-time) models)))
models))
#+end_src
** List-free convenience
#+begin_src lisp
(defun model-explorer-list-free ()
"Return all free models from cache or fetch."
(remove-if-not (lambda (m) (getf m :free)) (model-explorer-fetch :openrouter)))
#+end_src
** Curated recommendations per slot
#+begin_src lisp
(defun model-explorer-recommend (slot)
"Return recommended models for SLOT (:code, :chat, :plan, :background)."
(case slot
(:code
'((:id "qwen/qwen3-coder:free" :name "Qwen3 Coder 480B" :context 262000 :free t :note "Top-tier code MoE, 35B active")
(:id "poolside/laguna-m.1:free" :name "Laguna M.1" :context 131072 :free t :note "Flagship coding agent")
(:id "openai/gpt-oss-120b:free" :name "gpt-oss-120b" :context 131072 :free t :note "117B MoE open-weight coding")))
(:plan
'((:id "openrouter/owl-alpha" :name "Owl Alpha" :context 1048756 :free t :note "Agentic, tool use, reasoning")
(:id "nousresearch/hermes-3-llama-3.1-405b:free" :name "Hermes 3 405B" :context 131072 :free t :note "405B generalist, strong planning")
(:id "minimax/minimax-m2.5:free" :name "MiniMax M2.5" :context 196608 :free t :note "SOTA productivity, long context")))
(:chat
'((:id "meta-llama/llama-3.3-70b-instruct:free" :name "Llama 3.3 70B" :context 65536 :free t :note "Strong multilingual generalist")
(:id "google/gemma-4-31b-it:free" :name "Gemma 4 31B" :context 262144 :free t :note "Dense 31B, thinking mode, long context")
(:id "mistralai/mistral-nemo:free" :name "Mistral Nemo" :context 32768 :free t :note "Fast, good for casual conversation")))
(:background
'((:id "meta-llama/llama-3.2-3b-instruct:free" :name "Llama 3.2 3B" :context 131072 :free t :note "Small, fast, efficient")
(:id "liquid/lfm-2.5-1.2b-instruct:free" :name "LFM 2.5 1.2B" :context 32768 :free t :note "Ultra-compact, edge-ready")))
(t '((:id "meta-llama/llama-3.3-70b-instruct:free" :name "Llama 3.3 70B" :context 65536 :free t :note "Safe fallback")))))
#+end_src
* Tests
#+begin_src lisp :tangle ../tests/model-explorer-tests.lisp
;; REPL-verified: 2026-05-04
(eval-when (:compile-toplevel :load-toplevel :execute)
(ignore-errors (ql:quickload :fiveam :silent t)))
(defpackage :passepartout-system-model-explorer-tests
(:use :cl :passepartout)
(:export #:model-explorer-suite))
(in-package :passepartout-system-model-explorer-tests)
(fiveam:def-suite model-explorer-suite :description "Tests for the model explorer skill")
(fiveam:in-suite model-explorer-suite)
(fiveam:test model-explorer-recommend-slots
"model-explorer-recommend should return models for all standard slots"
(dolist (slot '(:code :chat :plan :background))
(let ((recs (passepartout::model-explorer-recommend slot)))
(fiveam:is (listp recs))
(fiveam:is (>= (length recs) 1)))))
(fiveam:test model-explorer-recommend-format
"Each recommendation should have :id and :name"
(dolist (rec (passepartout::model-explorer-recommend :chat))
(fiveam:is (getf rec :id))
(fiveam:is (getf rec :name))))
(fiveam:test model-explorer-recommend-unknown-slot
"Unknown slot should return fallback"
(let ((recs (passepartout::model-explorer-recommend :unknown)))
(fiveam:is (listp recs))
(fiveam:is (>= (length recs) 1))))
(fiveam:test model-explorer-fetch-openrouter-count
"OpenRouter API should return at least 300 models"
(let ((models (passepartout::model-explorer-fetch :openrouter)))
(if models
(fiveam:is (>= (length models) 300))
(fiveam:skip "API unreachable"))))
#+end_src

72
org/gateway-provider.org → org/system-model-provider.org
View File

@@ -1,72 +1,70 @@
#+TITLE: SKILL: Unified LLM Backend (org-skill-unified-llm-backend.org)
#+AUTHOR: Agent
#+FILETAGS: :skill:llm:backend:openai-compatible:
#+PROPERTY: header-args:lisp :tangle ../lisp/gateway-provider.lisp
#+FILETAGS: :skill:model:provider:llm:
#+PROPERTY: header-args:lisp :tangle ../lisp/system-model-provider.lisp
* Architectural Intent
The Unified LLM Backend provides a single OpenAI-compatible API client that works with any provider supporting the ~/v1/chat/completions~ endpoint. This covers local engines (Ollama, vLLM, LM Studio, llama.cpp) and cloud providers (OpenRouter, OpenAI, Anthropic, Groq, Gemini, DeepSeek, NVIDIA NIM).
~system-model-provider~ is the universal LLM client. It speaks the OpenAI-compatible ~/v1/chat/completions~ protocol, which covers every modern provider — OpenRouter, OpenAI, Anthropic, Groq, Gemini, DeepSeek, NVIDIA NIM, plus any local engine (Ollama, vLLM, LM Studio, llama.cpp) when running behind an OpenAI-compatible adapter.
The key design decision: **one client, many configurations**. Instead of having separate skills for each provider (org-skill-ollama, org-skill-openai, etc.), this single skill holds a configuration table mapping provider keywords to their base URL, API key env var, and default model. The same ~provider-openai-request~ function works for all of them.
One function, eight (and counting) providers. The same JSON payload, the same response format, the same error handling. Adding a new provider is a one-line config entry: a keyword, a base URL, an API key env var name, and a default model.
Providers are registered automatically at boot based on which API keys are set in the environment. If OPENAI_API_KEY is set, OpenAI is available. If not, it's skipped silently.
Providers register themselves at boot. No API key? That provider doesn't register. No local URL set? The local entry stays dormant. Only the providers you actually configure appear in ~*probabilistic-backends*~ at runtime. The old code assumed Ollama was always available; this code requires an env var like everything else.
Providers are registered automatically based on available environment variables.
No separate skills per provider — just different base URLs and API keys.
=*provider-cascade*= defaults to cloud-only (all providers except ~:local~ and ~:ollama~). If you want a local fallback, set ~LOCAL_BASE_URL~ in your env and add ~:local~ to the ~PROVIDER_CASCADE~ list.
* Implementation
** Provider registry (~*provider-configs*~)
The authoritative list of supported LLM providers and their configuration: base URL, env var for API key, and default model name.
;; REPL-VERIFIED: 2026-05-03T13:00:00
** Provider registry
#+begin_src lisp
(defparameter *provider-configs*
'((:ollama . (:base-url nil :key-env nil :default-model "llama3"))
'((:local . (:base-url nil :key-env nil :url-env "LOCAL_BASE_URL" :default-model "llama3"))
(:openrouter . (:base-url "https://openrouter.ai/api/v1" :key-env "OPENROUTER_API_KEY" :default-model "openrouter/auto"))
(:openai . (:base-url "https://api.openai.com/v1" :key-env "OPENAI_API_KEY" :default-model "gpt-4o-mini"))
(:anthropic . (:base-url "https://api.anthropic.com/v1" :key-env "ANTHROPIC_API_KEY" :default-model "claude-3-5-sonnet-20241022"))
(:groq . (:base-url "https://api.groq.com/openai/v1" :key-env "GROQ_API_KEY" :default-model "llama-3.1-70b-versatile"))
(:gemini . (:base-url "https://generativelanguage.googleapis.com/v1beta/openai" :key-env "GEMINI_API_KEY" :default-model "gemini-2.0-flash"))
(:deepseek . (:base-url "https://api.deepseek.com/v1" :key-env "DEEPSEEK_API_KEY" :default-model "deepseek-chat"))
(:nvidia . (:base-url "https://integrate.api.nvidia.com/v1" :key-env "NVIDIA_API_KEY" :default-model "meta/llama-3.1-405b-instruct"))))
(:nvidia . (:base-url "https://integrate.api.nvidia.com/v1" :key-env "NVIDIA_API_KEY" :default-model "meta/llama-3.1-405b-instruct"))
(:ollama . (:base-url nil :key-env nil :url-env "OLLAMA_HOST" :default-model "llama3"))))
#+end_src
** Provider config lookup (provider-config)
Returns the config plist for a given provider keyword.
;; REPL-VERIFIED: 2026-05-03T13:00:00
** Provider config lookup
#+begin_src lisp
(defun provider-config (provider)
"Returns the configuration plist for a provider keyword."
(cdr (assoc provider *provider-configs*)))
#+end_src
** Availability check (provider-available-p)
Returns T if a provider is configured — meaning it either has an API key set, or it is Ollama (always available locally).
;; REPL-VERIFIED: 2026-05-03T13:00:00
** Availability check
#+begin_src lisp
(defun provider-available-p (provider)
"Checks if a provider is configured. Ollama is always considered available."
"Checks if a provider is configured. Checks API key or URL env vars."
(let* ((config (provider-config provider))
(key-env (getf config :key-env))
(url-env (getf config :url-env))
(base-url (getf config :base-url)))
(cond ((eq provider :ollama) t)
(key-env (let ((key (uiop:getenv key-env))) (and key (> (length key) 0))))
(cond (key-env (let ((key (uiop:getenv key-env))) (and key (> (length key) 0))))
(url-env (let ((url (uiop:getenv url-env))) (and url (> (length url) 0))))
(base-url t))))
#+end_src
** Unified Request Execution
;; REPL-VERIFIED: 2026-05-03T13:00:00
** Unified request execution
#+begin_src lisp
(defun provider-openai-request (prompt system-prompt &key model (provider :ollama))
(defun provider-openai-request (prompt system-prompt &key model (provider :openrouter))
"Executes a request against any OpenAI-compatible API endpoint."
(let* ((config (provider-config provider))
(base-url (getf config :base-url))
(key-env (getf config :key-env))
(url-env (getf config :url-env))
(default-model (getf config :default-model))
(api-key (when key-env (uiop:getenv key-env)))
(model-id (or model default-model))
(url (if (eq provider :ollama)
(format nil "http://~a/v1/chat/completions" (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))
(url (if url-env
(let ((host (uiop:getenv url-env)))
(if host
(format nil "http://~a/v1/chat/completions" host)
(format nil "~a/chat/completions" base-url)))
(format nil "~a/chat/completions" base-url)))
(headers `(("Content-Type" . "application/json")
,@(when api-key `(("Authorization" . ,(format nil "Bearer ~a" api-key))))
@@ -91,8 +89,7 @@ Returns T if a provider is configured — meaning it either has an API key set,
(list :status :error :message (format nil "~a Failure: ~a" provider c))))))
#+end_src
** Dynamic Backend Registration
;; REPL-VERIFIED: 2026-05-03T13:00:00
** Register all available providers
#+begin_src lisp
(defun provider-register-all ()
"Scans environment variables and registers all available LLM backends."
@@ -103,10 +100,9 @@ Returns T if a provider is configured — meaning it either has an API key set,
(register-probabilistic-backend provider
(lambda (prompt system-prompt &key model)
(provider-openai-request prompt system-prompt :model model :provider provider)))))))
#+end_src
** provider-cascade-initialize
;; REPL-VERIFIED: 2026-05-03T13:00:00
** Initialize cascade
#+begin_src lisp
(defun provider-cascade-initialize ()
"Reads PROVIDER_CASCADE from env and sets *provider-cascade*."
@@ -115,16 +111,20 @@ Returns T if a provider is configured — meaning it either has an API key set,
(setf *provider-cascade*
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword))
(uiop:split-string cascade-str :separator '(#\,))))
(setf *provider-cascade* (mapcar #'car *provider-configs*)))))
#+end_src
(setf *provider-cascade* (mapcar #'car (remove-if (lambda (e)
(member (car e) '(:local :ollama)))
*provider-configs*))))))
#+end_src
** Skill Registration
** Boot registration
#+begin_src lisp
(provider-register-all)
(provider-cascade-initialize)
#+end_src
(defskill :passepartout-gateway-provider
** Skill registration
#+begin_src lisp
(defskill :passepartout-system-model-provider
:priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src
#+end_src

2
org/system-model-router.org
View File

@@ -171,7 +171,7 @@ Returns model name or :skip."
(t *model-cascade-chat*)))
(entry (model-cascade-find
(or cascade '((:ollama . "qwen2.5:14b"))) backend)))
(if entry (cdr entry) :skip)))))
(if entry (cdr entry) nil)))))
#+end_src
** Initialization

39
org/system-model.org Normal file
View File

@@ -0,0 +1,39 @@
#+TITLE: SKILL: Model Dispatch (org-skill-model.org)
#+AUTHOR: Agent
#+FILETAGS: :skill:model:dispatch:
#+PROPERTY: header-args:lisp :tangle ../lisp/system-model.lisp
* Architectural Intent
~system-model~ is the dispatcher. It sits between the reason pipeline and the provider backends registered in ~*probabilistic-backends*~. The reason pipeline calls ~model-request~ with a provider keyword and a model name; ~model-request~ looks up that provider's handler function, calls it, and returns the result.
This is intentionally thin. All the provider-specific logic (URL construction, API key headers, JSON parsing) lives in ~system-model-provider~. All the routing logic (which model for which task) lives in ~system-model-router~. This skill is the seam — it decouples "who to call" from "how to call them" and "why to call them."
When every provider fails (not registered, or all return errors), ~model-request~ returns an error plist with ~:status :error~. The reason pipeline's ~backend-cascade-call~ catches this and falls through to the next provider in the cascade. If no provider can serve the request, the cascade returns the "Neural Cascade Failure" signal.
~model-request~ replaces the old ~gateway-llm-request~ with the same contract but renamed for consistency with the ~system-model-*~ family.
* Implementation
** Request execution
#+begin_src lisp
(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)))))
#+end_src
** Skill registration
#+begin_src lisp
(defskill :passepartout-system-model
:priority 100
:trigger (lambda (ctx) (getf ctx :user-input))
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))
#+end_src

9
passepartout
View File

@@ -382,7 +382,8 @@ case "$COMMAND" in
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval "(ql:quickload :passepartout)" \
--eval "(load (format nil \"~alisp/system-model-router.lisp\" (truename \"$PASSEPARTOUT_DATA_DIR/\")))" \
--eval "(load (format nil \"~alisp/system-embedding-gateway.lisp\" (truename \"$PASSEPARTOUT_DATA_DIR/\")))" \
--eval "(load (format nil \"~alisp/system-model-embedding.lisp\" (truename \"$PASSEPARTOUT_DATA_DIR/\")))" \
--eval "(load (format nil \"~alisp/system-model-explorer.lisp\" (truename \"$PASSEPARTOUT_DATA_DIR/\")))" \
--eval '(passepartout:main)' \
> "$PASSEPARTOUT_STATE_DIR/daemon.log" 2>&1 &
echo "Waiting for port 9105..."
@@ -415,7 +416,7 @@ case "$COMMAND" in
--eval "(push (truename \"$PASSEPARTOUT_DATA_DIR/\") asdf:*central-registry*)" \
--eval '(ql:quickload :passepartout :force t)' \
--eval '(passepartout:skill-initialize-all)' \
--eval '(funcall (find-symbol "GATEWAY-LIST-PRINT" (find-package "OPENCORTEX.SKILLS.ORG-SKILL-GATEWAY-MANAGER")))'
--eval '(funcall (find-symbol "MESSAGING-LIST-PRINT" (find-package "OPENCORTEX.SKILLS.ORG-SKILL-GATEWAY-MESSAGING")))'
;;
link)
[ -z "$PLATFORM" ] || [ -z "$TOKEN" ] && echo "Usage: passepartout gateway link <platform> <token>" && exit 1
@@ -424,7 +425,7 @@ case "$COMMAND" in
--eval "(push (truename \"$PASSEPARTOUT_DATA_DIR/\") asdf:*central-registry*)" \
--eval '(ql:quickload :passepartout :force t)' \
--eval '(passepartout:skill-initialize-all)' \
--eval "(funcall (find-symbol \"GATEWAY-LINK\" (find-package \"OPENCORTEX.SKILLS.ORG-SKILL-GATEWAY-MANAGER\")) \"$PLATFORM\" \"$TOKEN\")"
--eval "(funcall (find-symbol \"MESSAGING-LINK\" (find-package \"OPENCORTEX.SKILLS.ORG-SKILL-GATEWAY-MESSAGING\")) \"$PLATFORM\" \"$TOKEN\")"
;;
unlink)
[ -z "$PLATFORM" ] && echo "Usage: passepartout gateway unlink <platform>" && exit 1
@@ -433,7 +434,7 @@ case "$COMMAND" in
--eval "(push (truename \"$PASSEPARTOUT_DATA_DIR/\") asdf:*central-registry*)" \
--eval '(ql:quickload :passepartout :force t)' \
--eval '(passepartout:skill-initialize-all)' \
--eval "(funcall (find-symbol \"GATEWAY-UNLINK\" (find-package \"OPENCORTEX.SKILLS.ORG-SKILL-GATEWAY-MANAGER\")) \"$PLATFORM\")"
--eval "(funcall (find-symbol \"MESSAGING-UNLINK\" (find-package \"OPENCORTEX.SKILLS.ORG-SKILL-GATEWAY-MESSAGING\")) \"$PLATFORM\")"
;;
*) echo "Usage: passepartout gateway {list|link|unlink}"; exit 1 ;;
esac

3
passepartout.asd
View File

@@ -30,7 +30,8 @@
(:file "tests/tui-tests")
(:file "tests/utils-org-tests")
(:file "tests/utils-lisp-tests")
(:file "tests/llm-gateway-tests")))
(:file "tests/llm-gateway-tests")
(:file "tests/model-explorer-tests")))
(defsystem :passepartout/tui
:depends-on (:passepartout :croatoan :usocket :bordeaux-threads)