chatikbot/plugins/deltacredit.lisp

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

(defparameter +api-uri+ "https://info.deltacredit.ru/webby_mobile/MobileService.svc/v1/")

;; poller methods
(defun is-post (method)
  (or (equal method "auth")
      (equal method "bill/extract")))

(defun is-raw-params (method)
  (equal method "bill/extract"))

(defmethod poller-request ((module (eql :deltacredit)) method &rest params)
  (handler-case
      (let* ((is-post (is-post method))
             (is-raw (is-raw-params method))
             (res
              (json-request (concatenate 'string +api-uri+ method)
                            :cookie-jar *poller-token*
                            :method (if is-post :post :get)
                            :json-content is-post
                            (if is-post :content :parameters) (rest-parameters params is-raw))))
        (unless (agets res "result")
          (error (agets res "errMsg")))
        (agets res "data"))
    (dex:http-request-failed (e) e)))

(defmethod poller-validate ((module (eql :deltacredit)) response)
  (not (typep response 'dex:http-request-failed)))

(defmethod poller-get-token ((module (eql :deltacredit)) secret)
  (destructuring-bind (username . password) secret
    (let* ((*poller-token* (cl-cookie:make-cookie-jar)))
      (ignore-errors
        (poller-request :deltacredit "auth"
                        :login username
                        :password password)
        *poller-token*))))

(defun list-credit ()
  (poller-call :deltacredit "credit/list"))

(defun profile-info ()
  (poller-call :deltacredit "profile/info"))

(defun bill-list ()
  (poller-call :deltacredit "bill/list"))

(defun bill-extract (bill-id &key start-date finish-date)
  (poller-call :deltacredit "bill/extract" :|billId| bill-id :|startDate| start-date :|finishDate| finish-date))

(defun format-credit (credit)
  (let ((cur (agets credit "creditCurrency")))
    (format nil "Кредит '~A' № ~A (~A)
Всего:    ~$ ~A ~A - ~A
Осталось: ~$ ~A, след. платёж ~$ ~A ~A"
            (agets credit "contractType")
            (agets credit "contractNumber")
            (agets credit "contractStatus")
            (agets credit "creditAmount") cur
            (agets credit "sinceDate") (agets credit "untilDate")
            (agets credit "remainingDebt") cur
            (agets credit "nextPaymentAmount") cur (agets credit "nextPaymentDate"))))

(defun format-bill (bill)
   (format nil "~A ~A (~A)
Баланс: ~$ ~A"
           (agets bill "billTypeDescription")
           (agets bill "billNumber")
           (agets bill "statusDescription")
           (agets bill "balance") (agets bill "currency")))

(defun format-entries (changes)
  (text-chunks (mapcar #'pta-ledger:render changes)))

(defvar *entry-description* "deltacredit")
(defvar *income-account* "assets")
(defvar *expense-account* "expenses")
(defvar *expense-account-interest* "expenses:Banking:Interest:Mortage")
(defvar *liabilities-account* "liabilities:delta:mortage")

(defun get-op-date (tr)
  (local-time:timestamp-to-universal
   (apply #'local-time:encode-timestamp 0 0 0 0
          (mapcar #'parse-integer
                  (split-sequence:split-sequence
                   #\. (agets tr "operationDate"))))))

(defun format-op-date (timestamp)
  (local-time:format-timestring
   nil timestamp
   :format '((:day 2) "/" (:month 2) "/" (:year 4))))

(defun transaction->entry (tr)
  (let* ((pta-ledger (find-package :pta-ledger))
         (make-entry (symbol-function (intern "MAKE-ENTRY" pta-ledger)))
         (make-posting (symbol-function (intern "MAKE-POSTING" pta-ledger)))
         (make-amount (symbol-function (intern "MAKE-AMOUNT" pta-ledger)))
         (date (get-op-date tr))
         (comment (agets tr "paymentDescription"))
         (is-income (not (zerop (agets tr "inAmount"))))
         (amount (agets tr (if is-income "inAmount" "outAmount")))
         (expense-account (if is-income *income-account*
                              (if (equal (subseq comment 0 17)
                                         "Гашение процентов")
                                  *expense-account-interest*
                                  *expense-account*)))
         (currency "RUB"))
    (funcall make-entry
     :date date
     :description *entry-description*
     :comment comment
     :postings (list
                (funcall make-posting
                 :account expense-account
                 :amount (funcall make-amount
                                  :quantity (* (if is-income -1 1) amount)
                          :commodity currency))
                (funcall make-posting
                 :account *liabilities-account*
                 :amount (funcall make-amount
                          :quantity (* (if is-income 1 -1) amount)
                          :commodity currency))))))

(defun get-transactions (&optional (days 30))
  (let* ((now (local-time:now))
         (finish-date (format-op-date now))
         (start-date (format-op-date (local-time:timestamp- now days :day)))
         (bills (bill-list)))
    (loop for bill in bills
       append (bill-extract (agets bill "id") :start-date start-date :finish-date finish-date))))

(defun process-new (diff)
  (let ((transactions (mapcar #'transaction->entry diff))
        (ledger-package (find-package :chatikbot.plugins.ledger)))
    (if ledger-package
        (let ((new-chat-entry (symbol-function
                               (intern "LEDGER/NEW-CHAT-ENTRY" ledger-package))))
          (dolist (tr transactions)
            (funcall new-chat-entry *chat-id* tr)))
        (bot-send-message (format-entries transactions) :parse-mode "markdown"))))

;; Cron
(defcron process-deltacredit (:minute '(member 0 10 20 30 40 50))
  (poller-poll-lists :deltacredit
                     #'get-transactions
                     #'process-new
                     :key #'get-op-date))

(defun handle-auth (login pass)
  (handler-case
      (progn
        (poller-authenticate :deltacredit (cons login pass))
        (handle-balance))
    (poller-cant-authenticate ()
      (bot-send-message "Чот не смог, пропробуй другие."))))

(defun handle-balance ()
  (bot-send-message
   (handler-case
       (let ((entries (append (mapcar 'format-credit (list-credit))
                              (mapcar 'format-bill (bill-list)))))
         (if entries (text-chunks entries) "Не нашлось"))
     (poller-no-secret () "Нужен логин-пароль. /delta <login> <pass>")
     (poller-cant-get-token () "Не смог получить данные. Попробуй перелогинься. /delta <login> <pass>"))
   :parse-mode "markdown"))

(defun handle-recent (&optional (days 30))
  (bot-send-message
   (handler-case
       (format-entries (mapcar #'transaction->entry (get-transactions days)))
     (poller-no-secret () "Нужен логин-пароль. /delta <login> <pass>")
     (poller-cant-get-token () "Не смог получить данные. Попробуй перелогинься. /delta <login> <pass>"))
   :parse-mode "markdown"))

(def-message-cmd-handler handle-cmd-delta (:deltacredit :delta)
  (let ((a0 (car *args*)))
    (cond
      ((= 2 (length *args*)) (apply 'handle-auth *args*))
      ((or (null *args*) (equal a0 "bal")) (handle-balance))
      (:otherwise (handle-recent (parse-integer a0 :junk-allowed t))))))