[bank] ->entry

plugins/raiffeisen.lisp

@@ -4,7 +4,7 @@
 (in-package :chatikbot.plugins.raiffeisen)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :cxml-stp))
+  (ql:quickload '(:cxml-stp :pta-ledger)))
 
 (defvar *raif-ws* "https://connect.raiffeisen.ru/Mobile-WS/services/" "Base WS URL")
 (defvar *ua* "Dalvik/2.1.0 (Linux; U; Android 6.0.1; ONE A2003 Build/MMB29M) Android/3.19.0(459)" "User agent")
@@ -175,77 +175,98 @@
 (defun short-date (date)
   (cl-ppcre:regex-replace-all "-" (subseq date 0 10) "/"))
 
-(defun move->journal (move)
+(defun move->entry (move)
   (let* ((account (agets move :account))
          (account1 (get-account-name account))
          (account2 (get-move-account2 move))
          (currency (get-account-currency account))
-         (date (short-date (agets move :commit-date)))
+         (date (pta-ledger:parse-date (short-date (agets move :commit-date))))
          (payee (get-move-payee move))
          (description (get-move-description move))
          (amount (parse-float (agets move :amount)))
          (expense (equal "0" (agets move :type))))
-    (format nil "~A~@[ (~A)~] ~A~@[ ; ~A~]~%    ~37A  ~A~,2F ~A~%    ~37A  ~A~,2F ~A"
-            date nil payee description
-            account2 (if expense " " "-") amount currency
-            account1 (if expense "-" " ") amount currency)))
+    (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 (if expense 1 -1))
+                          :commodity currency))
+                (pta-ledger:make-posting
+                 :account account1
+                 :amount (pta-ledger:make-amount
+                          :quantity (* amount (if expense -1 1))
+                          :commodity currency))))))
 
-(defun move->balance (move)
-  (let ((account (agets move :account)))
-    (format nil "; balance ~A ~A  = ~,2F ~A"
-            (short-date (agets account :balance-date))
-            (get-account-name account)
-            (parse-float (agets account :balance))
-            (get-account-currency account))))
+(defun account->balance (account)
+  (format nil "; balance ~A ~A  = ~,2F ~A"
+          (short-date (agets account :balance-date))
+          (get-account-name account)
+          (parse-float (agets account :balance))
+          (get-account-currency account)))
 
 
 (defun get-last-n-movements (&optional (count 10))
   (loop for account in (get-accounts (rc/get-batch-response))
-     append (loop for move in (nreverse (rc/get-last-account-movements account count))
+     append (loop for move in (rc/get-last-account-movements account count)
                collect (cons (cons :account (node->alist account t))
                              (node->alist move)))))
 
 (defun get-last-movements (begin-ut end-ut)
   (loop for account in (get-accounts (rc/get-batch-response))
-     append (loop for move in (nreverse (rc/get-account-movements account begin-ut end-ut))
+     append (loop for move in (rc/get-account-movements account begin-ut end-ut)
                collect (cons (cons :account (node->alist account t))
                              (node->alist move)))))
 
-(defun format-changes (movements)
-  (format nil "```~%~{~A~^~%~%~}```"
-          (append (mapcar #'move->journal movements)
-                  (list (move->balance (car (last movements)))))))
+(defun format-changes (entries)
+  (format nil "```~%~{~A~^~%~%~}```" (mapcar #'pta-ledger:render entries)))
+
+(defun format-balance (accounts)
+  (format nil "```~%~{~A~^~%~}```" (mapcar #'account->balance accounts)))
 
 ;; Cron
-(defvar *last-movements* (make-hash-table) "Last per-chat movements")
+(defvar *last-entries* (make-hash-table) "Last per-chat entries")
 (defvar *cookie-jars* (make-hash-table) "Per-chat cookie jars")
 
-(defun get-chat-last-movements (chat-id &optional (offset +day+))
-  (let* ((*cookie-jar* (or (gethash chat-id *cookie-jars*)
-                           (cl-cookie:make-cookie-jar)))
-         (*credentials-provider* (lambda (authenticator)
-                                   (with-secret (login-pass (list :raiffeisen chat-id))
+(defmacro with-chat-credentials ((chat-id) &body body)
+  `(let* ((*cookie-jar* (or (gethash ,chat-id *cookie-jars*)
+                            (cl-cookie:make-cookie-jar)))
+          (*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)))))
-         (now (get-universal-time))
-         (pre (- now offset))
-         (new (get-last-movements pre now)))
-      (when new
-        (setf (gethash chat-id *cookie-jars*) *cookie-jar*))
-      new))
+                                         (error "no raiffeisen credentials for ~A" ,chat-id))))))
+     (prog1 (progn ,@body)
+       (setf (gethash chat-id *cookie-jars*) *cookie-jar*))))
+
+(defun get-chat-last-entries (chat-id &optional (offset +day+))
+  (with-chat-credentials (chat-id)
+    (let* ((now (get-universal-time))
+           (pre (- now offset)))
+      (sort (mapcar #'move->entry (get-last-movements pre now))
+            #'< :key #'pta-ledger:entry-date))))
+
+(defun get-chat-accounts (chat-id)
+  (with-chat-credentials (chat-id)
+    (mapcar #'node->alist (get-accounts (rc/get-batch-response)))))
 
 (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-movements*))
-          (new (get-chat-last-movements chat-id (* 7 +day+))))
+    (let ((old (gethash chat-id *last-entries*))
+          (new (get-chat-last-entries chat-id (* 7 +day+))))
       (when new
-        (log:info "Got ~A raif events" (length new))
         (when old
           (alexandria:when-let (changes (set-difference new old :test #'equal))
+            (log:info changes)
             (bot-send-message chat-id (format-changes changes) :parse-mode "markdown")))
-        (setf (gethash chat-id *last-movements*) new)))))
+        (setf (gethash chat-id *last-entries*) new)))))
 
 (def-message-cmd-handler handler-raif (:raif)
-  (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")))
+  (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-entries chat-id (* (if arg (parse-integer arg) 7) +day+))))
+          (bot-send-message chat-id (format-changes last) :parse-mode "markdown")))))

plugins/tinkoff.lisp

@@ -3,6 +3,9 @@
   (:use :cl :chatikbot.common))
 (in-package :chatikbot.plugins.tinkoff)
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :pta-ledger))
+
 (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")
@@ -121,11 +124,10 @@
                           "income:" "expenses:")
                       (agets op "category" "name"))))))
 
-(defun ops->journal (ops)
+(defun ops->entry (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 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")
@@ -136,12 +138,25 @@
      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)))
+     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)
@@ -149,37 +164,62 @@
                   :end (* 1000 (universal-to-unix-time end-ut))))
 
 ;; Cron
-(defvar *last-movements* (make-hash-table) "Last per-chat movements")
+(defvar *last-entries* (make-hash-table) "Last per-chat entries")
 (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))
+(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)))))
-         (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)))
+                                         (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)
+  (format nil "```~%~{~A~^~%~%~}```" (mapcar #'pta-ledger:render changes)))
+
+(defun format-accounts (accounts)
+  (with-output-to-string (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")))))
 
 (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))))
+    (let ((old (gethash chat-id *last-entries*))
+          (new (get-chat-last-entries 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)))))
+            (log:info changes)
+            (bot-send-message chat-id (format-entries changes) :parse-mode "markdown")))
+        (setf (gethash chat-id *last-entries*) 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")))
+  (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")))))