| 62e9d7d6 |
(defpackage :hhgbot-fukaws
(:use :cl :alexandria :serapeum))
(in-package :hhgbot-fukaws)
(eval-when (:compile-toplevel :load-toplevel :execute)
(ubiquitous:restore 'hhgbot)
(require 'sb-concurrency))
(defvar *client*)
(defclass slack-client ()
((self :reader self :initarg :self)
(url :reader url :initarg :url)
(users :accessor users :initarg :users :initform (make-hash-table :test 'equal))
(slack-info :reader slack-info :initarg :slack-info)
(work-mailbox :reader work-mailbox :initform (sb-concurrency:make-mailbox :name "work"))
(name :reader name)
(waiting-pings :accessor waiting-pings :initform 0)
(latest-id :accessor latest-id :initform 0)
(ws-client :reader ws-client :initarg :ws-client)))
(defmethod initialize-instance :after ((client slack-client) &rest r)
(declare (ignore r))
(let ((self (self client)))
(setf (slot-value client 'name)
(gethash "name" self))))
(defclass user ()
((id :reader id :initarg :id)
(name :reader name :initarg :name)
(presence :accessor presence :initarg :presence)
(deleted :reader deleted :initarg :deleted)
(color :reader color :initarg :color)
(profile :reader profile :initarg :profile)
(is_admin :reader is_admin :initarg :is_admin)
(is_owner :reader is_owner :initarg :is_owner)
(is_primary_owner :reader is_primary_owner :initarg :is_primary_owner)
(is_restricted :reader is_restricted :initarg :is_restricted)
(is_ultra_restricted :reader is_ultra_restricted :initarg :is_ultra_restricted)
(has_2fa :reader has_2fa :initarg :has_2fa)
(two_factor_type :reader two_factor_type :initarg :two_factor_type)
(has_files :reader has_files :initarg :has_files)))
(defmethod print-object ((o user) s)
(print-unreadable-object (o s :type t :identity t)
(format s "~a: ~a" (id o) (name o))))
(defmacro define-constructor (name (class &rest args))
`(defun ,name (source-hash-table)
(make-instance ',class
,@(mapcan (lambda (arg) (list (make-keyword arg)
`(gethash ,(symbol-name arg)
source-hash-table)))
args))))
(define-constructor make-user (user id name deleted color profile is_admin is_owner is_primary_owner is_restricted is_ultra_restricted has_2fa two_factor_type has_files presence))
(defparameter *api-token*
|
| 62e9d7d6 |
(defgeneric send-message (client type &optional data))
(defgeneric handle-message (type message)
(:documentation "Handle a websocket message")
(:method (_type message)
(format t "~& Ok? ~s "(gethash "ok" message))
(when (eq 'yason:false (gethash "ok" message))
(format t "~&Problem: ~s~%" (hash-table-alist (gethash "error" message))))
(format t "Received a packet of type: ~a~%with data: ~s~%" _type
(hash-table-alist message))))
(defgeneric handle-mention (client event-data id channel message mentioned-pos)
(:method (client event-data id channel message mentioned-pos)))
(defgeneric bot-command (command &rest args)
(:method (c &rest r)
(format t "Received command ~a with args ~s" c r)))
(defun make-attachment (title pretext text)
(alist-hash-table
`(("title" . ,title)
("pretext" . ,pretext)
("text" . ,text))
:test 'equal))
(defun build-message (id channel text &rest attachments)
(alist-hash-table
`(("id" . ,id)
("type" . "message")
("channel" . ,channel)
("text" . ,text)
,@(when attachments
(cons "attachments"
(list attachments))))
:test 'equal))
(let ((id 0))
(defun make-message (data channel)
(incf id)
(with-output-to-string (s)
(yason:encode
(alist-hash-table
`(("id" . ,id)
("type" . "message")
("channel" . ,channel)
("text" . ,data)))
s))))
(defmethod send-message :around ((client slack-client) _type &optional data)
(declare (ignorable client _type data))
(wsd:send (ws-client client)
(with-output-to-string (s)
(yason:encode
(call-next-method)
s))))
(defmethod send-message ((client slack-client) (type (eql :ping)) &optional data)
(let* ((id (incf (latest-id client)))
(message `(("id" . ,id)
("type" . "ping"))))
(when data
(push (cons "data" data)
message))
(incf (waiting-pings client))
(alist-hash-table message
:test 'equal)))
(defun pick (keys h-t)
(mapcar (plambda:plambda (gethash :1 h-t))
keys))
(defun quote-output (str)
(with-output-to-string (s)
(format s "```~%~a```~%" str)))
(defvar *memory* '())
(defvar *feeds* '("https://thejosias.com/feed"
"https://sancrucensis.wordpress.com/feed"
"https://thomism.wordpress.com/feed"))
(defvar *books* (ubiquitous:defaulted-value '() :lists :books))
(defclass list-manager ()
())
(defgeneric add-to-list (list-name item))
(defmethod add-to-list ((list-name (eql :books)) item)
(push item
(ubiquitous:value :lists :books)))
(defmethod get-list ((list-name (eql :books)))
(ubiquitous:value :lists :books))
(defun get-random-article ()
(let* ((feed-url (elt *feeds*
(funcall (compose #'random #'length)
*feeds*)))
(feed (alimenta.pull-feed:pull-feed feed-url)))
(alimenta::get-random-item feed)))
(defmacro if-let* ((&rest bindings) &body (then-form &optional else-form))
"Like if-let, but sets bindings sequentially. Doesn't short-circuit."
`(let* ,bindings
(if (and ,@(mapcar #'car bindings))
,then-form
,else-form)))
(defmethod handle-mention ((client slack-client) (event-data hash-table) (id string) (channel string) (message string) (mentioned-pos (eql 0)))
(declare (optimize (debug 3)))
(if-let ((message (if (starts-with #\D) (cdr (tokens message)))))
(let* ((the-user (gethash (gethash "user" event-data)
(users client)))
(msg-text (string-case:string-case ((car message) :default "Not Recognized")
("users"
(if (is_admin the-user)
(quote-output
(with-output-to-string (s)
(format-users client s)))
"Can't help you"))
("josias"
(in-eventloop (cl)
(let* ((feed (alimenta.pull-feed:pull-feed "http://thejosias.com/feed"))
(item (alimenta::get-random-item feed)))
(wsd:send (ws-client cl)
(make-message (format nil "~a ( ~a )"
(alimenta:title item)
(alimenta:link item))
channel)))))
("recommend"
(string-case:string-case ((cadr message)
:default (format nil
"I don't know about ~a~p"
(cadr message)
2))
("book"
(wsd:send (ws-client client)
(make-message
(if-let* ((title (string-join (cddr message) #\space))
(message (format nil "I'll remember ~a" title)))
(prog1 message
(add-to-list :books title))
"No book suggested???")
channel)))
("feed" (let ((feed (caddr message)))
(push (subseq feed
1
(1- (length feed)))
*feeds*)))))
("suggest"
(string-case:string-case ((cadr message) :default (format nil "I don't know about ~a~p"
(cadr message) 2))
("book" (let ((*books* (get-list :books)))
(wsd:send (ws-client client)
(make-message (elt *books*
(random (length *books*)))
channel))))
("article" (in-eventloop (cl)
(let ((item (get-random-article)))
(wsd:send (ws-client cl)
(make-message (format nil "~a ( ~a )"
(alimenta:title item)
(alimenta:link item))
channel)))))))
("list"
(string-case:string-case ((cadr message) :default "No such list")
("feeds"
(wsd:send (ws-client *client*)
(make-message (format nil "```~%~{~a~^~%~}~%```"
*feeds*)
channel)))
("books"
(let ((*books* (ubiquitous:value :lists :books)))
(wsd:send (ws-client *client*)
(make-message (format nil "```~%~{~a~^~%~}~%```"
*books*)
channel))))))
("remember"
(wsd:send (ws-client client)
(make-message (car (push (string-join (cdr message)
#\space)
*memory*))
channel)))
("recall"
(let ((mem-length (length *memory*)))
(wsd:send (ws-client client)
(make-message (elt *memory*
(random mem-length))
channel)))))))
(wsd:send (ws-client client)
(make-message msg-text channel)))))
(defmethod handle-message ((type (eql :pong)) data)
(with-accessors ((waiting-pings waiting-pings)) *client*
(decf waiting-pings)
(when (> waiting-pings 0)
(format t "Something wrong? ~a waiting pings" waiting-pings)
(when (> waiting-pings 5)
(setf waiting-pings 0)))))
(defmethod handle-message ((type (eql :error)) data)
(format t "~&~s~%" (hash-table-alist (gethash "error" data))))
(defmethod handle-message ((type (eql :message)) data)
(format t "~&~s~%" (hash-table-alist data))
(let* ((message (gethash "text" data))
(id (gethash "id" (self *client*)))
(name (name *client*))
(channel (gethash "channel" data))
(mentioned (or (search (format nil "<@~a>" id)
message)
(search (format nil "~a " name) message)
(search id message))))
(format t "~&Received a message with text: ~a~&"
message)
(format t "~&My id is: ~a~%"
id)
(format t "~&The message mentions me? ~a~%"
mentioned)
(when mentioned
(handle-mention *client* data id channel message mentioned))))
(defmethod handle-message ((type (eql :presence_change)) data)
(let ((id (gethash "user" data))
(presence (gethash "presence" data)))
(when-let* ((user (gethash id (users *client*)))
(old-presence (presence user))
(user-name (name user)))
(setf (presence user)
presence)
(format t "~&Presence change: ~a is now ~a (~a -> ~a)~%"
user-name
presence
old-presence
(presence user)))))
(defmethod handle-message ((type (eql :team_join)) data)
(let ((user (gethash "user" data)))
(when user
(setf (gethash (gethash "id" user)
(users *client*))
(make-user user))
(format t "~&Added user: ~a~%" (gethash "id" user)))))
(defun get-ws-url (slack-response)
(gethash "url" slack-response))
(defun make-client ()
(fw.lu:let-each (:be slack-data)
(format nil "https://slack.com/api/rtm.start?token=~a" *api-token*)
(drakma:http-request slack-data :want-stream t)
(yason:parse slack-data)
(let* ((url (get-ws-url slack-data))
(self (gethash "self" slack-data))
(users (gethash "users" slack-data))
(client (wsd:make-client url)))
(wsd:on :message client
(lambda (message)
(let* ((message (yason:parse message
:object-as :hash-table
:json-booleans-as-symbols t))
(type (funcall (compose #'make-keyword #'string-upcase)
(gethash "type" message "DEFAULT-TYPE"))))
(handle-message type message))))
(make-instance 'slack-client
:self self
:url url
:slack-info slack-data
:ws-client client
:users (alist-hash-table
(loop for user in users
collect (cons (gethash "id" user)
(make-user (copy-hash-table user :test 'equalp))))
:test 'equal)))))
(defun start-heartbeat (client &optional (interval 5))
(bordeaux-threads:make-thread
(lambda ()
(let ((*client* client))
(loop
(in-eventloop (*client*)
(send-message *client* :ping))
(sleep interval))))
:name "Heartbeat"))
(defun start-client ()
(let ((slack-client (make-client)))
(values
slack-client
(bordeaux-threads:make-thread
(lambda ()
(let ((*client* slack-client))
(as:with-event-loop ()
(websocket-driver.ws.base:start-connection (ws-client slack-client))
(format t "... after start-connection ...")
(as:idle
(lambda ()
(multiple-value-bind (message message-p) (sb-concurrency:receive-message-no-hang (work-mailbox *client*))
(when message-p
(format t "~&got message~&")
(funcall message *client*))))))))
:name "Server"))))
(defun call-in-eventloop (client cb)
(sb-concurrency:send-message (work-mailbox client)
cb))
(defmacro in-eventloop ((client) &body body)
`(call-in-eventloop *client*
(lambda (,client)
(declare (ignorable ,client))
,@body)))
(defun format-users (client &optional (stream t))
(format stream "~&~:{~a: ~{~19<~a~>~^ ~}~%~}"
(stable-sort
(sort
(loop for id being the hash-keys of (users client) using (hash-value user)
collect (list id (list (name user) (presence user))))
#'string-lessp
:key #'caadr)
#'string-lessp
:key #'cadadr)))
|