121 lines
4.3 KiB
Common Lisp
121 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)
|
|
;;
|
|
;; (.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* '((:person "carl" :month 4 :day 13)
|
|
(:person "noellie" :month 7 :day 15)
|
|
(:person "joe" :month 9 :day 17)
|
|
(:person "daniel" :month 7 :day 18)
|
|
(:person "mike" :month 2 :day 13)
|
|
(:person "James Franco" :month 4 :day 19)
|
|
(:person "David Tennant" :month 4 :day 18)
|
|
(:person "famous actor Sean Bean" :month 4 :day 17)
|
|
(:person "bwandice" :month 10 :day 15)))
|
|
|
|
|
|
(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* (getf person :day) (getf person :month))
|
|
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 (getf person :person)) "ROOM_ID")))
|
|
|
|
(defun main* ()
|
|
(unwind-protect (main)
|
|
(sb-ext:exit :code 0)))
|
|
|