(in-package :cl-user) (defpackage chatikbot.plugins.gazprom (:use :cl :chatikbot.common :alexandria)) (in-package :chatikbot.plugins.gazprom) (defparameter +gpn-api-url+ "https://api.gpnbonus.ru/ios/v2/") (defvar *api-os* "android") (defvar *api-ver* "1.7.4") (defvar *session* nil "Currently active session") (defvar *credentials-provider* nil "Active credentials provider") (defvar *bonus-account* "assets:gazprom:bonus") (defvar *assets-account* "assets") (defvar *gas-expenses-account* "expenses:transport:car:gas") (defvar *other-expenses-account* "expenses:food:snacks") (defvar *expenses-currency* "RUB") (defvar *entry-description* "ГазпромНефть") (defun filled (alist) (remove nil alist :key #'cdr)) (defun %api (method &optional params) (let* ((response (json-request (concatenate 'string +gpn-api-url+ method) :parameters (filled (append `(("session" . ,*session*) ("os" . ,*api-os*) ("ver" . ,*api-ver*)) params)))) (message (agets response "message"))) (if (equal message "Необходимо авторизоваться") (if *credentials-provider* (progn (funcall *credentials-provider* (lambda (login password) (setf *session* (^auth login password)))) (let (*credentials-provider*) ;; Retry call resetting *credentials-provider* to prevent loop (%api method params))) (error message)) response))) (defun get-token (login pass) (let ((date (format nil "~{~4,'0D~2,'0D~2,'0D~}" (subseq (reverse (multiple-value-list (decode-universal-time (get-universal-time) 0))) 3 6)))) (crypto:byte-array-to-hex-string (crypto:digest-sequence :md5 (crypto:ascii-string-to-byte-array (concatenate 'string login pass date *api-ver*)))))) (defun ^auth (login pass) (let* ((resp (json-request (concatenate 'string +gpn-api-url+ "auth.php") :method :post :content `(("login" . ,login) ("passw" . ,pass) ("token" . ,(get-token login pass)) ("os" . ,*api-os*) ("ver" . ,*api-ver*)))) (status (agets resp "status"))) (unless (= status 1) (error (agets resp "message"))) (agets resp "session"))) (defun ^get-card-info () (%api "getCardInfo.php")) (defun ^get-order (&key (count 20) (offset 0)) (%api "getOrder.php" `(("count" . ,count) ("offset" . ,offset)))) ;; Formatting (defvar *account-fuel* "expenses:Transport:Car:Gas") (defvar *account-other* "expenses:Food:Snacks") (defvar *account-asset* "liabilities:Tinkoff:Credit:Platinum") (defvar *income-bonus* "income:bonus") (defvar *account-bonus* "assets:Gazprom:Bonus") (defvar *default-currency* "RUB") (defun is-fuel (name) (or (equal name "ДТ+") (equal name "Аи-92") (equal name "Аи-95") (equal name "Аи-98"))) (defun get-currency (name) (cond ((or (equal name "Аи-92") (equal name "Аи-95") (equal name "Аи-98")) "BENZ") ((equal name "ДТ+") "DIZ") (t *default-currency*))) (defun get-account (name) (cond ((is-fuel name) *account-fuel*) (t *account-other*))) (defun get-expense-posting (order) (let* ((name (agets order "name")) (is-fuel (is-fuel name)) (count (parse-float (agets order "count"))) (sum (parse-float (agets order "sum"))) (currency (get-currency name))) (pta-ledger:make-posting :account (get-account name) :comment name :amount (pta-ledger:make-amount :quantity (if is-fuel count sum) :commodity currency) :unit-price (when is-fuel (pta-ledger:make-amount :quantity (/ sum count) :commodity *default-currency*))))) (defun orders->entry (date orders) (pta-ledger:make-entry :date (local-time:timestamp-to-universal (local-time:unix-to-timestamp date)) :description *entry-description* :postings (loop for (type . orders) in (group-by orders (agetter "type")) for total = 0 then 0 for bonus = 0 then 0 append (append (loop for order in orders do (incf total (parse-float (agets order "sum"))) do (incf bonus (parse-float (agets order "bonus"))) collect (get-expense-posting order)) (list (pta-ledger:make-posting :account *account-bonus* :amount (pta-ledger:make-amount :quantity bonus :commodity *default-currency*))) (when (= type 1) (list (pta-ledger:make-posting :account *income-bonus* :amount (pta-ledger:make-amount :quantity (* -1 bonus) :commodity *default-currency*)) (pta-ledger:make-posting :account *account-asset* :amount (pta-ledger:make-amount :quantity (* -1 total) :commodity *default-currency*)))))))) (defun format-card (card) (format nil "Баланс: ~,2F баллов~%Статус: ~A~%Литров в месяце: ~D" (agets card "card_balance") (agets card "card_status") (agets card "amount_current_month_liter"))) (defun format-entries (changes) (text-chunks (mapcar #'pta-ledger:render changes))) ;; Cron (defvar *last-entries* (make-hash-table) "Last per-chat entries") (defvar *sessions* (make-hash-table) "Per-chat sessions") (defmacro with-chat-credentials ((chat-id) &body body) `(let* ((*session* (gethash ,chat-id *sessions*)) (*credentials-provider* (lambda (authenticator) (with-secret (login-pass (list :gazprom ,chat-id)) (if login-pass (apply authenticator login-pass) (error "no gazprom credentials for ~A" ,chat-id)))))) (prog1 (progn ,@body) (setf (gethash ,chat-id *sessions*) *session*)))) (defun get-chat-card (chat-id) (with-chat-credentials (chat-id) (^get-card-info))) (defun get-chat-last-n-orders (chat-id &optional (count 10)) (with-chat-credentials (chat-id) (^get-order :count count))) (defun prepare-entries (orders) (loop for (date . orders) in (group-by orders (agetter "date")) collect (orders->entry date orders))) (defcron process-gazprom (:minute '(member 0 5 10 15 20 25 30 35 40 45 50 55)) (dolist (chat-id (lists-get :gazprom)) (let* ((old (gethash chat-id *last-entries*)) (new (get-chat-last-n-orders chat-id 20)) (changes (sort (set-difference new old :test #'equalp) #'< :key (agetter "date"))) (ledger-package (find-package :chatikbot.plugins.ledger))) (when changes (log:info changes) (when old (if ledger-package (let ((new-chat-entry (symbol-function (intern "LEDGER/NEW-CHAT-ENTRY" ledger-package)))) (dolist (entry (prepare-entries changes)) (funcall new-chat-entry chat-id (pta-ledger:clone-entry entry)))) (bot-send-message chat-id (format-entries (prepare-entries changes)) :parse-mode "markdown"))) (let ((merged (merge 'list old changes #'< :key (agetter "date")))) (setf (gethash chat-id *last-entries*) (subseq merged (max (- (length merged) 200) 0)))))))) (def-message-cmd-handler handler-gazprom (:gpn :gazprom) (let ((arg (car args))) (if (string= arg "bal") (bot-send-message chat-id (format-card (get-chat-card chat-id)) :parse-mode "markdown") (let ((last (prepare-entries (get-chat-last-n-orders chat-id (if arg (parse-integer arg) 10))))) (bot-send-message chat-id (format-entries last) :parse-mode "markdown")))))