chatikbot/plugins/aoc.lisp

(in-package :cl-user)
(defpackage chatikbot.plugins.aoc
  (:use :cl :chatikbot.common))
(in-package :chatikbot.plugins.aoc)

(defparameter +api-uri+ "https://adventofcode.com/2020/leaderboard/private/view/657296.json")
(defparameter +leader-board-link+ "https://adventofcode.com/2020/leaderboard/private/view/657296")
(defparameter +advent-time+ (encode-universal-time 0 0 8 25 12 2020 -3))
(defparameter +max-people+ 10)

(defmethod poller-request ((module (eql :aoc)) method &rest params)
  (declare (ignorable params))
  (let ((cookie (format nil "session=~a" *poller-token*)))
    (handler-case
        (agets (json-request +api-uri+ :headers `((:cookie . ,cookie))))
      (dex:http-request-failed (e) e))))

(defmethod poller-validate ((module (eql :aoc)) response)
  (not (typep response 'dex:http-request-failed)))

(defmethod poller-get-token ((module (eql :aoc)) secret)
  (let* ((*poller-token* secret))
    (poller-request :aoc "")
    (format nil "~a" secret)))

(defun leaderboard ()
  (poller-call :aoc ""))
(defun completion-state ()
  (loop for (uid . member) in (agets (leaderboard) "members")
    append (loop for (num . completion) in (agets member "completion_day_level")
             collect (list (parse-integer uid) (agets member "name") (parse-integer num) (length completion)))))

(defun get-advent-days-active ()
  (max 0 (min 25 (- 25 (ceiling (/ (- +advent-time+ (get-universal-time)) 86400))))))

(defun format-stars(completions)
  (format nil "~{~a~}" (loop for daynum from 1 to (get-advent-days-active)
                          for stars = (length (agets completions (write-to-string daynum)))
                          collect (case stars (1 "☆") (2 "★") (t " • ")))))

(defun format-leaderboard (json)
  (let ((sorted (subseq (sort (loop for (uid . member) in (agets json "members")
                                collect (list (agets member "name")
                                              (agets member "local_score")
                                              (format-stars (agets member "completion_day_level"))))
                              #'> :key #'second) 0 +max-people+)))
    (format nil "🏆***Fridach AoC Leaderboard***🏆~%~a~%~%~{~a. ~a: ~a ~% ~a~^~%~}" +leader-board-link+
            (apply 'append (mapcar #'cons (alexandria:iota (length sorted) :start 1) sorted)))))

(defun handle-leaderboard ()
  (bot-send-message
   (handler-case
       (format-leaderboard (leaderboard))
     (poller-error ()
       "Надо обновить куки, старые истекли"))
   :parse-mode "markdown"))

(defun format-completion-state-change (diff)
  (format nil "Обновился лидерборд 🏆***AoC*** 🏆~%~a~%~{~a!~^~%~}" +leader-board-link+ (loop for (uid name daynum completed) in diff
                           collect (format nil "***~a*** сделал(а) ~a задачку ~a дня" name completed daynum))))

(defcron process-aoc (:minute '(member 0 5 10 15 20 25 30 35 40 45 50 55))
  (poller-poll-lists :aoc
                     #'completion-state
                     #'(lambda (diff)
                               (log:info (list "Completion state diff:" diff))
                               (bot-send-message (format-completion-state-change diff)
                                                 :parse-mode "markdown"))
                     :key #'first
                     :max-store 1000))

(defun handle-set-cookie (cookie)
  (handler-case (progn
                  (poller-authenticate :aoc cookie)
                  (bot-send-message "Кука рабочая, теперь можешь делать запросы."))
    (poller-cant-authenticate ()
      (bot-send-message "Чот не смог, пропробуй другие."))))

(defun handle-set-cron (enable)
  (lists-set-entry :aoc *chat-id* enable)
  (bot-send-message (if enable
                      "Включил рассылку обновлений лидерборда. '/aoc updates off' чтобы выключить, /aoc - показать лидерборд."
                      "Отключил рассылку обновлений лидерборда. '/aoc updates on' - включить, /aoc - показать лидерборд.")))

(def-message-cmd-handler handle-cmd-aoc (:aoc)
  (cond
    ((= 1 (length *args*))
     (handle-set-cookie (car *args*)))
    ((= 2 (length *args*))
     (handle-set-cron (equal "on" (second *args*))))
    (:otherwise (handle-leaderboard))))