diff options
| -rw-r--r-- | examples/shell-echo-bot.lisp | 4 | ||||
| -rw-r--r-- | granolin.lisp | 20 | ||||
| -rw-r--r-- | package.lisp | 2 | ||||
| -rw-r--r-- | utility-apps.lisp | 78 |
4 files changed, 91 insertions, 13 deletions
diff --git a/examples/shell-echo-bot.lisp b/examples/shell-echo-bot.lisp index 6cd9f1b..a73a174 100644 --- a/examples/shell-echo-bot.lisp +++ b/examples/shell-echo-bot.lisp @@ -11,7 +11,7 @@ ;; a script to login if necessary, and then start the bot -(unless (access-token *bot*) +(unless (granolin:logged-in-p *bot*) (princ "Log in to the server:") (terpri) (granolin:login *bot* @@ -19,4 +19,4 @@ (and (princ "password: ") (read-line)))) -(start *bot*) +(granolin:start *bot*) diff --git a/granolin.lisp b/granolin.lisp index 5c9e144..fa2935b 100644 --- a/granolin.lisp +++ b/granolin.lisp @@ -13,7 +13,6 @@ (base64:string-to-base64-string (format nil "~r, ~r bats ha hah hahhh" id-source id-source)))) - ;;; The main matrix client class (defclass client (id-source) @@ -24,6 +23,7 @@ :type string) (hardcopy :accessor hardcopy + :initarg :hardcopy :initform nil :type pathname :documentation "A file path where client state is saved.") @@ -50,12 +50,15 @@ INITIALIZE-INSTANCE :after auxilliary method will attempt to populate the following slots from a file: HOMESERVER, TIMEOUT, ACCESS-TOKEN, NEXT-BATCH.")) -(defun save-client-state (client &key (fname "granolin.conf")) +(defun logged-in-p (client) + (and (access-token client) t)) + +(defun save-client-state (client &key fname) "Save a PLIST of client state to disk. Saves HOMESERVER, TIMEOUT, ACCESS-TOKEN, and NEXT-BATCH values to the file." - (when (hardcopy client) - (setf fname hardcopy)) + (when (and (not fname) (hardcopy client)) + (setf fname (hardcopy client))) (with-open-file (out fname :direction :output) (print (list :homeserver (homeserver client) @@ -64,14 +67,13 @@ :next-batch (next-batch client)) out))) -(defun load-client-state (client &optional (fname "granolin.conf")) +(defun load-client-state (client &optional fname) "Load client state from a PLIST stored in a file." - (when (hardcopy client) - (setf fname hardcopy)) + (when (and (not fname) (hardcopy client)) + (setf fname (hardcopy client))) (let ((conf (with-open-file (in fname) (read in)))) - (setf (homeserver client) (getf conf :homeserver)) (setf (timeout client) (getf conf :timeout)) (setf (access-token client) (getf conf :access-token)) (setf (next-batch client) (getf conf :next-batch))) @@ -162,6 +164,8 @@ (event-type :|type|) (event-id :|event_id|) (state-key :|state_key|) + (room-name :|content| :|name|) ; only valid on m.room.name + (room-aliases :|content| :|aliases|) ; only valid on m.room.aliases (prev-content :|prev_content|)) (def-json-wrap invitation-event diff --git a/package.lisp b/package.lisp index aa68439..72c661a 100644 --- a/package.lisp +++ b/package.lisp @@ -7,6 +7,7 @@ #:txn-id #:client #:homeserver + #:logged-in-p #:handle-event #:getob @@ -31,4 +32,5 @@ #:start #:stop + )) diff --git a/utility-apps.lisp b/utility-apps.lisp index 0fdd3fb..7f649eb 100644 --- a/utility-apps.lisp +++ b/utility-apps.lisp @@ -1,5 +1,9 @@ +;;;; Common utilities to help in building bots + (in-package :granolin) +;;; Logging Bot + (defclass message-log () ((output :accessor output @@ -14,19 +18,87 @@ :do (format stream "~a: ~a~%" k v))) (defmethod handle-event :after ((log message-log) room (event timeline-event)) - (let ((fields `(("sender" . ,(sender event)) + (let ((fields `(("room" . ,room) + ("sender" . ,(sender event)) ("event type" . ,(event-type event)) ("message type" . ,(msg-type event)) - ("messge body" . ,(msg-body event))))) + ("messge body" . ,(msg-body event)) + ("content" . ,(event-content event)))))m (print-assoc fields (output log)) (terpri (output log)))) (defmethod handle-event :after ((log message-log) room (event room-state-event)) - (let ((fields `(("sender" . ,(sender event)) + (let ((fields `(("room" . ,room) + ("sender" . ,(sender event)) ("event type" . ,(event-type event)) ("state key" . ,(state-key event)) ("content" . ,(event-content event))))) (print-assoc fields (output log)) (terpri (output log)))) + + +;;; A Room and User Directory Bot + +(defstruct (server-room (:conc-name room-)) + (id "") + (name "") + (aliases nil) + (members nil)) + +(defclass server-directory () + ((directory-table + :reader directory-table + :initform (make-hash-table :test 'equal) + :documentation "A table mapping room IDs to room struct instances."))) + +(defun update-room-name (client room-id name) + (let ((room (gethash room-id (directory-table client)))) + (if room + (setf (room-name room) name) + (setf room (make-server-room :id room-id :name name))) + (setf (gethash room-id (directory-table client)) room))) + +(defun update-room-member (client room-id member) + (let ((room (gethash room-id (directory-table client)))) + (if room + (pushnew member (room-members room) :test #'equal) + (setf room (make-server-room :id room-id :members (list member)))) + (setf (gethash room-id (directory-table client)) room))) + +;; TODO +(defun update-room-aliases (client room-id member) + (declare (ignore client room-id member))) + +(defmethod handle-event :after ((client server-directory) room (event room-state-event)) + (cond + ((string= "m.room.name" (event-type event)) + (update-room-name client room (room-name event))) + + ((string= "m.room.member" (event-type event)) + (update-room-member client room (sender event))) + + ((string= "m.room.aliases" (event-type event)) + (update-room-aliases client room (room-aliases event))))) + +(defun get-room (client room-id) + "Get the SERVER-ROOM struct keyed by ROOM-ID, or return NIL." + (gethash room-id (directory-table client))) + +(defun name-of-room (client room-id) + "Looks up the name of a room with ROOM-ID. Returns a string of NIL" + (let ((room (get-room client room-id))) + (when room (room-name room)))) + +(defun find-rooms-named (client name &key like full) + "Looks up the room ID of rooms with the name NAME. If LIKE is T, then any room + whose name contains the NAME as a substring is returned. If FULL is T, then + the SERVER-ROOM structs themselves are returned." + (with-slots (directory-table) client + (loop :for room-id :being :the :hash-keys :of directory-table + :for room :being :the :hash-values :of directory-table + :when (or (string-equal name (room-name room)) + (and like (search name (room-name room) :test #'string-equal))) + :collect (if full room room-id)))) + |