[gazprom] initial

plugins/gazprom.lisp

@@ -0,0 +1,104 @@
+(in-package :cl-user)
+(defpackage chatikbot.plugins.gazprom
+  (:use :cl :chatikbot.common :alexandria))
+(in-package :chatikbot.plugins.gazprom)
+
+(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")
+
+(defun filled (alist)
+  (remove nil alist :key #'cdr))
+
+(defun %api (method &optional params)
+  (let* ((response
+          (json-request (concatenate 'string +gpn-api-url+ method)
+                        :parameters (filled (append `(("session" . ,*session*)
+                                                      ("os" . ,*api-os*)
+                                                      ("ver" . ,*api-ver*))
+                                                    params))))
+         (message (agets response "message")))
+    (if (equal message "Необходимо авторизоваться")
+        (if *credentials-provider*
+          (progn
+            (funcall *credentials-provider*
+                     (lambda (login password)
+                       (setf *session* (^auth login password))))
+            (let (*credentials-provider*) ;; Retry call resetting *credentials-provider* to prevent loop
+              (%api method params)))
+          (error message))
+        response)))
+
+(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*)
+                                   ("os" . ,*api-os*)
+                                   ("ver" . ,*api-ver*))))
+         (status (agets resp "status")))
+    (unless (= status 1)
+      (error (agets resp "message")))
+    (agets resp "session")))
+
+(defun ^get-card-info ()
+  (%api "getCardInfo.php"))
+
+(defun ^get-order (&key (count 20) (offset 0))
+  (%api "getOrder.php" `(("count" . ,count) ("offset" . ,offset))))
+
+;; Cron
+(defvar *last-entries* (make-hash-table) "Last per-chat entries")
+(defvar *sessions* (make-hash-table) "Per-chat sessions")
+
+(defmacro with-chat-credentials ((chat-id) &body body)
+  `(let* ((*session* (gethash ,chat-id *sessions*))
+          (*credentials-provider* (lambda (authenticator)
+                                    (with-secret (login-pass (list :gazprom ,chat-id))
+                                      (if login-pass
+                                          (apply authenticator login-pass)
+                                          (error "no gazprom credentials for ~A" ,chat-id))))))
+     (prog1 (progn ,@body)
+       (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)
+  (with-chat-credentials (chat-id)
+    (concatenate 'list (^account) (^loan))))
+
+(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))
+          (ledger-package (find-package :chatikbot.plugins.ledger)))
+      (when new
+        (when old
+          (when-let (changes (set-difference new old :test #'equalp))
+            (log:info changes)
+            (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"))))
+        (setf (gethash chat-id *last-entries*) new)))))
+
+(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-entries last) :parse-mode "markdown")))))