[gpn] use poller api

plugins/gazprom.lisp

@@ -3,36 +3,29 @@
   (:use :cl :chatikbot.common :alexandria))
 (in-package :chatikbot.plugins.gazprom)
 
-(defparameter +gpn-api-url+ "https://api.gpnbonus.ru/ios/v2/")
+(defparameter +api-uri+ "https://api.gpnbonus.ru/ios/v2/")
 (defvar *api-os* "android")
 (defvar *api-ver* "1.7.4")
-(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 %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)))
+;; poller methods
+(defmethod poller-request ((module (eql :gazprom)) method &rest params)
+  (json-request (concatenate 'string +api-uri+ method)
+                :method (if (equal method "auth.php") :post :get)
+                :parameters (filled (append `(("session" . ,*poller-token*)
+                                              ("os" . ,*api-os*)
+                                              ("ver" . ,*api-ver*))
+                                            (rest-parameters params)))))
+
+(defmethod poller-validate ((module (eql :gazprom)) response)
+  (not (equal (agets response "message") "Необходимо авторизоваться")))
+
+(defmethod poller-authenticate ((module (eql :gazprom)) secret)
+  (destructuring-bind (username password) secret
+    (agets (poller-request :gazprom "auth.php"
+                           :login username
+                           :passw password
+                           :token (get-token username password))
+           "session")))
 
 (defun get-token (login pass)
   (let ((date (format nil "~{~4,'0D~2,'0D~2,'0D~}"
@@ -45,25 +38,12 @@
       :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" . ,(get-token login pass))
-                                   ("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))))
+;; API
+(defun get-card-info ()
+  (poller-call :gazprom "getCardInfo.php"))
+
+(defun get-order (&key (count 20) (offset 0))
+  (poller-call :gazprom "getOrder.php" :count count :offset offset))
 
 ;; Formatting
 (defvar *account-fuel* "expenses:Transport:Car:Gas")
@@ -72,6 +52,7 @@
 (defvar *income-bonus* "income:bonus")
 (defvar *account-bonus* "assets:Gazprom:Bonus")
 (defvar *default-currency* "RUB")
+(defvar *entry-description* "ГазпромНефть")
 
 (defun is-fuel (name)
   (or (equal name "ДТ+")
@@ -145,54 +126,29 @@
   (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")
-
-(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-card (chat-id)
-  (with-chat-credentials (chat-id)
-    (^get-card-info)))
-
-(defun get-chat-last-n-orders (chat-id &optional (count 10))
-  (with-chat-credentials (chat-id)
-    (^get-order :count count)))
-
 (defun prepare-entries (orders)
   (loop for (date . orders) in (group-by orders (agetter "date"))
      collect (orders->entry date orders)))
 
+(defun process-new (changes)
+  (let ((ledger-package (find-package :chatikbot.plugins.ledger))
+        (transactions (prepare-entries changes)))
+    (if ledger-package
+        (let ((new-chat-entry (symbol-function
+                               (intern "LEDGER/NEW-CHAT-ENTRY" ledger-package))))
+          (dolist (entry transactions)
+            (funcall new-chat-entry *chat-id* (pta-ledger:clone-entry entry))))
+        (bot-send-message (format-entries transactions) :parse-mode "markdown"))))
+
 (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-orders *chat-id* 20))
-           (changes (sort (set-difference new old :test #'equalp)
-                          #'< :key (agetter "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 (prepare-entries changes))
-                  (funcall new-chat-entry *chat-id* (pta-ledger:clone-entry entry))))
-              (bot-send-message (format-entries (prepare-entries changes)) :parse-mode "markdown")))
-        (let ((merged (merge 'list old changes #'< :key (agetter "date"))))
-          (setf (gethash *chat-id* *last-entries*)
-                (subseq merged (max (- (length merged) 200) 0))))))))
+  (poller-poll-lists :gazprom
+                     #'get-order
+                     #'process-new
+                     :key (agetter "date")))
 
 (def-message-cmd-handler handler-gazprom (:gpn :gazprom)
   (let ((arg (car *args*)))
-    (if (string= arg "bal")
-        (bot-send-message (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 (format-entries last) :parse-mode "markdown")))))
+    (bot-send-message (if (string= arg "bal")
+                          (format-card (get-card-info))
+                          (format-entries (prepare-entries (get-order :count (if arg (parse-integer arg) 10)))))
+                      :parse-mode "markdown")))