birthday-boy/bot.lisp
2025-04-18 15:02:23 -06:00

135 lines
4.7 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 :cl-dotenv)
;;
;; (.env:load-env (merge-pathnames ".env"))
;; (ql:quickload '(:dexador :cl-dotenv :local-time :jonathan))
(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 put-json-content (uri json-content)
(dex:put uri
:headers '((:content-type . "application/json"))
:content (jojo:to-json json-content)))
(defun put-json-content-auth (uri json-content)
(dex:put uri
:headers `((:|Authorization| . ,(format nil "Bearer ~A" (uiop:getenv "BOT_ACCESS_TOKEN")) )
(:content-type . "application/json"))
:content (jojo:to-json json-content)))
(defun post-json-content (uri json-content)
(dex:post uri
:headers '((:content-type . "application/json"))
:content (jojo:to-json json-content)))
(defun post-json-content-auth (uri json-content)
(dex:post uri
:headers `((:|Authorization| . ,(format nil "Bearer ~A" (uiop:getenv "BOT_ACCESS_TOKEN")) )
(:content-type . "application/json"))
:content (jojo:to-json json-content)))
(defun make-homeserver-endpoint (endpoint)
(format nil "~a~a" (uiop:getenv "HOMESERVER_URL") 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| (uiop:getenv "BOT_NAME"))
:|type| "m.login.password"
:|password| (uiop:getenv "BOT_PW"))))))
(values
(getf res :|access_token|)
(getf res :|device_id|))))
(defun message (msg &optional (room-id "GENERAL2_ROOM_ID"))
(put-json-content-auth
;; (format nil "https://matrix.groupchattt.page/_matrix/client/v3/rooms/~a/send/m.room.message/~a"
;; (uiop:getenv room-id)
;; (make-txn-id))
(make-homeserver-endpoint (format nil "/_matrix/client/v3/rooms/~a/send/m.room.message/~a"
(uiop:getenv room-id)
(make-txn-id)))
(list
:|msgtype| "m.text"
:|body| msg)))
;; (defun request-join (room)
;; (post-json-content-auth
;; (make-homeserver-endpoint (format nil "/_matrix/client/v3/knock/~A" room))
;; (list
;; :|reason| "for birthday bot")))
(defvar *birthdays* nil)
(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 (gethash "birthdays" *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 ()
;; (.env:load-env env-file)
(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 (uiop:getenv var)
(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*)
(env-file (or (second args) #P".env"))
(birthdays-file (or (third args) "./birthdays.yml")))
(format t "Using env file: ~A~%" env-file)
(format t "Using birthdays file: ~A~%" birthdays-file)
(.env:load-env env-file)
(check-required-env-vars)
(unwind-protect
(let ((*birthdays* (cl-yaml:parse (pathname birthdays-file))))
(main))
(sb-ext:exit :code 0))))