chatikbot/nalunch.lisp

(in-package #:chatikbot)

(defvar *nalunch-username* nil "Username")
(defvar *nalunch-password* nil "Password")
(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"
  "Mobile UA")
(defparameter +nalunch-mobile+ (puri:uri "https://www.nalunch.ru/Mobile/"))
(defparameter +nalunch-login+ (puri:uri "https://www.nalunch.ru/Mobile/Account/Login"))
(defparameter +basicdata-calend+ (puri:uri "http://basicdata.ru/api/json/calend/"))

(defun nalunch-auth (&optional body)
  (let* ((body (or body
                   (drakma:http-request +nalunch-login+ :cookie-jar *nalunch-cookie-jar* :user-agent +mobile-ua+)))
         (dom (plump:parse body))
         (form (plump:get-element-by-id dom "LoginForm"))
         (parameters
          (loop for input in (get-by-tag form "input")
             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+
                                        :method :post
                                        :parameters parameters
                                        :cookie-jar *nalunch-cookie-jar*
                                        :user-agent +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 +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))))))

      (list (cons :balance balance)
            (cons :recent recent)))))

(defun 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*))

(defun get-working-days (year month)
  (let* ((exceptions (aget (princ-to-string month) (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)
       for dof = (local-time:timestamp-day-of-week ts)
       for exc = (aget "isWorking" (aget (princ-to-string day) exceptions))
       when (or (and (<= 1 dof 5)
                     (not (equal 2 exc)))
                (and (or (= dof 0) (= dof 6))
                     (or (equal 0 exc)
                         (equal 3 exc))))
       collect day)))

(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))))))
    (format nil "🍴 Баланс ~A руб~@[ на ~A дней, по ~$ руб~].~{~&~A~}"
            balance left-working-days (/ balance (max left-working-days 1))
            (mapcar (lambda (meal) (format nil "~A @ ~A — ~A руб."
                                           (aget :time meal) (aget :place meal) (aget :price meal)))
                    recent))))

;; Cron
(defvar *nalunch-last-result* nil "Last check result")
(defun process-nalunch ()
  (handler-case
      (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)))
    (error (e) (log:error "~A" e))))

;; Hooks
(def-message-cmd-handler handler-cmd-nalunch (:nalunch)
  (if (member chat-id *admins*)
      (send-response chat-id (nalunch-format
                              (or *nalunch-last-result*
                                  (setf *nalunch-last-result*
                                        (nalunch-recent)))))
      (send-dont-understand chat-id)))