chatikbot/plugins/ledger.lisp

(in-package #:chatikbot)
(ql:quickload :pta-ledger)

(defsetting *ledger/default-timezone* -3 "Default timezone for time display. GMT+3")
(defvar *ledger/chat-journals* (make-hash-table))

(defun ledger/get-hook-url (chat-id url)
  (declare (ignore url))
  (get-webhook-url "ledger" chat-id (token-hmac (format nil "~A" chat-id))))

(defun ledger/parse-uri (chat-id uri)
  (setf (gethash chat-id *ledger/chat-journals*)
        (cons (pta-ledger:parse-journal (http-request uri))
              (get-universal-time))))

(defun ledger/handle-set-uri (chat-id uri)
  (handler-case
      (destructuring-bind (journal . ut)
          (ledger/parse-uri chat-id uri)
        (declare (ignore ut))
        (secret/set (list :ledger chat-id) uri)
        (send-response chat-id (format nil "Добавил журнал с ~D записями. Веб-хук для обновления: ~A"
                                       (length journal)
                                       (ledger/get-hook-url chat-id uri))))
    (pta-ledger:journal-failed (e)
      (send-response chat-id (format nil "Не смог спарсить: ~A" e)))
    (dex:http-request-failed (e)
      (send-response chat-id (format nil "Не смог в урл: ~A" (dex:response-body e))))))

(defun ledger/format-time (universal-time)
  (when universal-time
    (multiple-value-bind (sec min hour day month year dow dst-p tz)
        (decode-universal-time universal-time *ledger/default-timezone*)
      (declare (ignore dow dst-p tz))
      (format nil "~4,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D:~2,'0D"
              year month day hour min sec))))

(defun ledger/handle-info (chat-id)
  (secret/with (uri (list :ledger chat-id))
    (if uri
        (destructuring-bind (journal . ut)
            (or (gethash chat-id *ledger/chat-journals*)
                (ledger/parse-uri chat-id uri))
          (send-response chat-id (format nil "Журнал с ~D записями, из ~A, обновлён ~A.~%Веб-хук: ~A"
                                         (length journal)
                                         (quri:render-uri (quri:make-uri :userinfo nil
                                                                         :defaults uri))
                                         (ledger/format-time ut)
                                         (ledger/get-hook-url chat-id uri))))
        (send-response chat-id "Добавь урл журнала, /ledger <url>"))))

(def-message-cmd-handler handler-ledger (:ledger)
  (cond
    ((= 1 (length args)) (ledger/handle-set-uri chat-id (car args)))
    (:otherwise (ledger/handle-info chat-id))))

(defun ledger/handle-balance (chat-id query)
  (destructuring-bind (journal . ut)
      (gethash chat-id *ledger/chat-journals*)
    (if journal
        (bot-send-message chat-id (format nil "```~%~A~%```~%Обновлено: ~A"
                                          (pta-ledger:journal-balance journal query)
                                          (ledger/format-time ut))
                          :parse-mode "markdown")
        (secret/with (uri (list :ledger chat-id))
          (if uri
              (progn (ledger/parse-uri chat-id uri)
                     (ledger/handle-balance chat-id query))
              (send-response chat-id "Добавь урл журнала, /ledger <url>"))))))

(def-message-cmd-handler handler-balance (:balance :bal)
  (cond
    ((null args) (ledger/handle-balance chat-id "assets"))
    (:otherwise (ledger/handle-balance chat-id (spaced args)))))

(def-webhook-handler ledger/handle-webhook ("ledger")
  (cond
    ((= 2 (length paths))
     (destructuring-bind (chat-id hmac) paths
       (let ((true-hmac (token-hmac chat-id)))
         (if (string= true-hmac hmac)
             (secret/with (uri (list :ledger chat-id))
               (if uri
                   (progn (ledger/parse-uri (parse-integer chat-id) uri)
                          "OK")
                   "FAIL"))
             "FAIL"))))
    (:otherwise "FAIL")))