(in-package :cl-user) (defpackage chatikbot.plugins.ledger (:use :cl :chatikbot.common)) (in-package :chatikbot.plugins.ledger) (eval-when (:compile-toplevel :load-toplevel :execute) (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 (write-to-string 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/format-uri (url) (let ((uri (quri:uri url))) (quri:render-uri (quri:make-uri :userinfo (when (quri:uri-userinfo uri) "*:*") :defaults url)))) (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) (with-secret (uri (list :ledger chat-id)) (if uri (destructuring-bind (journal . ut) (or (gethash chat-id *ledger/chat-journals*) (ledger/parse-uri chat-id uri)) (bot-send-message chat-id (format nil "Журнал с ~D записями, из ~A, обновлён ~A.~%Веб-хук: ~A" (length journal) (ledger/format-uri uri) (ledger/format-time ut) (ledger/get-hook-url chat-id uri)) :disable-web-preview t)) (send-response chat-id "Добавь урл журнала, /ledger ")))) (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) (let ((pair (gethash chat-id *ledger/chat-journals*))) (if pair (destructuring-bind (journal . ut) pair (bot-send-message chat-id (format nil "```~%~A~%```Обновлено: ~A" (pta-ledger:journal-balance journal query) (ledger/format-time ut)) :parse-mode "markdown")) (with-secret (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 ")))))) (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") (when (= 2 (length paths)) (destructuring-bind (chat-id hmac) paths (let ((true-hmac (token-hmac chat-id))) (when (string= true-hmac hmac) (with-secret (uri (list :ledger chat-id)) (when uri (ledger/parse-uri (parse-integer chat-id) uri))))))))