Raiffeisen ws -> ledger

raif.lisp

@@ -0,0 +1,207 @@
+(uiop:define-package :enikesha-scripts/raif
+  (:use :cl)
+  (:mix :uiop :drakma :cl-ppcre :cxml-stp)
+  (:export
+   #:main))
+
+(in-package :enikesha-scripts/raif)
+
+(defvar *raif-ws* "https://connect.raiffeisen.ru/Mobile-WS/services/" "Base WS URL")
+(defvar *ua* "Dalvik/2.1.0 (Linux; U; Android 6.0.1; ONE A2003 Build/MMB29M) Android/3.19.0(459)" "User agent")
+(defvar *cookie-jar* (make-instance 'drakma:cookie-jar) "Default cookie jar")
+(defvar *soap-dom* (cxml:parse "<?xml version='1.0' encoding='UTF-8' standalone='yes' ?><soapenv:Envelope xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" xmlns:xsd=\"http://entry.rconnect/xsd\" xmlns:ser=\"http://service.rconnect\" xmlns:soapenv=\"http://schemas.xmlsoap.org/soap/envelope/\" xmlns:soapenc=\"http://schemas.xmlsoap.org/soap/encoding/\"><soapenv:Header /><soapenv:Body></soapenv:Body></soapenv:Envelope>" (stp:make-builder)) "XML SOAP raif service envelope")
+(defparameter +ns-soap-env+ "http://schemas.xmlsoap.org/soap/envelope/" "Soap envelope xmlns")
+(defparameter +ns-rconnect+ "http://service.rconnect" "Service r-connect xmlns")
+(defparameter +ct-xml+ "text/xml;charset=UTF-8" "XML Content-Type")
+(defvar *rc-auth-service* "RCAuthorizationService")
+(defvar *rc-account-service* "RCAccountService")
+
+(defun reset-cookie ()
+  (setf *cookie-jar* (make-instance 'drakma:cookie-jar)))
+
+(defun get-service-url (service-name)
+  (concatenate 'string *raif-ws* service-name))
+
+(defun soap-request-serialize (body)
+  (let* ((doc (stp:copy *soap-dom*))
+         (n-body (stp:find-recursively-if (stp:of-name "Body" +ns-soap-env+) doc)))
+    (stp:append-child n-body body)
+    (stp:serialize doc (cxml:make-string-sink))))
+
+(defun %rs/login (login password)
+  (let ((n-method (stp:make-element "ser:login" +ns-rconnect+))
+        (n-login (stp:make-element "login"))
+        (n-password (stp:make-element "password")))
+    (stp:append-child n-login (stp:make-text login))
+    (stp:append-child n-password (stp:make-text password))
+    (stp:append-child n-method n-login)
+    (stp:append-child n-method n-password)
+    n-method))
+
+(defun %r-call (service request)
+  (multiple-value-bind (body code)
+      (drakma:http-request (get-service-url service)
+                           :method :post
+                           :content (soap-request-serialize request)
+                           :content-type +ct-xml+
+                           :cookie-jar *cookie-jar*
+                           :user-agent *ua*
+                           :external-format-in :utf-8
+                           :external-format-out :utf-8
+                           :additional-headers `(("SOAPAction" . "")))
+    (values (stp:first-child
+             (stp:find-recursively-if
+              (stp:of-name "Body" +ns-soap-env+)
+              (cxml:parse body (stp:make-builder))))
+            code)))
+
+(defun rc/perform-login (login password)
+  (reset-cookie)
+  (multiple-value-bind (info code)
+      (%r-call *rc-auth-service* (%rs/login login password))
+    (if (= code 200)
+        info
+        (error "Login error"))))
+
+(defun rc/get-batch-response ()
+  (multiple-value-bind (res code)
+      (%r-call *rc-auth-service* (make-element "ser:getBatchResponse" +ns-rconnect+))
+    (when (= code 200)
+      res)))
+
+(defun get-accounts (batch-response)
+  (stp:filter-recursively (stp:of-name "accounts") batch-response))
+
+(defun %rs/get-last-account-movements (account count)
+  (let ((n-method (stp:make-element "ser:GetLastAccountMovements" +ns-rconnect+))
+        (n-account (stp:copy account))
+        (n-count (stp:make-element "count")))
+    (setf (stp:local-name n-account) "account")
+    (stp:append-child n-count (stp:make-text (princ-to-string count)))
+    (stp:append-child n-method n-account)
+    (stp:append-child n-method n-count)
+    n-method))
+
+(defun rc/get-last-account-movements (account count)
+  (multiple-value-bind (info code)
+      (%r-call *rc-account-service* (%rs/get-last-account-movements account count))
+    (when (= code 200)
+      (stp:filter-recursively (stp:of-name "return") info))))
+
+
+(defun %rs/get-account-movements (account start-date end-date)
+  (let ((n-method (stp:make-element "ser:GetAccountMovements" +ns-rconnect+))
+        (n-account (stp:copy account))
+        (n-start-date (stp:make-element "startDate"))
+        (n-end-date (stp:make-element "endDate")))
+    (setf (stp:local-name n-account) "account")
+    (stp:append-child n-start-date (stp:make-text start-date))
+    (stp:append-child n-end-date (stp:make-text end-date))
+    (stp:append-child n-method n-account)
+    (stp:append-child n-method n-start-date)
+    (stp:append-child n-method n-end-date)
+    n-method))
+
+(defun rc/get-account-movements (account start-ut end-ut)
+  (labels ((format-ut (ut)
+             (multiple-value-bind (sec min hour day month year)
+                 (decode-universal-time ut)
+               (format nil "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0D.0"
+                       year month day hour min sec))))
+    (multiple-value-bind (info code)
+        (%r-call *rc-account-service*
+                 (%rs/get-account-movements account
+                                            (format-ut start-ut)
+                                            (format-ut end-ut)))
+      (when (= code 200)
+        (stp:filter-recursively (stp:of-name "return") info)))))
+
+"<startDate>2017-05-09T16:57:23.0</startDate><endDate>2017'
+     b'-05-16T16:57:23.0</endDate>"
+
+(defun tag->keyword (tag)
+  (setf tag (cl-ppcre:regex-replace-all "([a-z])([A-Z])" tag '(0 "-" 1)))
+  (setf tag (cl-ppcre:regex-replace-all "_" tag "-"))
+  (intern (string-upcase tag) :keyword))
+
+(defun node->alist (node)
+  (let (res)
+    (stp:do-children (child node (nreverse res))
+      (push (cons (tag->keyword (stp:local-name child))
+                  (stp:string-value child))
+            res))))
+
+(defun aget (alist &rest keys)
+  (loop for key in keys
+     for ret = (cdr (assoc key alist :test #'equal)) then (cdr (assoc key ret :test #'equal))
+     finally (return ret)))
+
+(defun get-account-name (account)
+  (let ((num (aget account :number)))
+    (concatenate 'string "assets:Raiffeisen:"
+                 (cond
+                   ((string= num "40817810503000266700") "Debit")
+                   ((string= num "40817978803000110883") "Savings:EUR")
+                   ((string= num "40817810203001534278") "Savings:Renov")
+                   ((string= num "40817810103001667025") "Savings:For credit")
+                   (:overwise (concatenate 'string
+                                           (aget account :account-type)
+                                           ":"
+                                           num
+                                           ":"
+                                           (aget account :currency)))))))
+
+(defun get-move-payee (move)
+  (aget move :short-description))
+
+(defun get-move-description (move)
+  (let ((full (aget move :full-description)))
+    (unless (or (zerop (length full))
+                (string= "CARD **" (subseq full 0 (min (length full) 7))))
+      (cl-ppcre:regex-replace-all "\\s" full " "))))
+
+(defun get-move-account2 (move)
+  (if (string= "1" (aget move :type))
+      "income" "expenses"))
+
+(defun short-date (date)
+  (cl-ppcre:regex-replace-all "-" (subseq date 0 10) "/"))
+
+(defun moves->journal (account moves)
+  (let ((account1 (get-account-name account))
+        (currency (aget account :currency))
+        entries)
+    (loop for move in moves
+       for date = (short-date (aget move :commit-date))
+       for payee = (get-move-payee move)
+       for description = (get-move-description move)
+       for id = (aget move :id)
+       for amount = (aget move :amount)
+       for account2 = (get-move-account2 move)
+       for expense = (equal "0" (aget move :type))
+       do (push (format nil "~A~@[ (~A)~] ~A~@[ ; ~A~]~%    ~37A  ~A~A ~A~%    ~37A  ~A~A ~A"
+                        date nil payee description
+                        account1 (if expense "-" " ") amount currency
+                        account2 (if expense " " "-") amount currency)
+                entries))
+    ;; Total account balance
+    (push (format nil "; balance ~A ~A  = ~A"
+                  (short-date (aget account :balance-date))
+                  account1
+                  (aget account :balance))
+          entries)
+    (nreverse entries)))
+
+(defun main (argv)
+  (destructuring-bind (type login pass) argv
+    (rc/perform-login login pass)
+    (let* ((accounts (get-accounts (rc/get-batch-response)))
+           (now (get-universal-time))
+           (week-ago (- now (* 60 60 24 7)))
+           (moves (mapcar (lambda (a) (cons (node->alist a)
+                                            (mapcar #'node->alist
+                                                    (if (string= type "last")
+                                                        (nreverse (rc/get-last-account-movements a 10))
+                                                        (rc/get-account-movements a week-ago now)))))
+                          accounts)))
+      (format t "~{~A~^~%~%~}~%" (loop for (a . m) in moves append (moves->journal a m))))))