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

passepartout: v0.5.0 hotfix 2 — daemon stable
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Details

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

Verified: daemon processes messages, TUI clean, gate trace works
This commit is contained in:
Amr Gharbeia
2026-05-07 20:14:51 -04:00
parent da160b71e3
commit 924bf8f479
71 changed files with 2976 additions and 3888 deletions
Download Patch File Download Diff File Expand all files Collapse all files

183
lisp/gateway-messaging.lisp
View File

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