|
@@ -0,0 +1,74 @@
|
|
|
|
|
+(in-package #:chatikbot)
|
|
|
|
|
+(ql:quickload :pta-ledger)
|
|
|
|
|
+
|
|
|
|
|
+(defvar *ledger/chat-journals* (make-hash-table))
|
|
|
|
|
+
|
|
|
|
|
+(defun ledger/get-hook-url (chat-id url)
|
|
|
|
|
+ (when *web-path*
|
|
|
|
|
+ (quri:render-uri
|
|
|
|
|
+ (quri:merge-uris (quri:uri (format nil "/hook/ledger/~A/~A/" chat-id
|
|
|
|
|
+ (token-hmac (format nil "~A~A" chat-id url))))
|
|
|
|
|
+ (quri:uri *web-path*)))))
|
|
|
|
|
+
|
|
|
|
|
+(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)
|
|
|
|
|
+ (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"
|
|
|
|
|
+ (length journal)
|
|
|
|
|
+ (quri:render-uri (quri:make-uri :userinfo nil
|
|
|
|
|
+ :defaults uri))
|
|
|
|
|
+ (ledger/format-time ut))))
|
|
|
|
|
+ (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*)
|
|
|
|
|
+ (declare (ignore ut))
|
|
|
|
|
+ (if journal
|
|
|
|
|
+ (bot-send-message chat-id (format nil "```~%~A~%```" (pta-ledger:journal-balance journal query))
|
|
|
|
|
+ :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)))))
|
