|
|
@@ -0,0 +1,184 @@
|
|
|
+(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))))))
|
