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