[gazprom] Full

common.lisp

@@ -59,6 +59,7 @@
            :get-chat-location
            :get-chat-timezone
            :same-time-in-chat
+           :group-by
            :telegram-get-me
            :telegram-send-message
            :telegram-forward-message

plugins/gazprom.lisp

@@ -6,10 +6,14 @@
 (defparameter +gpn-api-url+ "https://api.gpnbonus.ru/ios/v2/")
 (defvar *api-os* "android")
 (defvar *api-ver* "1.7.4")
-(defvar *api-token* "21c733213e747611432154b1bf96e723")
 (defvar *session* nil "Currently active session")
 (defvar *credentials-provider* nil "Active credentials provider")
-
+(defvar *bonus-account* "assets:gazprom:bonus")
+(defvar *assets-account* "assets")
+(defvar *gas-expenses-account* "expenses:transport:car:gas")
+(defvar *other-expenses-account* "expenses:food:snacks")
+(defvar *expenses-currency* "RUB")
+(defvar *entry-description* "ГазпромНефть")
 (defun filled (alist)
   (remove nil alist :key #'cdr))
 
@@ -32,13 +36,24 @@
           (error message))
         response)))
 
+(defun get-token (login pass)
+  (let ((date (format nil "~{~4,'0D~2,'0D~2,'0D~}"
+                      (subseq (reverse (multiple-value-list
+                                        (decode-universal-time
+                                         (get-universal-time) 0)))
+                              3 6))))
+    (crypto:byte-array-to-hex-string
+     (crypto:digest-sequence
+      :md5 (crypto:ascii-string-to-byte-array
+            (concatenate 'string login pass date *api-ver*))))))
+
 (defun ^auth (login pass)
   (let* ((resp
           (json-request (concatenate 'string +gpn-api-url+ "auth.php")
                         :method :post
                         :content `(("login" . ,login)
                                    ("passw" . ,pass)
-                                   ("token" . ,*api-token*)
+                                   ("token" . ,(get-token login pass))
                                    ("os" . ,*api-os*)
                                    ("ver" . ,*api-ver*))))
          (status (agets resp "status")))
@@ -52,6 +67,84 @@
 (defun ^get-order (&key (count 20) (offset 0))
   (%api "getOrder.php" `(("count" . ,count) ("offset" . ,offset))))
 
+;; Formatting
+(defun get-chat-card (chat-id)
+  (with-chat-credentials (chat-id)
+    (^get-card-info)))
+
+(defvar *account-fuel* "expenses:Transport:Car:Gas")
+(defvar *account-other* "expenses:Food:Snacks")
+(defvar *account-asset* "liabilities:Tinkoff:Platinum")
+(defvar *account-bonus* "assets:Gazprom:Bonus")
+(defvar *default-currency* "RUB")
+
+(defun is-fuel (name)
+  (or (equal name "ДТ+")
+      (equal name "Аи-92")
+      (equal name "Аи-95")
+      (equal name "Аи-98")))
+
+(defun get-currency (name)
+  (cond
+    ((or (equal name "Аи-92")
+         (equal name "Аи-95")
+         (equal name "Аи-98")) "BENZ")
+    ((equal name "ДТ+") "DIZ")
+    (t *default-currency*)))
+
+(defun get-account (name)
+  (cond
+    ((is-fuel name) *account-fuel*)
+    (t *account-other*)))
+
+(defun get-expense-posting (order)
+  (let* ((name (agets order "name"))
+         (is-fuel (is-fuel name))
+         (count (parse-float (agets order "count")))
+         (sum (parse-float (agets order "sum")))
+         (currency (get-currency name)))
+    (pta-ledger:make-posting
+     :account (get-account name)
+     :comment name
+     :amount (pta-ledger:make-amount
+              :quantity (if is-fuel count sum)
+              :commodity currency)
+     :unit-price (when is-fuel
+                   (pta-ledger:make-amount
+                    :quantity (/ sum count)
+                    :commodity *default-currency*)))))
+
+(defun orders->entry (date orders)
+  (pta-ledger:make-entry
+   :date (local-time:timestamp-to-universal (local-time:unix-to-timestamp date))
+   :description *entry-description*
+   :postings (loop for (type . orders) in (group-by orders (agetter "type"))
+                for total = 0 then 0
+                for bonus = 0 then 0
+                append (append
+                        (loop for order in orders
+                           do (incf total (parse-float (agets order "sum")))
+                           do (incf bonus (parse-float (agets order "bonus")))
+                           collect (get-expense-posting order))
+                        (list (pta-ledger:make-posting
+                               :account *account-bonus*
+                               :amount (pta-ledger:make-amount
+                                        :quantity bonus :commodity *default-currency*)))
+                        (when (= type 1)
+                          (list (pta-ledger:make-posting
+                                 :account *account-asset*
+                                 :amount (pta-ledger:make-amount
+                                          :quantity (* -1 total) :commodity *default-currency*))))))))
+
+(defun format-card (card)
+  (format nil "Баланс: ~,2F баллов~%Статус: ~A~%Литров в месяце: ~D"
+          (agets card "card_balance")
+          (agets card "card_status")
+          (agets card "amount_current_month_liter")))
+
+(defun format-entries (changes)
+  (text-chunks (mapcar #'pta-ledger:render changes)))
+
 ;; Cron
 (defvar *last-entries* (make-hash-table) "Last per-chat entries")
 (defvar *sessions* (make-hash-table) "Per-chat sessions")
@@ -64,29 +157,24 @@
                                           (apply authenticator login-pass)
                                           (error "no gazprom credentials for ~A" ,chat-id))))))
      (prog1 (progn ,@body)
-       (setf (gethash chat-id *sessions*) *session*))))
+       (setf (gethash ,chat-id *sessions*) *session*))))
 
-(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)
+(defun get-chat-last-n-orders (chat-id &optional (count 10))
   (with-chat-credentials (chat-id)
-    (concatenate 'list (^account) (^loan))))
+    (^get-order :count count)))
+
+(defun prepare-entries (orders)
+  (loop for (date . orders) in (group-by orders (agetter "date"))
+     collect (orders->entry date orders)))
 
 (defcron process-gazprom (:minute '(member 0 5 10 15 20 25 30 35 40 45 50 55))
   (dolist (chat-id (lists-get :gazprom))
     (let ((old (gethash chat-id *last-entries*))
-          (new (get-chat-last-n-entries chat-id 20))
+          (new (get-chat-last-n-orders chat-id 20))
           (ledger-package (find-package :chatikbot.plugins.ledger)))
       (when new
         (when old
-          (when-let (changes (set-difference new old :test #'equalp))
+          (when-let (changes (prepare-entries (set-difference new old :test #'equalp)))
             (log:info changes)
             (if ledger-package
                 (let ((new-chat-entry (symbol-function
@@ -94,11 +182,15 @@
                   (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"))))
-        (setf (gethash chat-id *last-entries*) new)))))
+        (let ((merged (remove-duplicates
+                       (merge 'list old new #'< :key (agetter "date"))
+                       :test 'equalp)))
+          (setf (gethash chat-id *last-entries*)
+                (subseq merged (max 0 (- (length merged) 100)))))))))
 
 (def-message-cmd-handler handler-gazprom (:gpn :gazprom)
   (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-card (get-chat-card chat-id)) :parse-mode "markdown")
+        (let ((last (prepare-entries (get-chat-last-n-orders chat-id (if arg (parse-integer arg) 10)))))
           (bot-send-message chat-id (format-entries last) :parse-mode "markdown")))))

plugins/raiffeisen.lisp

@@ -174,7 +174,7 @@
                                           (apply authenticator login-pass)
                                           (error "no raiffeisen credentials for ~A" ,chat-id))))))
      (prog1 (progn ,@body)
-       (setf (gethash chat-id *tokens*) *access-token*))))
+       (setf (gethash ,chat-id *tokens*) *access-token*))))
 
 (defun get-chat-last-n-entries (chat-id &optional (count 10))
   (with-chat-credentials (chat-id)
@@ -204,11 +204,11 @@
                   (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 (remove-duplicates
-		       (merge 'list old new #'< :key #'pta-ledger:entry-date)
-		       :test 'equalp)))
-	  (setf (gethash chat-id *last-entries*)
-		(subseq merged (max 0 (- (length merged) 40)))))))))
+        (let ((merged (remove-duplicates
+                       (merge 'list old new #'< :key #'pta-ledger:entry-date)
+                       :test 'equalp)))
+          (setf (gethash chat-id *last-entries*)
+                (subseq merged (max 0 (- (length merged) 100)))))))))
 
 (def-message-cmd-handler handler-raif (:raif)
   (let ((arg (car args)))

plugins/tinkoff.lisp

@@ -222,7 +222,11 @@
                   (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"))))
-        (setf (gethash chat-id *last-entries*) new)))))
+        (let ((merged (remove-duplicates
+                       (merge 'list old new #'< :key #'pta-ledger:entry-date)
+                       :test 'equalp)))
+          (setf (gethash chat-id *last-entries*)
+                (subseq merged (max 0 (- (length merged) 100)))))))))
 
 (def-message-cmd-handler handler-tink (:tink)
   (let ((arg (car args)))

utils.lisp

@@ -48,6 +48,7 @@
            :get-chat-location
            :get-chat-timezone
            :same-time-in-chat
+           :group-by
            :message-id
            :from-id
            :chat-id
@@ -408,6 +409,17 @@ is replaced with replacement."
         (current-tz (nth-value 8 (get-decoded-time))))
     (+ ut (* (- chat-tz current-tz) +hour+))))
 
+(defun group-by (list getter)
+  (let (grouped)
+    (loop for item in list
+       for key = (funcall getter item)
+       for group = (agets grouped key)
+       unless group do (let ((new-group (list key)))
+                         (push new-group grouped)
+                         (setf group new-group))
+       do (push item (cdr group)))
+    grouped))
+
 ;; Fix bug in local-time (following symlinks in /usr/share/zoneinfo/
 ;; leads to bad cutoff)
 (in-package #:local-time)