-;; readers beware: this is currently a very barebones library
+;; readers beware: this is currently a very barebones (and amateurish) library
+;;
+;; In the future it might be packaged into its own thing
(defpackage nullbot/matrix-api
(:use #:cl
#:sendmsg
#:on-event
#:start
- #:stop))
+ #:stop
+ #:whoami
+ #:request
+ #:join
+ #:leave
+ #:room-id))
(in-package #:nullbot/matrix-api)
-(defclass matrix-user ()
+(defclass matrix-client ()
((homeserver
:type string
:initarg :homeserver
:initform (bt2:make-lock)
:reader lock)))
-(defclass matrix-bot (matrix-user) ()
+;; these are not perfect functions by any means but matrix has
+;; many different room versions with different formats
+;; this is what the official matrix-bot-sdk does as well
+(defun room-id-p (object)
+ (and (stringp object)
+ (> (length object) 0)
+ (equal (aref object 0) #\!)))
+
+(defun room-alias-p (object)
+ (and (stringp object)
+ (> (length object) 0)
+ (equal (aref object 0) #\#)))
+
+(deftype room-id ()
+ '(and string (satisfies room-id-p)))
+
+(deftype room-alias ()
+ '(and string (satisfies room-alias-p)))
+
+(defclass matrix-bot (matrix-client) ()
(:default-initargs :name "matrix-bot"))
(defgeneric request (obj endpoint &rest rest)
- (:method ((obj matrix-user) endpoint &rest rest &aux (headers))
+ (:method ((obj matrix-client) endpoint &rest rest &aux (headers))
(declare (type string endpoint))
(when (>= (length rest) 3) (setf headers (car (last rest))))
:verbose nil))))
(defgeneric on-event (obj event room-id)
- (:method ((obj matrix-user) event room-id)
+ (:method ((obj matrix-client) event room-id)
(format t "Event Received: ~a~%" event)))
(defun randint (start end)
(fs:octets-to-string arr))
(defgeneric sendmsg (obj room-id content)
- (:method ((obj matrix-user) room-id content
+ (:method ((obj matrix-client) room-id content
&aux
(msg (make-hash-table :test #'equal))
(encoded-room-id (quri:url-encode room-id))
msg
'(("Content-Type" . "application/json")))))
+(defgeneric whoami (obj)
+ (:method ((obj matrix-client))
+ (request obj "/account/whoami" :get)))
+
+(defgeneric directory-room (obj room-alias)
+ (:method ((obj matrix-client) room-alias)
+ (check-type room-alias room-alias)
+ ))
+
+(defgeneric join (obj room)
+ (:method ((obj matrix-client) room)
+ (request obj (format nil "/rooms/~a/join"
+ (quri:url-encode room))
+ :get)))
+
+(defgeneric leave (obj room-id)
+ (:method ((obj matrix-client) room-id)
+ (check-type room-id room-id)
+ (request obj (format nil "/rooms/~a/leave"
+ (quri:url-encode room-id))
+ :post)))
+
(defgeneric get-events (obj rooms-join room-id)
- (:method ((obj matrix-user) rooms-join room-id
+ (:method ((obj matrix-client) rooms-join room-id
&aux
(room-table (gethash room-id rooms-join))
(events
(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)))))
+ (:method ((obj matrix-client))
+ (unless (listening obj)
+ (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))
+ (:method ((obj matrix-client))
(bt2:with-lock-held ((lock obj)) (setf (listening obj) nil))))
(:local-nicknames
(:jzon :com.inuoe.jzon)
(:mapi :nullbot/matrix-api)
- (:sseq :split-sequence))
+ (:sseq :split-sequence)
+ (:dex :dexador))
(:export
#:start))
(in-package #:nullbot)
:token (uiop:getenv "NULLBOT_TOKEN")
:homeserver "matrix.nullring.xyz"))
+(defparameter +feed-url+ "https://list.nullring.xyz/discussion/new.atom")
+(defparameter +feed-room-id+ "!ShuXi5ohrPUtKHkrNO:matrix.nullring.xyz")
+(defparameter +feed-cache-path+ #P"./nullbot_cache.sexp")
+(defparameter +feed-sleep-minutes+ 1)
+
+(defparameter +prefix+ "$")
+
+(defun get-temp
+ (&aux
+ (endpoint "https://api.weather.gc.ca/collections/swob-realtime/items?f=json&lang=en&url=CYVR&sortby=-date_tm-value&limit=1&properties=date_tm-value,air_temp,air_temp-uom,air_temp-qa")
+ (data (jzon:parse (dex:get endpoint))))
+ (hash-get (aref (gethash "features" data) 0) '("properties" "air_temp")))
+
(defun process-roommsg
(content room-id sender
&aux
(when (and (> (length body) 0) (equal (aref (car split-body) 0) #\$))
(cond
((string= command "$help")
- (mapi:sendmsg *bot* room-id "Unlike some other bots, I'm nice :3")))))
+ (mapi:sendmsg *bot* room-id "Unlike some other bots, I'm nice :3"))
+ ((string= command "$weather")
+ (mapi:sendmsg *bot* room-id (format nil "It's ~a degrees in Vancouver" (get-temp)))))))
(defmethod mapi:on-event
((obj nullbot) event room-id
(cond
((string= msgtype "m.room.message")
(process-roommsg (gethash "content" event) room-id sender))))
+
+(defun node-val (obj)
+ (car (xmls:node-children obj)))
+
+(defun node-attr (obj name)
+ (second (assoc name (xmls:node-attrs obj) :test #'string=)))
+
+;; TODO: make this into a generic f-n maybe and also make it not dumb
+(defun get-node-by-name (obj name)
+ (check-type obj xmls:node)
+ (check-type name string)
+ (loop for child in (xmls:node-children obj)
+ when (and (xmls:node-p child) (string= name (xmls:node-name child)))
+ return child))
+
+(defun send-entry (entry)
+ (mapi:sendmsg
+ *bot*
+ +feed-room-id+
+ (format nil "New message on mailing list!~%Title: ~a~%From: ~a~%Link: ~a~%"
+ (getf entry :title)
+ (getf entry :author)
+ (getf entry :link))))
+
+(defun write-entries (entries)
+ (with-open-file (str +feed-cache-path+
+ :direction :output
+ :if-does-not-exist :create
+ :if-exists :supersede)
+ (format str "~s" entries)))
+
+(defun feed-thread ()
+ (loop while (bt2:with-lock-held ((mapi:lock *bot*)) (mapi:listening *bot*)) do
+ (format t "Doing another poll~%")
+ (let* ((feed-str (dex:get +feed-url+))
+ (xmlobj (xmls:parse feed-str))
+ (entries (loop for entry in (xmls:node-children xmlobj)
+ when (string= (xmls:node-name entry) "entry")
+ collect `(:id ,(node-val (get-node-by-name entry "id"))
+ :title ,(node-val (get-node-by-name entry "title"))
+ :author ,(node-val (node-val (get-node-by-name entry "author")))
+ :link ,(node-attr (get-node-by-name entry "link") "href"))))
+ (cached-entries))
+
+ (if (uiop:file-exists-p +feed-cache-path+)
+ (setf cached-entries (read-from-string (uiop:read-file-string +feed-cache-path+)))
+ (write-entries entries))
+
+ (when cached-entries
+ (loop for entry in entries
+ when (not (find (getf entry :id)
+ cached-entries
+ :test #'string=
+ :key (lambda (e) (getf e :id))))
+ do (send-entry entry)))
+ ;; update the cache with the new entries
+ (write-entries entries))
+ (sleep (* 60 +feed-sleep-minutes+))))
+
+(defun start ()
+ (bt2:make-thread #'feed-thread :name "nullbot polling thread")
+ (mapi:start *bot*))
projects / nullerbot.git / commitdiff