[nalunch] multi-user and minor refactoring

plugins/nalunch.lisp

@@ -1,20 +1,16 @@
 (in-package #:chatikbot)
 
-(defsetting *nalunch-username* nil "Username")
-(defsetting *nalunch-password* nil "Password")
+(defvar *nalunch/calend* nil "Working calendar exceptions")
 
-(defvar *nalunch-cookie-jar* (make-instance 'drakma:cookie-jar) "Cookie storage")
-(defvar *nalunch-calend* nil "Working calendar exceptions")
-
-(defparameter +mobile-ua+ "Mozilla/5.0 (Linux; Android 4.4.4; Nexus 5 Build/KTU84P) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/38.0.2125.114 Mobile Safari/537.36"
+(defparameter +nalunch/mobile-ua+ "Mozilla/5.0 (Linux; Android 4.4.4; Nexus 5 Build/KTU84P) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/38.0.2125.114 Mobile Safari/537.36"
   "Mobile UA")
-(defparameter +nalunch-mobile+ "https://www.nalunch.ru/Mobile/")
-(defparameter +nalunch-login+ "https://www.nalunch.ru/Mobile/Account/Login")
-(defparameter +basicdata-calend+ "http://basicdata.ru/api/json/calend/")
+(defparameter +nalunch/mobile-uri+ "https://www.nalunch.ru/Mobile/")
+(defparameter +nalunch/login-uri+ "https://www.nalunch.ru/Mobile/Account/Login")
+(defparameter +nalunch/basicdata-calend+ "http://basicdata.ru/api/json/calend/")
 
-(defun nalunch-auth (&optional body)
+(defun nalunch/auth (login pass cookies &optional body)
   (let* ((body (or body
-                   (drakma:http-request +nalunch-login+ :cookie-jar *nalunch-cookie-jar* :user-agent +mobile-ua+)))
+                   (drakma:http-request +nalunch/login-uri+ :cookie-jar cookies :user-agent +nalunch/mobile-ua+)))
          (dom (plump:parse body))
          (form (plump:get-element-by-id dom "LoginForm"))
          (parameters
@@ -22,47 +18,48 @@
              for name = (plump:get-attribute input "name")
              for value = (plump:get-attribute input "value")
              when (and name value) collect (cons name value)
-             when (string= name "UserName") collect (cons name *nalunch-username*)
-             when (string= name "Password") collect (cons name *nalunch-password*)))
-         (response (drakma:http-request +nalunch-login+
+             when (string= name "UserName") collect (cons name login)
+             when (string= name "Password") collect (cons name pass)))
+         (response (drakma:http-request +nalunch/login-uri+
                                         :method :post
                                         :parameters parameters
-                                        :cookie-jar *nalunch-cookie-jar*
-                                        :user-agent +mobile-ua+)))
+                                        :cookie-jar cookies
+                                        :user-agent +nalunch/mobile-ua+)))
     (when (search "id=\"LoginForm\"" response)
       (error "Bad username or password"))
     response))
 
