chatikbot/plugins/raiffeisen.lisp

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

(defsetting *account-aliases* nil "account to ledger account")
(defsetting *account-default-prefix* "assets:Raiffeisen")
(defsetting *account-loan-prefix* "liabilities:Raiffeisen")
(defsetting *move-categories* nil "move categoryId->account")
(defsetting *account-cash* "assets:Cash:RUB")

(defparameter +raif-oauth-url+ "https://online.raiffeisen.ru/oauth/token")
(defparameter +raif-oauth-basic-auth+ '("oauthUser" . "oauthPassword!@"))
(defvar *access-token* nil "Currently active access token")
(defvar *credentials-provider* nil "Active credentials provider")

(defun get-access-token (username password)
  (let ((response
         (json-request +raif-oauth-url+ :method :post
                       :content `(("grant_type" . "password")
                                  ("username" . ,username)
                                  ("password" . ,password))
                       :basic-auth +raif-oauth-basic-auth+)))
    (values (agets response "access_token")
            (agets response "expires_in")
            (agets response "resource_owner"))))

(defun filled (alist)
  (remove nil alist :key #'cdr))

(defparameter +raif-rest-url+ "https://online.raiffeisen.ru/rest/")
(defun %rest (method &optional parameters)
  (handler-case
      (json-request (concatenate 'string +raif-rest-url+ method)
                    :parameters (filled parameters)
                    :headers (when *access-token*
                               `((:authorization . ,(concatenate 'string "Bearer " *access-token*)))))
    (dex:http-request-unauthorized (e)
      (if *credentials-provider*
          (progn
            (funcall *credentials-provider*
                     (lambda (login password)
                       (setf *access-token* (get-access-token login password))))
            (let (*credentials-provider*) ;; Retry call resetting *credentials-provider* to prevent loop
              (%rest method parameters)))
          (error e)))))


(defun ^request (&key (page 0) (size 20) (sort "date") (order "desc") alien)
  (%rest "request" `(("page" . ,page)
                     ("size" . ,size)
                     ("sort" . ,sort)
                     ("order" . ,order)
                     ("alien" . ,(when alien "true")))))

(defun ^transaction (&key (page 0) (size 20) (sort "date") (order "desc"))
  (%rest "transaction" `(("page" . ,page)
                         ("size" . ,size)
                         ("sort" . ,sort)
                         ("order" . ,order))))

(defun ^account (&key alien)
  (%rest "account" `(("alien" . ,(when alien "true")))))

(defun ^loan (&key alien)
  (%rest "loan" `(("alien" . ,(when alien "true")))))

(defun get-account-currency (account)
  (agets account "currency" "shortName"))

(defun get-account-name (account)
  (if (agets account "leftDebt")
      (or (agets *account-aliases* (agets account "id"))
          (format nil "~A:~A:~A:~A"
                  *account-loan-prefix*
                  (agets account "type" "id")
                  (agets account "id")
                  (get-account-currency account)))
      (or (agets *account-aliases* (agets account "cba"))
          (when-let (name (agets account "name"))
            (format nil "~A:~A" *account-default-prefix* name))
          (format nil "~A:~A:~A:~A"
                  *account-default-prefix*
                  (agets account "type" "name")
                  (agets account "cba")
                  (get-account-currency account)))))

(defun get-transaction-account (transaction accounts)
  (let ((relation (agets transaction "relation"))
        (related-id (agets transaction "relatedId")))
    (cond
      ((equal relation "ACCOUNT")
       (find related-id accounts :test 'equal :key (agetter "id")))
      ((equal relation "CARD")
       (some (lambda (acc)
               (when (find related-id (agets acc "cards") :test 'equal :key (agetter "id"))
                 acc))
             accounts)))))

(defvar *default-payee* "Raiffeisen")
(defun get-move-payee (move)
  (or (agets move "merchant")
      *default-payee*))

(defun get-move-description (move)
  (agets move "note"))

(defun get-move-account2 (move)
  (let ((category (agets move "categoryId"))
        (category-id (agets move "parentCategoryId")))
    (cond
      ((agets *move-categories* category-id))
      ((equal category "ATM") *account-cash*)
      (t (format nil "~A~@[:~A~]"
                 (if (> (agets move "amount") 0) "income" "expenses") category)))))

(defun short-date (date)
  (cl-ppcre:regex-replace-all "-" (subseq date 0 10) "/"))

(defun move->entry (move)
  (let* ((account (agets move "account"))
         (account1 (get-account-name account))
         (account2 (get-move-account2 move))
         (currency (agets move "currency" "shortName"))
         (bill-currency (agets move "billCurrency" "shortName"))
         (date (pta-ledger:parse-date (short-date (agets move "date"))))
         (payee (get-move-payee move))
         (description (get-move-description move))
         (amount (agets move "amount"))
         (bill-amount (agets move "billAmount")))
    (pta-ledger:make-entry
     :date date
     :description payee
     :comment description
     :postings (list
                (pta-ledger:make-posting
                 :account account2
                 :amount (pta-ledger:make-amount
                          :quantity (* amount -1)
                          :commodity currency)
                 :total-price (unless (equal currency bill-currency)
                                (pta-ledger:make-amount
                                 :quantity (* bill-amount -1)
                                 :commodity bill-currency)))
                (pta-ledger:make-posting
                 :account account1
                 :amount (pta-ledger:make-amount
                          :quantity bill-amount
                          :commodity bill-currency))))))

(defun account->balance (account)
  (let ((left-debt (agets account "leftDebt")))
    (format nil "; balance ~A = ~,2F ~A"
            (get-account-name account)
            (if left-debt (* -1 left-debt) (agets account "balance"))
            (get-account-currency account))))


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

(defun format-balance (accounts)
  (format nil "```~%~{~A~^~%~}```" (mapcar #'account->balance accounts)))

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

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

(defun get-chat-last-n-entries (chat-id &optional (count 10))
  (with-chat-credentials (chat-id)
    (let ((accounts (^account))
          (transactions (remove nil (agets (^transaction :size count) "list")
                                :key (agetter "type"))))
      (sort (loop for tr in transactions
               collect (move->entry (append tr (list (cons "account" (get-transaction-account tr accounts))))))
            #'< :key #'pta-ledger:entry-date))))

(defun get-chat-accounts (chat-id)
  (with-chat-credentials (chat-id)
    (concatenate 'list (^account) (^loan))))

(defcron process-raiffeisen (:minute '(member 0 5 10 15 20 25 30 35 40 45 50 55))
  (dolist (chat-id (lists-get :raiffeisen))
    (let* ((old (gethash chat-id *last-entries*))
           (new (get-chat-last-n-entries chat-id 20))
           (changes (sort (set-difference new old :test #'equalp)
                          #'< :key #'pta-ledger:entry-date))
           (ledger-package (find-package :chatikbot.plugins.ledger)))
      (when changes
        (log:info changes)
        (when old
          (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 (merge 'list old changes #'< :key #'pta-ledger:entry-date)))
          (setf (gethash chat-id *last-entries*)
                (subseq merged (max (- (length merged) 200) 0))))))))

(def-message-cmd-handler handler-raif (:raif)
  (let ((arg (car args)))
    (if (string= arg "bal")
        (bot-send-message chat-id (format-balance (get-chat-accounts chat-id)) :parse-mode "markdown")
        (let ((last (get-chat-last-n-entries chat-id (if arg (parse-integer arg) 10))))
          (bot-send-message chat-id (format-entries last) :parse-mode "markdown")))))