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

FEAT: Implement Telegram Gateway and Channel-Aware Chat

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-11 15:34:51 -04:00
parent b2acd9c702
commit 8ba3532067
13 changed files with 381 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
src/chat-logic.lisp
View File

@@ -1,3 +1,5 @@
(in-package :org-agent)
(defun trigger-skill-chat (context)
(let* ((payload (getf context :payload))
(sensor (getf payload :sensor)))
@@ -11,28 +13,44 @@
(or (and (member (getf proposed-action :type) '(:request :REQUEST))
(or (and (member target '(:emacs :EMACS))
(member action '(:insert-at-end :INSERT-AT-END)))
(and (member target '(:telegram :TELEGRAM))
(or (getf payload :chat-id) (getf proposed-action :chat-id)))
(and (member target '(:shell :SHELL))
(or (getf payload :cmd) (getf proposed-action :cmd)))
(member target '(:tool :TOOL))))
(member (getf proposed-action :type) '(:response :RESPONSE :log :LOG))))
proposed-action
(let ((err-text (format nil "\n\n*System Error:* Chat agent returned invalid action: ~s" proposed-action)))
(let ((err-text (format nil "
*System Error:* Chat agent returned invalid action: ~s" proposed-action)))
`(:type :request :target :emacs :payload (:action :insert-at-end :buffer "*org-agent-chat*" :text ,err-text))))))
(defun neuro-skill-chat (context)
"Generates a conversational response, stripping system errors from context."
(let* ((payload (getf context :payload))
(raw-text (getf payload :text))
(channel (or (getf payload :channel) :emacs))
(chat-id (getf payload :chat-id))
;; Context Purge: Remove system errors and hallucinations from the history
(clean-text (cl-ppcre:regex-replace-all "(?i)Unknown request|System Error.*|Thinking\\.\\.\\." raw-text ""))
(trimmed-text (if (> (length clean-text) 1000)
(subseq clean-text (- (length clean-text) 1000))
clean-text)))
(ask-neuro trimmed-text :system-prompt "ACTUATOR IDENTITY: You are the pure Lisp actuator for the org-agent kernel.
clean-text))
(reply-instruction
(case channel
(:telegram (format nil "- To reply via Telegram: (:type :REQUEST :target :telegram :chat-id \"~a\" :text \"<Response>\")" chat-id))
(t "- To reply via Emacs: (:type :REQUEST :target :emacs :action :insert-at-end :buffer \"*org-agent-chat*\" :text \"* <Response>\")"))))
(ask-neuro trimmed-text :system-prompt (concatenate 'string
"ACTUATOR IDENTITY: You are the pure Lisp actuator for the org-agent kernel.
MANDATE: Output EXACTLY ONE Common Lisp property list starting with (:type :REQUEST).
ZERO CONVERSATION: Do not explain. Do not use markdown.
STRICT RULE: Never output the strings 'Unknown request' or 'System Error'.
REQUIRED FORMATS:
- To reply: (:type :REQUEST :target :emacs :action :insert-at-end :buffer \"*org-agent-chat*\" :text \"* <Response>\")
- To use a tool: (:type :REQUEST :target :tool :action :call :tool \"<name>\" :args (...))")))
" reply-instruction "
- To use a tool: (:type :REQUEST :target :tool :action :call :tool \"<name>\" :args (...))"))))
(defskill :skill-chat
:priority 100
:trigger #'trigger-skill-chat
:neuro #'neuro-skill-chat
:symbolic #'verify-skill-chat)

6
src/core.lisp
View File

@@ -8,12 +8,6 @@
(defvar *skill-telemetry* (make-hash-table :test 'equal))
(defvar *telemetry-lock* (bt:make-lock "kernel-telemetry-lock"))
(defvar *actuator-registry* (make-hash-table :test 'equal))
(defun register-actuator (name fn)
"Registers an actuator function. Actuators receive two arguments: (ACTION CONTEXT)."
(setf (gethash name *actuator-registry*) fn))
(defun dispatch-action (action context)
"Routes an approved action to its registered physical actuator."
(when (and action (listp action))

1
src/credentials-vault.lisp
View File

@@ -22,6 +22,7 @@
(:anthropic "ANTHROPIC_API_KEY")
(:groq "GROQ_API_KEY")
(:openrouter "OPENROUTER_API_KEY")
(:telegram "TELEGRAM_BOT_TOKEN")
(t nil))))
(when (and env-var (eq type :api-key))
(uiop:getenv env-var))))))

81
src/gateway-telegram.lisp Normal file
View File

@@ -0,0 +1,81 @@
(in-package :org-agent)
(defvar *telegram-last-update-id* 0)
(defvar *telegram-polling-thread* nil)
(defvar *telegram-authorized-chats* nil
"List of chat IDs allowed to interact with the bot. Hydrated from environment.")
(defun get-telegram-token () (vault-get-secret :telegram))
(defun execute-telegram-action (action context)
"Sends a message back to Telegram."
(declare (ignore context))
(let* ((payload (getf action :payload))
(chat-id (or (getf payload :chat-id) (getf action :chat-id)))
(text (or (getf payload :text) (getf action :text)))
(token (get-telegram-token))
(url (format nil "https://api.telegram.org/bot~a/sendMessage" token)))
(when (and token chat-id text)
(kernel-log "TELEGRAM: Sending message to ~a..." chat-id)
(handler-case
(dex:post url
:headers '(("Content-Type" . "application/json"))
:content (cl-json:encode-json-to-string
`((chat_id . ,chat-id) (text . ,text))))
(error (c) (kernel-log "TELEGRAM ERROR: ~a" c))))))
(defun telegram-process-updates ()
"Polls for new messages and injects them into the kernel."
(let* ((token (get-telegram-token))
(url (format nil "https://api.telegram.org/bot~a/getUpdates?offset=~a"
token (1+ *telegram-last-update-id*))))
(when token
(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 *telegram-last-update-id* update-id)
(when (and text chat-id)
(kernel-log "TELEGRAM: Received message from ~a" chat-id)
(inject-stimulus
(list :type :EVENT
:payload (list :sensor :chat-message
:channel :telegram
:chat-id (format nil "~a" chat-id)
:text text)))))))
(error (c) (kernel-log "TELEGRAM POLL ERROR: ~a" c))))))
(defun start-telegram-gateway ()
"Initializes the Telegram background thread."
(unless (and *telegram-polling-thread* (bt:thread-alive-p *telegram-polling-thread*))
(setf *telegram-polling-thread*
(bt:make-thread
(lambda ()
(loop
(telegram-process-updates)
(sleep 3)))
:name "org-agent-telegram-gateway"))
(kernel-log "TELEGRAM: Gateway polling active.")))
(defun stop-telegram-gateway ()
(when (and *telegram-polling-thread* (bt:thread-alive-p *telegram-polling-thread*))
(bt:destroy-thread *telegram-polling-thread*)
(setf *telegram-polling-thread* nil)))
(progn
(register-actuator :telegram #'execute-telegram-action)
(defskill :skill-gateway-telegram
:priority 150
:trigger (lambda (ctx) (declare (ignore ctx)) nil) ;; Passive, handles its own loop
:neuro nil
:symbolic (lambda (action ctx) (declare (ignore ctx)) action))
;; Initialize the background polling loop
(start-telegram-gateway))

7
src/protocol.lisp
View File

@@ -1,5 +1,12 @@
(in-package :org-agent)
(defvar *actuator-registry* (make-hash-table :test 'equal)
"Global registry mapping target keywords to their physical actuator functions.")
(defun register-actuator (name fn)
"Registers an actuator function. Actuators receive two arguments: (ACTION CONTEXT)."
(setf (gethash name *actuator-registry*) fn))
(defun frame-message (msg-string)
"Prefix MSG-STRING with a 6-character hex length (lowercase).
FUTURE: Will also prefix a 64-char HMAC signature when OACP_ENFORCE_HMAC=true."