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 @ ~$~]"
          name
          (unless (= quantity 1) quantity)
          (unless (= quantity 1) (/ price 100))))

(defun expense-posting (item &optional user address)
  (let ((name (agets item "name"))
        (price (agets item "price"))
        (quantity (agets item "quantity"))
        (sum (agets item "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*))))

(defun asset-posting (amount &optional user address)
  (declare (ignorable user address))
  (pta-ledger:make-posting
   :account *default-asset-account*
   :amount (pta-ledger:make-amount
            :quantity (* -1 amount)
            :commodity *default-currency*)))

(defun not-empty (str)
  (unless (string= str "")
    str))

(defun cheque->entry (c)
  (let* ((total-sum (agets c "totalSum"))
         (date (local-time:timestamp-to-universal
                (local-time:parse-timestring (agets c "dateTime"))))
         (inn (not-empty (agets c "userInn")))
         (user (or (not-empty (agets c "retailPlace"))
                   (not-empty (agets c "user"))
                   (format nil "ИНН ~A" inn)))
         (address (not-empty (agets c "retailPlaceAddress")))
         (items (agets c "items")))
    (pta-ledger:make-entry
     :date date
     :description user
     :comment (format nil "~@[inn: ~A~]~@[, address: ~A~]" inn address)
     :postings (append (mapcar #'expense-posting items)
                       (list (asset-posting (/ total-sum 100) user address))))))


(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>"))))

(defvar *chat-next-cheque-handlers* (make-hash-table) "chat cheque handlers")
(defun handle-next-cheque (handler)
  (setf (gethash *chat-id* *chat-next-cheque-handlers*) handler))

(def-message-handler ofd-handler (-10)
  (let ((parsed (parse-qt *text*)))
    (when parsed
      (telegram-send-chat-action *chat-id* "typing")
      (let ((cheque (apply #'receive parsed))
            (handler (gethash *chat-id* *chat-next-cheque-handlers*)))
        (if cheque
            (let ((ledger-package (find-package :chatikbot.plugins.ledger))
                  (entry (cheque->entry cheque)))
              (cond
                (handler
                 (remhash *chat-id* *chat-next-cheque-handlers*)
                 (funcall handler entry))
                (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))))
                (:otherwise (bot-send-message (pta-ledger:render entry) :parse-mode "markdown"))))
            (bot-send-message "Не смог в чек :(")))
      t)))