chatikbot/plugins/ofd.lisp

(in-package :cl-user)
(defpackage chatikbot.plugins.ofd
  (:use :cl :chatikbot.common :alexandria))
(in-package :chatikbot.plugins.ofd)

(defparameter +api-root+ "https://proverkacheka.nalog.ru:9999/v1/")

(defmethod poller-request ((module (eql :ofd)) method &rest params)
  (handler-case
    (json-request (concatenate 'string +api-root+ method)
                  :basic-auth *poller-token*
                  :headers '((:device-id . "bot") (:device-os . "lisp"))
                  :parameters (rest-parameters params t))
    (dex:http-request-failed (e) e)))

(defmethod poller-validate ((module (eql :ofd)) response)
  (not (typep response 'dex:http-request-failed)))

(defmethod poller-get-token ((module (eql :ofd)) secret)
  (let* ((*poller-token* secret))
    (ignore-errors
      (poller-request :ofd "mobile/users/login")
      *poller-token*)))

(defun login ()
  (poller-request :ofd "mobile/users/login"))

(defun cheque-check (fn fd fp n date sum)
  (handler-case
      (let ((res (poller-call :ofd
                  (format nil "ofds/*/inns/*/fss/~A/operations/~A/tickets/~A" fn n fd)
                  :|fiscalSign| fp
                  :|date| date
                  :|sum| sum)))
    (typecase res
      (dex:http-request-not-acceptable nil)
      (t (error res))))
    (end-of-file () t)))

(defun cheque-get (fn fd fp)
  (handler-case
      (let ((res (poller-call :ofd
                  (format nil "inns/*/kkts/*/fss/~A/tickets/~A" fn fd)
                  :|fiscalSign| fp
                  :|sendToEmail| "no")))
    (typecase res
      (list (agets res "document" "receipt"))
      (dex:http-request-not-acceptable nil)
      (t res)))
    (end-of-file () nil)))

(defun receive (fn fd fp n date sum)
  (ignore-errors (login))
  (when (handler-case (cheque-check fn fd fp n date sum)
          (dex:http-request-internal-server-error ()
            (ignore-errors (cheque-check fn fd fp n date sum)))
          (error (e) (log:warn e) nil))
    (or (cheque-get fn fd fp)
        (cheque-get fn fd fp)
        (cheque-get fn fd fp))))

(defparameter +qr-re+ (cl-ppcre:create-scanner "t=(\\d{8}T\\d{4,6})&s=(\\d+(?:\\.\\d{2})?)&fn=(\\d{16})&i=(\\d{0,10})&fp=(\\d{0,10})&n=(1|2)"))

(defun parse-qt (str)
  (multiple-value-bind (matched groups)
      (cl-ppcre:scan-to-strings +qr-re+ str)
    (when matched
      (destructuring-bind (date sum fn fd fp n) (coerce groups 'list)
        (list (parse-integer fn) (parse-integer fd) (parse-integer fp)
              (parse-integer n) date (round (* 100 (parse-float sum))))))))

(defvar *default-currency* "RUB")
(defvar *default-expense-account* "expenses")
(defvar *default-asset-account* "assets:Cash:RUB")
(defun expense-account (name &optional user address)
  (declare (ignorable name user address))
  *default-expense-account*)

(defun expense-comment (name &optional user address price quantity sum)
  (declare (ignorable name user address price quantity sum))
  (format nil "item: ~A~@[, ~A @ ~A~]"
          name
          (unless (= quantity 1) quantity)
          (unless (= quantity 1) (/ price 100))))

(defun asset-account (&optional user address)
  (declare (ignorable user address))
  *default-asset-account*)

(defun cheque->entry (c)
  (let ((total-sum (agets c "totalSum"))
        (date (local-time:timestamp-to-universal
               (local-time:parse-timestring (agets c "dateTime") )))
        (user (or (agets c "retailPlace")
                  (agets c "user")
                  (format nil "ИНН ~A" (agets c "userInn"))))
        (address (agets c "retailPlaceAddress"))
        (items (agets c "items")))
    (pta-ledger:make-entry
     :date date
     :description user
     :comment (when address (format nil "address: ~A" address))
     :postings (append (loop for i in items
                          collect
                            (let ((name (agets i "name"))
                                  (price (agets i "price"))
                                  (quantity (agets i "quantity"))
                                  (sum (agets i "sum")))
                              (pta-ledger:make-posting
                               :account (expense-account name user address)
                               :comment (expense-comment name user address price quantity sum)
                               :amount (pta-ledger:make-amount
                                        :quantity (/ sum 100)
                                        :commodity *default-currency*))))
                       (list (pta-ledger:make-posting
                              :account (asset-account user address)
                              :amount (pta-ledger:make-amount
                                       :quantity (* -1 (/ total-sum 100))
                                       :commodity *default-currency*)))))))


(defun handle-auth (login pass)
  (handler-case
      (progn
        (poller-authenticate :ofd (cons login pass)))
    (poller-cant-authenticate ()
      (bot-send-message "Чот не смог, пропробуй другие."))))

(def-message-cmd-handler handler-ofd (:ofd)
  (cond
    ((= 2 (length *args*)) (apply 'handle-auth *args*))
    (:otherwise (bot-send-message "/ofd <login> <pass>"))))

(def-message-handler ofd-handler (-10)
  (let ((parsed (parse-qt *text*)))
    (when parsed
      (let ((cheque (apply #'receive parsed)))
        (if cheque
            (let ((ledger-package (find-package :chatikbot.plugins.ledger))
                  (entry (cheque->entry cheque)))
              (if ledger-package
                  (let ((new-chat-entry (symbol-function
                                         (intern "LEDGER/NEW-CHAT-ENTRY" ledger-package))))
                    (funcall new-chat-entry *chat-id* (pta-ledger:clone-entry entry)))
                  (bot-send-message (pta-ledger:render entry) :parse-mode "markdown")))
            (bot-send-message "Не смог в чек :(")))
      t)))