chatikbot/plugins/tinkoff.lisp

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

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

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

(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)
  (case (parse-integer (agets op "account"))
    (5001173482 "assets:Tinkoff:Debit")
    (1850735 "assets:Raiffeisen:Debit")
    (0047479860 "liabilities:Tinkoff:Credit:Platinum")
    (8102961813 "assets:Tinkoff:Savings:For credit")
    (t (concatenate 'string "assets:Tinkoff:" (agets op "account")))))

(defun get-op-account2 (op)
  (let ((cat (parse-integer (agets op "category" "id") :junk-allowed t)))
    (case cat
      (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")
      (t (concatenate 'string
                      (if (equal "Credit" (agets op "type"))
                          "income:" "expenses:")
                      (agets op "category" "name"))))))

(defun ops->journal (ops)
  (loop for op in ops
     for status = (agets op "status")
     for date = (short-date (agets op "operationTime" "milliseconds"))
     for id = (agets op "ucid")
     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 (format nil "~A~@[ (~A)~] ~A~@[ ; ~A~]~%    ~38A  ~A~,2F ~A~@[ @@ ~{~A~,2F ~A~}~]~%    ~38A  ~A~,2F ~A"
                     date nil payee (unless (equal payee description) description)
                     account2 (if expense " " "-") amount currency
                     (unless (equal currency account-currency)
                       (list (if expense "" "-") account-amount account-currency))
                     account1 (if expense "-" " ") account-amount 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-movements* (make-hash-table) "Last per-chat movements")
(defvar *chat-sessions* (make-hash-table) "Per-chat sessions")

(defun get-chat-last-movements (chat-id &optional (offset +day+))
  (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)))))
         (now (get-universal-time))
         (pre (- now offset))
         (new (get-last-movements pre now)))
      (when new
        (setf (gethash chat-id *chat-sessions*) *session-id*))
      new))

(defun format-changes (changes)
  (format nil "```~%~{~A~^~%~%~}```" (ops->journal changes)))

(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-movements*))
          (new (get-chat-last-movements chat-id (* 7 24 60 60))))
      (when new
        (log:info "Got ~A tinkoff events" (length new))
        (when old
          (alexandria:when-let (changes (set-difference new old :test #'equal))
            (bot-send-message chat-id (format-changes changes) :parse-mode "markdown")))
        (setf (gethash chat-id *last-movements*) new)))))

(def-message-cmd-handler handler-tink (:tink)
  (let ((last (get-chat-last-movements chat-id (* (if args (parse-integer (car args)) 7) +day+))))
    (bot-send-message chat-id (format-changes last) :parse-mode "markdown")))