chatikbot/plugins/gazprom.lisp

(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))
          (ledger-package (find-package :chatikbot.plugins.ledger)))
      (when new
        (when old
          (when-let (changes (prepare-entries (set-difference new old :test #'equalp)))
            (log:info changes)
            (if ledger-package
                (let ((new-chat-entry (symbol-function
                                       (intern "LEDGER/NEW-CHAT-ENTRY" ledger-package))))
                  (dolist (entry changes)
                    (funcall new-chat-entry chat-id (pta-ledger:clone-entry entry))))
                (bot-send-message chat-id (format-entries changes) :parse-mode "markdown"))))
        (let ((merged (remove-duplicates
                       (merge 'list old new #'< :key (agetter "date"))
                       :test 'equalp)))
          (setf (gethash chat-id *last-entries*)
                (subseq merged (max 0 (- (length merged) 100)))))))))

(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")))))