enikesha-scripts/raif.lisp

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