chatikbot/plugins/gazprom.lisp

(in-package :cl-user)
(defpackage chatikbot.plugins.gazprom
  (:use :cl :chatikbot.common :alexandria))
(in-package :chatikbot.plugins.gazprom)

(defparameter +api-uri+ "https://api.gpnbonus.ru/ios/v2/")
(defvar *api-os* "android")
(defvar *api-ver* "1.7.4")

;; poller methods
(defmethod poller-request ((module (eql :gazprom)) method &rest params)
  (json-request (concatenate 'string +api-uri+ method)
                :method (if (equal method "auth.php") :post :get)
                :parameters (filled (append `(("session" . ,*poller-token*)
                                              ("os" . ,*api-os*)
                                              ("ver" . ,*api-ver*))
                                            (rest-parameters params)))))

(defmethod poller-validate ((module (eql :gazprom)) response)
  (not (equal (agets response "message") "Необходимо авторизоваться")))

(defmethod poller-authenticate ((module (eql :gazprom)) secret)
  (destructuring-bind (username password) secret
    (agets (poller-request :gazprom "auth.php"
                           :login username
                           :passw password
                           :token (get-token username password))
           "session")))

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

;; API
(defun get-card-info ()
  (poller-call :gazprom "getCardInfo.php"))

(defun get-order (&key (count 20) (offset 0))
  (poller-call :gazprom "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")
(defvar *entry-description* "ГазпромНефть")

(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
(defun prepare-entries (orders)
  (loop for (date . orders) in (group-by orders (agetter "date"))
     collect (orders->entry date orders)))

(defun process-new (changes)
  (let ((ledger-package (find-package :chatikbot.plugins.ledger))
        (transactions (prepare-entries changes)))
    (if ledger-package
        (let ((new-chat-entry (symbol-function
                               (intern "LEDGER/NEW-CHAT-ENTRY" ledger-package))))
          (dolist (entry transactions)
            (funcall new-chat-entry *chat-id* (pta-ledger:clone-entry entry))))
        (bot-send-message (format-entries transactions) :parse-mode "markdown"))))

(defcron process-gazprom (:minute '(member 0 5 10 15 20 25 30 35 40 45 50 55))
  (poller-poll-lists :gazprom
                     #'get-order
                     #'process-new
                     :key (agetter "date")))

(def-message-cmd-handler handler-gazprom (:gpn :gazprom)
  (let ((arg (car *args*)))
    (bot-send-message (if (string= arg "bal")
                          (format-card (get-card-info))
                          (format-entries (prepare-entries (get-order :count (if arg (parse-integer arg) 10)))))
                      :parse-mode "markdown")))