(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://amobile.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")))) (defparameter +raif-rest-url+ "https://amobile.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 (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 (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 (format-entries last) :parse-mode "markdown")))))