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