-(defun nalunch-recent ()
-  (multiple-value-bind (body status headers uri)
-      (drakma:http-request +nalunch-mobile+ :cookie-jar *nalunch-cookie-jar* :user-agent +mobile-ua+)
-    (declare (ignore status headers))
-    (let* ((body (if (puri:uri= uri (puri:uri +nalunch-mobile+))
-                     body
-                     (nalunch-auth body)))
-           (dom (plump:parse body))
-           (balance (parse-integer (plump:text (elt (clss:select ".newswire-header_balance" dom) 0))))
-           (recent (loop for day across (clss:select ".day-feed" dom)
-                      append (loop for el across (clss:select ".media" day)
-                                for date = (select-text ".day-feed_date" day)
-                                for time = (select-text ".transaction_time" el)
-                                for price = (parse-integer (select-text ".transaction_price" el))
-                                for place = (select-text ".transaction-title" el)
-                                collect (list (cons :time (format nil "~A ~A" date time))
-                                              (cons :price price)
-                                              (cons :place place))))))
+(defun nalunch/recent (login pass &optional cookies)
+  (let ((cookies (or cookies (make-instance 'drakma:cookie-jar))))
+    (multiple-value-bind (body status headers uri)
+        (drakma:http-request +nalunch/mobile-uri+ :cookie-jar cookies :user-agent +mobile-ua+)
+      (declare (ignore status headers))
+      (let* ((body (if (puri:uri= uri (puri:uri +nalunch/mobile-uri+))
+                       body
+                       (nalunch/auth login pass cookies body)))
+             (dom (plump:parse body))
+             (balance (parse-integer (plump:text (elt (clss:select ".newswire-header_balance" dom) 0))))
+             (recent (loop for day across (clss:select ".day-feed" dom)
+                        append (loop for el across (clss:select ".media" day)
+                                  for date = (select-text ".day-feed_date" day)
+                                  for time = (select-text ".transaction_time" el)
+                                  for price = (parse-integer (select-text ".transaction_price" el))
+                                  for place = (select-text ".transaction-title" el)
+                                  collect (list (cons :time (format nil "~A ~A" date time))
+                                                (cons :price price)
+                                                (cons :place place))))))
 
-      (list (cons :balance balance)
-            (cons :recent recent)))))
+        (list (cons :balance balance)
+              (cons :recent recent))))))
 
-(defun get-calend (year)
+(defun %nalunch/get-calend (year)
   (setf year (princ-to-string year))
-  (unless (aget year *nalunch-calend*)
-    (setf *nalunch-calend* (aget "data" (json-request +basicdata-calend+))))
-  (aget year *nalunch-calend*))
+  (unless (aget year *nalunch/calend*)
+    (setf *nalunch/calend* (aget "data" (json-request +nalunch/basicdata-calend+))))
+  (aget year *nalunch/calend*))
 
-(defun get-working-days (year month)
-  (let* ((exceptions (aget (princ-to-string month) (get-calend year)))
+(defun %nalunch/get-working-days (year month)
+  (let* ((exceptions (aget (princ-to-string month) (%nalunch/get-calend year)))
          (days-in-month (local-time:days-in-month month year)))
     (loop for day from 1 upto days-in-month
        for ts = (local-time:encode-timestamp 0 0 0 0 day month year)
@@ -75,14 +72,14 @@
                          (equal 3 exc))))
        collect day)))
 
-(defun nalunch-format (result &optional last)
+(defun %nalunch/format (result &optional last)
   (let* ((balance (aget :balance result))
          (all (aget :recent result))
          (recent (cons (car all) (unless last (cdr all))))
          (now (local-time:now))
          (left-working-days (length (remove-if #'(lambda (d) (<= d (local-time:timestamp-day now)))
-                                               (get-working-days (local-time:timestamp-year now)
-                                                                 (local-time:timestamp-month now))))))
+                                               (%nalunch/get-working-days (local-time:timestamp-year now)
+                                                                          (local-time:timestamp-month now))))))
     (format nil "🍴 Баланс ~A руб~@[ на ~A дней, по ~$ руб~].~{~&~A~}"
             balance left-working-days (/ balance (max left-working-days 1))
             (mapcar (lambda (meal) (format nil "~A @ ~A — ~A руб."
@@ -90,13 +87,24 @@
                     recent))))
 
 ;; Cron
-(defvar *nalunch-last-result* nil "Last check result")
-(defcron process-nalunch (:minute '(member 0 15 30 45))
-  (let ((result (nalunch-recent)))
-    (unless (equal (aget :balance *nalunch-last-result*)
-                   (aget :balance result))
-      (send-response (car *admins*) (nalunch-format result t))
-      (setf *nalunch-last-result* result))))
+(defvar *nalunch/last-results* (make-hash-table) "Last check results")
+(defvar *nalunch/jars* (make-hash-table) "Cookie jars")
+(defcron process-nalunch (:minute '(member 0 10 20 30 40 50))
+  (dolist (chat-id (lists-get :nalunch))
+    (secret/with (login-pass (list :nalunch chat-id))
+      (if login-pass
+          (let* ((cookie-jar (or (gethash chat-id *nalunch/jars*)
+                                 (make-instance 'drakma:cookie-jar)))
+                 (old (gethash chat-id *nalunch/last-results*))
+                 (new (nalunch/recent (car login-pass) (cdr login-pass) cookie-jar)))
+            (when new
+              (when (and old (not (equal old new)))
+                (send-response chat-id (%nalunch/format new t)))
+              (setf (gethash chat-id *nalunch/last-results*) new
+                    (gethash chat-id *nalunch/jars*) cookie-jar)))
+          (progn
+            (log:warn "nalunch no login/pass for" chat-id)
+            (lists-set-entry :nalunch chat-id nil))))))
 
 ;; Hooks
 (def-message-cmd-handler handle-cmd-nalunch (:nalunch)
@@ -106,3 +114,41 @@
                                   (setf *nalunch-last-result*
                                         (nalunch-recent)))))
       (send-dont-understand chat-id)))
+
+(defun nalunch/handle-set-cron (chat-id enable)
+  (lists-set-entry :nalunch chat-id enable)
+  (bot-send-message chat-id
+                    (if enable
+                        "Включил рассылку. '/nalunch off' чтобы выключить, /nalunch - показать последние."
+                        "Без рассылки. '/nalunch on' - включить, /nalunch - последние.")))
+
+(defun nalunch/handle-auth (chat-id login pass)
+  (let ((cookies (make-instance 'drakma:cookie-jar)))
+    (handler-case
+        (progn
+          (nalunch/auth login pass cookies)
+          (secret/set `(:nalunch ,chat-id) (cons login pass))
+          (nalunch/handle-set-cron chat-id t))
+      (error () (bot-send-message chat-id "Чот не смог, пропробуй другие.")))))
+
+(defun nalunch/handle-recent (chat-id)
+  (secret/with (login-pass (list :nalunch chat-id))
+    (bot-send-message chat-id
+                      (if login-pass
+                          (let* ((cookies (or (gethash chat-id *nalunch/jars*)
+                                              (make-instance 'drakma:cookie-jar)))
+                                 (data (nalunch/recent (car login-pass) (cdr login-pass) cookies)))
+                            (if data
+                                (progn
+                                  (setf (gethash chat-id *nalunch/jars*) cookies)
+                                  (%nalunch/format data))
+                                "Не смог получить данные. Попробуй перелогинься. /nalunch <login> <pass>"))
+                          "Нужен логин-пароль. /nalunch <login> <pass>")
+                      :parse-mode "markdown")))
+
+(def-message-cmd-handler handle-cmd-nalunch (:nalunch)
+  (cond
+    ((= 1 (length args))
+     (nalunch/handle-set-cron chat-id (equal "on" (car args))))
+    ((= 2 (length args)) (apply 'nalunch/handle-auth chat-id args))
+    (:otherwise (nalunch/handle-recent chat-id))))

secrets.lisp

@@ -19,19 +19,25 @@
   (handler-case
       (let ((*read-eval* nil))
         (values (read-from-string (%secret/pass "show" path))))
-    (error (e)
-      (log:error "~A" e)
-      (values))))
+    (error () (values))))
 
 (defun secret/set (path value)
   (%secret/pass "insert --force --multiline" path
-                :input (prin1-to-string value)))
+                :input (prin1-to-string value) :output nil :error-output :string))
 
 (defun secret/del (path)
   (%secret/pass "rm --force" path))
 
+(defun secret/wipe (data)
+  (cond
+    ((stringp data) (fill data #\Space))
+    ((vectorp data) (fill data 0))
+    ((consp data)
+     (secret/wipe (car data))
+     (secret/wipe (cdr data)))))
+
 (defmacro secret/with ((var path) &body body)
   `(let ((,var (ignore-errors (secret/get ,path))))
      (unwind-protect
           (progn ,@body)
-       (fill ,var #\Space))))
+       (secret/wipe ,var))))