Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
- 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
42 lines
2.0 KiB
Common Lisp
42 lines
2.0 KiB
Common Lisp
(in-package :passepartout)
|
|
(defun signal-get-account ()
|
|
(vault-get-secret :signal))
|
|
|
|
(defun signal-poll ()
|
|
"Polls Signal for new messages and injects them into the harness."
|
|
(let ((account (signal-get-account)))
|
|
(when account
|
|
(handler-case
|
|
(let* ((output (uiop:run-program (list "signal-cli" "-u" account "receive" "--json")
|
|
:output :string :error-output :string :ignore-error-status t))
|
|
(lines (cl-ppcre:split "\\\\n" output)))
|
|
(dolist (line lines)
|
|
(when (and line (> (length line) 0))
|
|
(let* ((json (ignore-errors (cl-json:decode-json-from-string line)))
|
|
(envelope (cdr (assoc :envelope json)))
|
|
(source (cdr (assoc :source envelope)))
|
|
(data-message (cdr (assoc :data-message envelope)))
|
|
(text (cdr (assoc :message data-message))))
|
|
(when (and source text)
|
|
(log-message "SIGNAL: Received message from ~a" source)
|
|
(unless (ignore-errors (hitl-handle-message text :signal))
|
|
(stimulus-inject
|
|
(list :type :EVENT
|
|
:meta (list :source :signal :chat-id source)
|
|
:payload (list :sensor :user-input :text text)))))))))
|
|
(error (c) (log-message "SIGNAL POLL ERROR: ~a" c))))))
|
|
|
|
(defun signal-send (action context)
|
|
"Sends a message via Signal."
|
|
(declare (ignore context))
|
|
(let* ((payload (getf action :payload))
|
|
(meta (getf action :meta))
|
|
(chat-id (or (getf meta :chat-id) (getf payload :chat-id) (getf action :chat-id)))
|
|
(text (or (getf payload :text) (getf action :text)))
|
|
(account (signal-get-account)))
|
|
(when (and account chat-id text)
|
|
(handler-case
|
|
(uiop:run-program (list "signal-cli" "-u" account "send" "-m" text chat-id)
|
|
:output :string :error-output :string)
|
|
(error (c) (log-message "SIGNAL ERROR: ~a" c))))))
|