[ofd] pta-ledger entry, bot parsing

plugins/ofd.lisp

@@ -9,7 +9,7 @@
   (handler-case
     (json-request (concatenate 'string +api-root+ method)
                   :basic-auth *poller-token*
-		  :headers '((:device-id . "bot") (:device-os . "lisp"))
+                  :headers '((:device-id . "bot") (:device-os . "lisp"))
                   :parameters (rest-parameters params t))
     (dex:http-request-failed (e) e)))
 
@@ -22,29 +22,126 @@
       (poller-request :ofd "mobile/users/login")
       *poller-token*)))
 
-(defun auth (user pass)
-  (poller-authenticate :ofd (cons user pass)))
+(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))))
+                  (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)))
+                  (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)))