blob: fb4cc20b5f08c329105ac0d13d95b6eeae3ae209 (
plain)
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
|
;; readers beware: this is currently a very barebones library
(defpackage nullbot/matrix-api
(:use #:cl
#:cl-hash-util)
(:local-nicknames
(:jzon :com.inuoe.jzon)
(:fs :flexi-streams))
(:export
#:matrix-user
#:homeserver
#:name
#:listening
#:token
#:lock
#:matrix-bot
#:sendmsg
#:on-event
#:start
#:stop))
(in-package #:nullbot/matrix-api)
(defclass matrix-user ()
((homeserver
:type string
:initarg :homeserver
:initform "matrix.org"
:reader homeserver)
(name
:type string
:initarg :name
:initform "matrix-user"
:reader name)
(listening
:type boolean
:initform nil
:accessor listening)
(token
:type string
:initarg :token
:initform ""
:reader token)
(lock
:type bt2:lock
:initform (bt2:make-lock)
:reader lock)))
(defclass matrix-bot (matrix-user) ()
(:default-initargs :name "matrix-bot"))
(defgeneric request (obj endpoint &rest rest)
(:method ((obj matrix-user) endpoint &rest rest &aux (headers))
(declare (type string endpoint))
(when (>= (length rest) 3) (setf headers (car (last rest))))
(bt2:with-lock-held ((lock obj))
(push `("Authorization" . ,(format nil "Bearer ~a" (token obj))) headers))
(jzon:parse (dexador:request (format nil "https://~a/_matrix/client/v3~a"
(homeserver obj) endpoint)
:headers headers
:method (car rest)
:content (jzon:stringify (cadr rest))
:verbose nil))))
(defgeneric on-event (obj event room-id)
(:method ((obj matrix-user) event room-id)
(format t "Event Received: ~a~%" event)))
(defun randint (start end)
(+ start (random (+ 1 (- end start)))))
(defun rand-string (len &aux (arr (make-array len)))
(loop for i from 0 below len do
(setf (aref arr i) (randint 65 90)))
(fs:octets-to-string arr))
(defgeneric sendmsg (obj room-id content)
(:method ((obj matrix-user) room-id content
&aux
(msg (make-hash-table :test #'equal))
(encoded-room-id (quri:url-encode room-id))
(unique-str (rand-string 20)))
(setf (gethash "msgtype" msg) "m.text")
(setf (gethash "body" msg) content)
(request obj (format nil "/rooms/~a/send/m.room.message/~a"
encoded-room-id
unique-str)
:put
msg
'(("Content-Type" . "application/json")))))
(defgeneric get-events (obj rooms-join room-id)
(:method ((obj matrix-user) rooms-join room-id
&aux
(room-table (gethash room-id rooms-join))
(events
(hash-get room-table '("timeline" "events"))))
(when events
(loop for event across events do
(on-event obj event room-id)))))
(defgeneric start (obj)
(:method-combination progn)
(:method ((obj matrix-user))
(setf (listening obj) t)
(bt2:make-thread (lambda (&aux
(since)
(sync-route "/sync?timeout=30000"))
(loop while (bt2:with-lock-held ((lock obj)) (listening obj)) do
(when since
(setf sync-route (format nil "/sync?timeout=30000&since=~a" since)))
(let* ((response (request obj sync-route :get))
(rooms-join (hash-get response '("rooms" "join"))))
(when rooms-join (loop for room-id being each hash-key of rooms-join
do (when since (get-events obj rooms-join room-id))))
(setf since (gethash "next_batch" response))))
(format t "Shutting down...~%"))
:name (format nil "~a Poll Thread" (name obj)))))
(defgeneric stop (obj)
(:method ((obj matrix-user))
(bt2:with-lock-held ((lock obj)) (setf (listening obj) nil))))
|