129 lines
4.3 KiB
Common Lisp
129 lines
4.3 KiB
Common Lisp
(in-package :cl-user)
|
|
(defpackage :birthday-boy
|
|
(:use :cl)
|
|
(:export main*))
|
|
(in-package :birthday-boy)
|
|
|
|
(load (sb-ext:posix-getenv "ASDF"))
|
|
(asdf:load-systems :dexador :local-time :jonathan :cl-yaml)
|
|
|
|
(defvar *birthdays* nil
|
|
"Hashtable of birthdays.")
|
|
(defvar *config* nil
|
|
"Hashtable of needed configuration for the bot.")
|
|
|
|
(defun now-string ()
|
|
(local-time:format-timestring
|
|
nil
|
|
(local-time:now)
|
|
:format
|
|
local-time:+iso-8601-format+)) ;; 2008-03-01T19:42:34.608506+01:00
|
|
|
|
(defvar *txn-counter* 0)
|
|
(defun make-txn-id ()
|
|
(format nil "~A~A" (now-string) (incf *txn-counter*)))
|
|
|
|
(defun make-json-request (method uri json-content &key auth)
|
|
"Generic HTTP request function using dex:request with JSON content"
|
|
(let ((headers (if auth
|
|
`((:|Authorization| . ,(format nil "Bearer ~A" (gethash "bot_access_token" *config*)))
|
|
(:content-type . "application/json"))
|
|
'((:content-type . "application/json")))))
|
|
(dex:request uri
|
|
:method method
|
|
:headers headers
|
|
:content (jojo:to-json json-content))))
|
|
|
|
;; Replace your existing functions with these:
|
|
(defun put-json-content (uri json-content)
|
|
(make-json-request 'put uri json-content))
|
|
|
|
(defun put-json-content-auth (uri json-content)
|
|
(make-json-request 'put uri json-content :auth t))
|
|
|
|
(defun post-json-content (uri json-content)
|
|
(make-json-request 'post uri json-content))
|
|
|
|
(defun post-json-content-auth (uri json-content)
|
|
(make-json-request 'post uri json-content :auth t))
|
|
|
|
|
|
(defun make-homeserver-endpoint (endpoint)
|
|
(format nil "~a~a" (gethash "homeserver_url" *config*) endpoint))
|
|
|
|
(defun get-access-token ()
|
|
(let ((res
|
|
(jojo:parse
|
|
(post-json-content (make-homeserver-endpoint "/_matrix/client/v3/login" )
|
|
(list :|identifier| (list :|type| "m.id.user" :|user| (gethash "bot_name" *config*))
|
|
:|type| "m.login.password"
|
|
:|password| (gethash "bot_pw" *config*))))))
|
|
(values
|
|
(getf res :|access_token|)
|
|
(getf res :|device_id|))))
|
|
|
|
(defun message (msg &optional (room-id "GENERAL2_ROOM_ID"))
|
|
(put-json-content-auth
|
|
(make-homeserver-endpoint (format nil "/_matrix/client/v3/rooms/~a/send/m.room.message/~a"
|
|
(gethash room-id *config*)
|
|
(make-txn-id)))
|
|
(list
|
|
:|msgtype| "m.text"
|
|
:|body| msg)))
|
|
|
|
|
|
|
|
|
|
|
|
(defun is-today (tstamp)
|
|
"Check just the day and month of today and tstamp and return true if its today"
|
|
(let ((today (local-time:now)))
|
|
(if (and (eql (local-time:timestamp-day today)
|
|
(local-time:timestamp-day tstamp))
|
|
(eql (local-time:timestamp-month today)
|
|
(local-time:timestamp-month tstamp)))
|
|
t
|
|
nil)))
|
|
|
|
(defun is-today* (day month)
|
|
(is-today (local-time:encode-timestamp 0 0 0 0 day month 1900)))
|
|
|
|
(defun collect-bdays ()
|
|
(loop for person in *birthdays*
|
|
when (is-today* (gethash "day" person) (gethash "month" person))
|
|
collect person))
|
|
|
|
|
|
(defun make-bday-message (person)
|
|
(format nil "Hey hey hey, its the birthday boy, and I am pleased to announce that it is ~A's today. Congratulation, I love you." person))
|
|
|
|
(defun main ()
|
|
(dolist (person (collect-bdays))
|
|
(message (make-bday-message (gethash "person" person)) "ROOM_ID")))
|
|
|
|
(defun check-required-env-vars ()
|
|
(let ((required-vars '("bot_name" "bot_pw" "bot_access_token" "homeserver_url" "room_id"))
|
|
(missing-vars '()))
|
|
|
|
(dolist (var required-vars)
|
|
(unless (gethash var *config*)
|
|
(push var missing-vars)))
|
|
|
|
(when missing-vars
|
|
(format t "ERROR: Missing required environment variables:~%")
|
|
(dolist (var missing-vars)
|
|
(format t " - ~A~%" var))
|
|
(sb-ext:exit :code 1))
|
|
|
|
t))
|
|
(defun main* ()
|
|
(let* ((args sb-ext:*posix-argv*)
|
|
(config-file (or (second args) "./config.yml")))
|
|
(format t "Using config file: ~A~%" config-file)
|
|
(unwind-protect
|
|
(let* ((base-config (cl-yaml:parse (pathname config-file)))
|
|
(*birthdays* (gethash "birthdays" base-config))
|
|
(*config* (gethash "config" base-config)))
|
|
(check-required-env-vars)
|
|
(main))
|
|
(sb-ext:exit :code 0))))
|