chatikbot/plugins/tinkoff.lisp

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

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :pta-ledger))

(defsetting *account-default-prefix* "assets:Tinkoff:")
(defsetting *account-aliases* nil "tinkoff account to ledger account")
(defsetting *category-aliases* '((60 . "expenses:Food:Fast-food")
                                 (36 . "expenses:Transport")
                                 (32 . "expenses:Food:Restaurant")
                                 (20 . "expenses:Life:Wear")
                                 (16 . "expenses:Transport:Car:Gas")
                                 (10 . "expenses:Food:Grocery")) "tinkoff category to expense account mapping")

(defsetting *ua* "OnePlus ONE A2003/android: 6.0.1/TCSMB/3.4.2" "User agent")
(defsetting *device-id* "1df9bdeac787e08")
(defsetting *app-version* "4.1.3")

(defvar *api-base-url* "https://api.tinkoff.ru/v1/")
(defvar *session-id* nil "Last session id")
(defvar *origin* "mobile,ib5,loyalty,platform")
(defvar *platform* "android")
(defvar *credentials-provider* nil "Active credentials provider")

(defun api-url (method)
  (concatenate 'string *api-base-url* method))

(defun default-params ()
  `(("origin" . ,*origin*)
    ("platform" . ,*platform*)
    ("deviceId" . ,*device-id*)
    ("appVersion" . ,*app-version*)
    ("sessionid" . ,*session-id*)
    ("ccc" . "true")))

(define-condition api-error (error)
  ((code :initarg :code :reader api-error-code)
   (message :initarg :message :reader api-error-message))
  (:report (lambda (condition stream)
             (with-slots (code message) condition
               (format stream "Tinkoff api error ~A: ~A" code message)))))

(defun request (method &key params content retry)
  (flet ((api/login (username password)
           (let ((new-session (request "session")))
             (prog1
                 (let* ((*session-id* new-session))
                   (request "sign_up" :params `(("username" . ,username)
                                                ("password" . ,password)))
                   (request "level_up"))
               (setf *session-id* new-session)))))
    (let* ((params (loop for (k . v) in (append (default-params) params) when v
                      collect (cons (princ-to-string k) (princ-to-string v))))
           (r (json-request (api-url method) :method (if content :POST :GET)
                            :parameters params
                            :content content)))
      (if (string= "OK" (agets r "resultCode"))
          (agets r "payload")
          (let ((code (agets r "resultCode"))
                (message (agets r "errorMessage")))
            (if (and (not retry)
                     *credentials-provider*
                     (string-equal code "INSUFFICIENT_PRIVILEGES"))
                (progn
                  (funcall *credentials-provider*
                           (lambda (login password)
                             (api/login login password)))
                  (request method :params params :content content :retry t))
                (error 'api-error :code code :message message)))))))



(defun api/accounts ()
  (request "accounts_flat"))

(defun api/operations (&key account start end)
  (request "operations" :params `(("account" . ,account)
                                  ("start" . ,start)
                                  ("end" . ,end))))

(defvar *unix-epoch-difference*
  (encode-universal-time 0 0 0 1 1 1970 0))

(defun universal-to-unix-time (universal-time)
  (- universal-time *unix-epoch-difference*))

(defun unix-to-universal-time (unix-time)
  (+ unix-time *unix-epoch-difference*))

(defun get-unix-time ()
  (universal-to-unix-time (get-universal-time)))

(defun short-date (ms)
  (if ms
   (multiple-value-bind (sec min hour day month year)
       (decode-universal-time (unix-to-universal-time (round ms 1000)))
     (declare (ignore sec min hour))
     (format nil "~4,'0D/~2,'0D/~2,'0D" year month day))
   "-"))

(defun get-op-description (op)
  (let ((cat (parse-integer (agets op "category" "id") :junk-allowed t)))
    (cond
      ((equal cat 16) (if (> (agets op "accountAmount" "value")
                             1500)
                      "project: Volvo" "project: Smart"))
      (:otherwise
       (or
        (agets op "payment" "fieldsValues" "comment")
        (agets op "brand" "name"))))))

(defun get-op-account1 (op)
  (or (agets *account-aliases* (parse-integer (agets op "account")))
      (concatenate 'string *account-default-prefix* (agets op "account"))))

(defun get-op-account2 (op)
  (or (agets *category-aliases* (parse-integer (agets op "category" "id") :junk-allowed t))
      (concatenate 'string
                   (if (equal "Credit" (agets op "type"))
                       "income:" "expenses:")
                   (agets op "category" "name"))))

(defun ops->entry (ops)
  (loop for op in ops
     for status = (agets op "status")
     for date = (unix-to-universal-time (round (agets op "operationTime" "milliseconds") 1000))
     for payee = (agets op "description")
     for description = (get-op-description op)
     for account-amount = (agets op "accountAmount" "value")
     for account-currency = (agets op "accountAmount" "currency" "name")
     for amount = (agets op "amount" "value")
     for currency = (agets op "amount" "currency" "name")
     for account1 = (get-op-account1 op)
     for account2 = (get-op-account2 op)
     for expense = (equal "Debit" (agets op "type"))
     unless (string= status "FAILED")
     collect (pta-ledger:make-entry
              :date date
              :description payee
              :comment (unless (equal payee description) description)
              :postings (list
                         (pta-ledger:make-posting
                          :account account2
                          :amount (pta-ledger:make-amount
                                   :quantity (* amount (if expense 1 -1))
                                   :commodity currency)
                          :total-price (unless (equal currency account-currency)
                                         (pta-ledger:make-amount
                                          :quantity (* account-amount (if expense 1 -1))
                                          :commodity account-currency)))
                         (pta-ledger:make-posting
                          :account account1
                          :amount (pta-ledger:make-amount
                                   :quantity (* account-amount (if expense -1 1))
                                   :commodity account-currency))))))


(defun get-last-movements (begin-ut end-ut)
  (api/operations :start (* 1000 (universal-to-unix-time begin-ut))
                  :end (* 1000 (universal-to-unix-time end-ut))))

;; Cron
(defvar *last-entries* (make-hash-table) "Last per-chat entries")
(defvar *chat-sessions* (make-hash-table) "Per-chat sessions")

(defmacro with-chat-credentials ((chat-id) &body body)
  `(let* ((*session-id* (gethash ,chat-id *chat-sessions*))
          (*credentials-provider* (lambda (authenticator)
                                   (with-secret (login-pass (list :tinkoff ,chat-id))
                                     (if login-pass
                                         (apply authenticator login-pass)
                                         (error "no tinkoff credentials for ~A" ,chat-id))))))
     (prog1
         (progn
           ,@body)
       (setf (gethash ,chat-id *chat-sessions*) *session-id*))))

(defun get-chat-last-entries (chat-id &optional (offset +day+))
  (with-chat-credentials (chat-id)
    (let* ((now (get-universal-time))
           (pre (- now offset)))
      (sort (ops->entry (get-last-movements pre now))
            #'< :key #'pta-ledger:entry-date))))

(defun get-chat-accounts (chat-id)
  (with-chat-credentials (chat-id)
    (api/accounts)))

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

(defun format-accounts (accounts)
  (with-output-to-string (s)
    (princ "```" s)
    (loop for a in accounts
       when (agets a "moneyAmount" "value")
       do (format s "; balance ~A ~A = ~A~A ~A~%"
                  (short-date (agets a "lastPaymentDate" "milliseconds"))
                  (get-op-account1 (push (cons "account" (agets a "id")) a))
                  (if (equal "Credit" (agets a "accountType")) "-" "")
                  (if (equal "Credit" (agets a "accountType"))
                      (agets a "debtAmount" "value")
                      (agets a "moneyAmount" "value"))
                  (agets a "moneyAmount" "currency" "name")))
        (princ "```" s)))

(defcron process-tinkoff (:minute '(member 0 5 10 15 20 25 30 35 40 45 50 55))
  (dolist (chat-id (lists-get :tinkoff))
    (let ((old (gethash chat-id *last-entries*))
          (new (get-chat-last-entries chat-id (* 7 24 60 60)))
          (ledger-package (find-package :chatikbot.plugins.ledger)))
      (when new
        (when old
          (alexandria:when-let (changes (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 #'pta-ledger:entry-date)
                       :test 'equalp)))
          (setf (gethash chat-id *last-entries*)
                (subseq merged 0 (min (length merged) 200))))))))

(def-message-cmd-handler handler-tink (:tink)
  (let ((arg (car args)))
    (if (string= arg "bal")
        (bot-send-message chat-id (format-accounts (get-chat-accounts chat-id)) :parse-mode "markdown")
        (let ((last (get-chat-last-entries chat-id (* (if arg (parse-integer arg) 7) +day+))))
          (bot-send-message chat-id (format-entries last) :parse-mode "markdown")))))