1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
;;;; Common utilities to help in building bots
(in-package :granolin)
;;; Logging Bot
(defclass message-log ()
((output
:accessor output
:initarg :output
:initform (error "Message Log requires an output stream")
:type stream
:documentation "An output stream to which messages are logged."
)))
(defun print-assoc (alist &optional (stream t))
(loop :for (k . v) :in alist
:do (format stream "~a: ~a~%" k v)))
(defmethod handle-event :after ((log message-log) room (event timeline-event))
(print "Joined Room Message/Timeline Event" (output log))
(let ((fields `(("room" . ,room)
("sender" . ,(sender event))
("event type" . ,(event-type event))
("message type" . ,(msg-type event))
("messge body" . ,(msg-body event))
("content" . ,(event-content event)))))
(print-assoc fields (output log))
(terpri (output log))))
(defmethod handle-event :after ((log message-log) room (event room-state-event))
(print "Joined Room State Event" (output log))
(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))))
(defmethod handle-event :after ((log message-log) room (event invitation-event))
(print "Invitation Event" (output log))
(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
(defclass server-room ()
((id :accessor room-id :initarg :id :initform (error "Must have a room-id"))
(name :accessor room-name :initarg :name :initform "")
(aliases :accessor room-aliases :initarg :aliases :initform nil)
(members :accessor room-members :initarg :members :initform 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 get-room (client room-id)
"Get the SERVER-ROOM struct keyed by ROOM-ID, or return NIL."
(gethash room-id (directory-table client)))
(defun update-room-name (client room-id name)
(let ((room (get-room client room-id)))
(if room
(setf (room-name room) name)
(setf room (make-instance '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 (get-room client room-id)))
(if room
(pushnew member (room-members room) :test #'equal)
(setf room (make-instance '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-id (event room-state-event))
(cond
((string= "m.room.name" (event-type event))
(update-room-name client room-id (room-name event)))
((string= "m.room.member" (event-type event))
(update-room-member client room-id (sender event)))
((string= "m.room.aliases" (event-type event))
(update-room-aliases client room-id (room-aliases event)))))
(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 :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 room)))))
;;; Basic Joiner Bot
(defclass auto-joiner () ())
(defmethod handle-event :after ((client auto-joiner) room-id (event invitation-event))
(when (equal "invite"
(getf (event-content event) :|join_rule|))
(join-room client room-id)))
(defparameter +join-room-path+ "/_matrix/client/r0/rooms/~a/join")
(defun join-room (client room-id)
(let ((body (list :|roomId| room-id))
(url (format nil +join-room-path+ room-id)))
(send (client url body :method :post :wrap make-basic-json)
(format *standard-output* "JOINED ROOM ~a" room-id)
(format *error-output* "JOIN ROOM FAILED ~a" room-id))))
|
