Add some more api functions and atom feed integration

3 files changed, 155 insertions, 28 deletions

diff --git a/nullbot.asd b/nullbot.asd
index 033d589..634802d 100644
--- a/nullbot.asd
+++ b/nullbot.asd
@@ -8,7 +8,8 @@
                :cl-hash-util
                :quri
                :flexi-streams
-               :split-sequence)
+               :split-sequence
+               :xmls)
   :components ((:module "src"
                 :components
                 ((:file "api")
diff --git a/src/api.lisp b/src/api.lisp
index fb4cc20..3ed133a 100644
--- a/src/api.lisp
+++ b/src/api.lisp
@@ -1,4 +1,6 @@
-;; 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
@@ -17,10 +19,15 @@
    #: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
@@ -45,11 +52,30 @@
     :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))))
@@ -63,7 +89,7 @@
                                  :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)
@@ -75,7 +101,7 @@
   (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))
@@ -89,8 +115,30 @@
              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
@@ -100,23 +148,23 @@
         (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))))
diff --git a/src/main.lisp b/src/main.lisp
index ee37ddc..d789921 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -4,7 +4,8 @@
   (:local-nicknames
    (:jzon :com.inuoe.jzon)
    (:mapi :nullbot/matrix-api)
-   (:sseq :split-sequence))
+   (:sseq :split-sequence)
+   (:dex :dexador))
   (:export
    #:start))
 (in-package #:nullbot)
@@ -14,6 +15,19 @@
                                    :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
@@ -25,7 +39,9 @@
   (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
@@ -35,3 +51,65 @@
   (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*))