chatikbot/plugins/revolut.lisp

(in-package :cl-user)
(defpackage chatikbot.plugins.revolut
  (:use :cl :chatikbot.common :alexandria))
(in-package :chatikbot.plugins.revolut)

(defparameter +api-domain+ "app.revolut.com")
(defparameter +api-uri+ (format nil "https://~a/api/retail/" +api-domain+))
(defparameter +device-id+ "cb483962-b75c-4e4d-b4da-e5afee9a664c")
(defparameter +user-agent+ "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:100.0) Gecko/20100101 Firefox/100.0")

(defvar *accounts* nil "alist of account aliases, by id")
(defvar *merchant-expenses*
  '(("78c23116-39ff-4ebf-a311-344dbc9d507d" . "expenses:transport:taxi") ; Bolt
    ("239ce793-91a7-47ba-8085-9de84c02b1c6" . "expenses:travel:hotel") ; booking.com
    ("5a3451cf-dc08-4d94-9969-a4d080b7402c" . "expenses:food:fast-food") ; McDonalds
    ))
(defvar *category-expenses*
  '(("56bdc570-99c6-420d-a855-d09dc5eaabc3" . "expenses:food:work")))
(defvar *tag-expenses*
      '(("groceries" . "expenses:food:groceries")
        ("restaurants" . "expenses:food:restaurants")
        ("health" . "expenses:life:health")))

(defvar *topup-accounts*
  '(("Top-Up by *1508" . "assets:rbcz:czk")))
(defvar *fee-account* "expenses:banking:fee")

(defun is-content (rest-method)
  (case rest-method
    ((:post :put) t)))

(defun make-cookie-jar (token)
  (when token         
    (cl-cookie:make-cookie-jar
     :cookies
     (list                             
      (cl-cookie:make-cookie
       :name "credentials"
       :value (base64:string-to-base64-string
               (format nil "~a:~a" (agets token "user" "id")
		       (agets token "accessToken")))
       :domain +api-domain+)
      (cl-cookie:make-cookie
       :name "refresh-token"
       :value (base64:string-to-base64-string
               (format nil "~a:~a" (agets token "user" "id")
		       (agets token "refreshCode")))
       :domain +api-domain+)))))

(defun need-to-refresh-token (method)
  (unless (or (string-equal method "signin")
	      (string-equal method "token"))
    (when-let (expire (agets *poller-token* "tokenExpiryDate"))
      (let* ((expire-ts (local-time:unix-to-timestamp (round expire 1000)))
	     (expire-5-min (local-time:timestamp- expire-ts 5 :minute))
	     (now (local-time:now)))
	(when (local-time:timestamp< expire-5-min now expire-ts)
	  (log:info "Refreshing token" expire-ts)
	  (error 'dex:http-request-unauthorized
		 :method :post :uri (quri:uri "expire")
		 :headers nil :status 422 :body nil))))))

(defmethod poller-request ((module (eql :revolut)) method &rest params)
  (handler-case
      (let* ((uri (if (listp method) (car method) method))             
             (rest-method (if (listp method) (cdr method) :get))
	     (refresh (need-to-refresh-token uri))
             (is-content (is-content rest-method))
	     (cookie-jar (make-cookie-jar *poller-token*))
             (res
               (json-request (concatenate 'string +api-uri+ uri)
                             :headers `((:x-device-id . ,+device-id+)
                                        (:x-browser-application . "WEB_CLIENT"))
                             :user-agent +user-agent+
                             :cookie-jar cookie-jar
                             :method rest-method
                             :json-content is-content
                             (if is-content :content :parameters)
                             (rest-parameters params t))))
        (values res cookie-jar))
    (dex:http-request-failed (e)
      (let ((*print-escape*)) (log:warn "Revolut request failed" e))
      e)))

(defmethod poller-validate ((module (eql :revolut)) response)
  (not (typep response 'dex:http-request-unauthorized)))

(defun signin (phone passcode)
  (let ((sign-res (poller-request :revolut '("signin" . :post)
                                  :|phone| phone
                                  :|channel| "APP"
                                  :|password| passcode)))
    (when (listp sign-res)
      (loop with start = (get-universal-time)
            for res = (poller-request :revolut '("token" . :post)
                                      :|phone| phone
                                      :|password| passcode
                                      :|tokenId| (agets sign-res "tokenId"))
            when (listp res) do (return res)
            unless (= (dex:response-status res) 422) do (return)
            when (> (- (get-universal-time) start) 30) do (return)
              do (sleep 2)))))

(defun get-cookie-value (jar name)
  (when jar
    (let ((cookie (find name (cl-cookie:cookie-jar-cookies jar)
			:from-end t
			:key 'cl-cookie:cookie-name
			:test 'equal)))
      (when cookie (cl-cookie:cookie-value cookie)))))

(defun decode-cookie-token (value)
  (when value
    (let ((decoded (base64:base64-string-to-string value)))
      (when (> (length decoded) 37)
	(subseq decoded 37)))))

(defun refresh-token ()
  (multiple-value-bind (res jar)
      (poller-request :revolut '("token" . :put))
    ;;(let ((*print-escape*)) (log:info "Token refresh" res jar))
    (when (listp res)
      `(("user" . (("id" . ,(agets res "userId"))))
	("tokenExpiryDate" . ,(agets res "expireAt"))
	("accessToken" . ,(decode-cookie-token (get-cookie-value jar "credentials")))
	("refreshCode" . ,(decode-cookie-token (get-cookie-value jar "refresh-token")))))))
 
(defmethod poller-get-token ((module (eql :revolut)) secret)
  (let ((user-id (agets *poller-token* "user" "id"))
        (refresh-code (agets *poller-token* "refreshCode")))
    ;; Try to refresh old token
    (when (and user-id refresh-code)
      (when-let (token (refresh-token))
	(log:info "Refreshed" token)
        (return-from poller-get-token token)))
    ;; Signin for a new token
    (destructuring-bind (phone . passcode) secret
      (let ((token (signin phone passcode)))
	(log:info "Signin" token)
	token))))

(defun get-user ()
  (poller-call :revolut "user/current"))

(defun get-user-portfolio ()
  (poller-call :revolut "user/current/portfolio"))

(defun get-user-features ()
  (poller-call :revolut "user/current/features"))

(defun get-user-wallet ()
  (poller-call :revolut "user/current/wallet"))

(defun get-user-money-boxes ()
  (poller-call :revolut "user/current/money-boxes"))

(defun get-my-card-all ()
  (poller-call :revolut "my-card/all"))

(defun get-currencies (&optional (type "fiat"))
  "Type could be 'fiat', 'crypto' or 'commodity'"
  (poller-call :revolut "currencies" :|type| type))

(defun get-cashback ()
  (poller-call :revolut "cashback"))

(defun get-quote (symbol)
  (poller-call :revolut "quote" :|symbol| symbol))


(defun get-transactions-last (&key (count 10) pocket to)
  (poller-call :revolut "user/current/transactions/last"
               :|count| count
               :|to| to ;; timestamp (startedDate) of last received transaction
               :|internalPocketId| pocket))

(defun get-transactions-vault (&key id)
  (poller-call :revolut "user/current/transactions/vault" :|id| id))

(defun get-transaction (id)
  (poller-call :revolut (format nil "transaction/~a" id)))

(defun get-recurring-payments ()
  (poller-call :revolut "recurring-payments"))

(defparameter +unix-epoch-difference+
  (encode-universal-time 0 0 0 1 1 1970 0))

(defun unix-to-universal-time (unix-time)
  (+ unix-time +unix-epoch-difference+))

(defun universal-to-unix-time (universal-time)
  (- universal-time +unix-epoch-difference+))

(defun get-date (ms)
  (unix-to-universal-time (round ms 1000)))

(defun format-short-date (ms)
  (if ms
   (multiple-value-bind (sec min hour day month year)
       (decode-universal-time (get-date ms))
     (declare (ignore sec min hour))
     (format nil "~4,'0D/~2,'0D/~2,'0D" year month day))
   "-"))

(defun get-amount (amount)
  (/ amount 100))

(defun format-pocket-account (p)
  (when p         
    (let ((cur (string-downcase (agets p "currency"))))
      (concatenate 'string
                   "assets:revolut:"
                   (or (agets *accounts* (agets p "id"))
                       (when (agets p "name") (string-downcase (agets p "name")))
                       (when (equal "SAVINGS" (agets p "type"))
                         (concatenate 'string "savings" cur))
                       cur)))))

(defun format-pocket-balance (p)
  (format nil "; balance ~A ~A = ~,2F ~A"
          (format-short-date (* 1000 (universal-to-unix-time (get-universal-time))))
          (format-pocket-account p)
          (get-amount (agets p "balance"))
          (agets p "currency")))

(defun format-entries (changes)
  (text-chunks (mapcar #'pta-ledger:render (remove nil changes))))

(defun find-pocket (id pockets)
  (find id pockets :key (agetter "id") :test #'equal))

(defun get-expense-account (tr)
  (or (agets *merchant-expenses* (agets tr "merchant" "merchantId"))
      (agets *category-expenses* (agets tr "category"))
      (agets *tag-expenses* (agets tr "tag"))
      (concatenate 'string "expenses:" (agets tr "tag"))))

(defun params-exchange (tr pockets)
  (when (equal "sell" (agets tr "direction"))
    (let ((description (agets tr "description"))
          (rcv-account (format-pocket-account (find-pocket
                                               (agets tr "counterpart" "account" "id")
                                               pockets)))
          (rcv-amount (get-amount (agets tr "counterpart" "amount")))
          (rcv-currency (agets tr "counterpart" "currency"))
          (snd-account (format-pocket-account (find-pocket
                                               (agets tr "account" "id") pockets)))
          (snd-amount (get-amount (agets tr "amount")))
          (snd-currency (agets tr "currency")))         
      (values description nil
              rcv-account rcv-amount rcv-currency
              snd-account snd-amount snd-currency))))

(defun params-topup (tr pockets)
  (let* ((description (agets tr "description"))
         (rcv-account (format-pocket-account (find-pocket
                                              (agets tr "account" "id") pockets)))
         (rcv-amount (get-amount (agets tr "amount")))
         (rcv-currency (agets tr "currency"))
         (snd-account (or (agets *topup-accounts* description) "income"))
         (snd-amount (* -1 rcv-amount))
         (snd-currency rcv-currency))         
    (values description nil
            rcv-account rcv-amount rcv-currency
            snd-account snd-amount snd-currency)))

(defun params-transfer (tr pockets)
  (when (equal "CURRENT" (agets tr "account" "type"))
    (let* ((description (agets tr "description"))
           (snd-account (format-pocket-account (find-pocket (agets tr "account" "id")
                                                            pockets)))
           (snd-amount (get-amount (agets tr "amount")))
           (snd-currency (agets tr "currency"))
           (rcv-account (or (format-pocket-account (find-pocket
                                                    (or
                                                     (agets tr "recipient" "account" "id")
                                                     (agets tr "sender" "account" "id"))
                                                    pockets))
                            (get-expense-account tr)))
           (rcv-amount (* -1 snd-amount))
           (rcv-currency snd-currency))
      (values description nil
              rcv-account rcv-amount rcv-currency
              snd-account snd-amount snd-currency))))

(defun params-atm (tr pockets)
  (let* ((description (agets tr "description"))
         (snd-account (format-pocket-account (find-pocket (agets tr "account" "id")
                                                          pockets)))
         (snd-amount (get-amount (agets tr "amount")))
         (snd-currency (agets tr "currency"))
         (rcv-currency (agets tr "counterpart" "currency"))
         (rcv-amount (* -1 (get-amount (agets tr "counterpart" "amount"))))
         (rcv-account (format nil "assets:cash:~(~a~)" rcv-currency)))         
    (values description nil
            rcv-account rcv-amount rcv-currency
            snd-account snd-amount snd-currency)))

(defun params-fee (tr pockets)
  (let* ((description (agets tr "description"))
         (rcv-account *fee-account*)
         (rcv-amount (* -1 (get-amount (agets tr "amount"))))
         (rcv-currency (agets tr "currency"))
         (snd-account (format-pocket-account (find-pocket (agets tr "account" "id")
                                                          pockets)))
         (snd-amount (* -1 rcv-amount))
         (snd-currency rcv-currency))         
    (values description nil
            rcv-account rcv-amount rcv-currency
            snd-account snd-amount snd-currency)))

(defun params-card-payment (tr pockets)
  (let* ((merchant-name (agets tr "merchant" "name"))
         (tr-description (agets tr "description"))
         (description (or merchant-name tr-description))
         (comment (unless (equal description tr-description) tr-description))
         (rcv-account (get-expense-account tr))
         (rcv-amount (get-amount (* -1 (agets tr "counterpart" "amount"))))
         (rcv-currency (agets tr "counterpart" "currency"))
         (snd-account (format-pocket-account (find-pocket (agets tr "account" "id")
                                                          pockets)))
         (snd-amount (get-amount (agets tr "amount")))
         (snd-currency (agets tr "currency")))    
    (values description comment
            rcv-account rcv-amount rcv-currency
            snd-account snd-amount snd-currency)))

(defun params-card-refund (tr pockets)
  (let* ((description (agets tr "description"))
	 (snd-account (format-pocket-account (find-pocket (agets tr "account" "id")
                                                          pockets)))
         (snd-amount (get-amount (agets tr "amount")))
         (snd-currency (agets tr "currency"))
	 (rcv-account "income:refund")
	 (rcv-amount (get-amount (* -1 (agets tr "counterpart" "amount"))))
	 (rcv-currency (agets tr "counterpart" "currency")))
    (values description nil
            rcv-account rcv-amount rcv-currency
            snd-account snd-amount snd-currency)))

(defun default-account (currency)
  (concatenate 'string "assets:revolut:" (string-downcase currency)))

(defun transaction->entry (tr pockets)
  (let* ((date (get-date (agets tr "startedDate")))
         (type (keyify (agets tr "type")))
	 (state (keyify (agets tr "state")))
	 (fee (get-amount (or (agets tr "fee") 0))))
    (case state ((:declined :failed :cancelled :reverted :deleted)
		 (return-from transaction->entry)))
    (multiple-value-bind (description comment
                          rcv-account rcv-amount rcv-currency
                          snd-account snd-amount snd-currency)
        (case type
          (:exchange (params-exchange tr pockets))
          (:topup (params-topup tr pockets))
          (:atm (params-atm tr pockets))
          (:transfer (params-transfer tr pockets))
          (:fee (params-fee tr pockets))
          (:card-payment (params-card-payment tr pockets))
	  (:card-refund (params-card-refund tr pockets)))
      (when snd-amount
        (pta-ledger:make-entry
         :date date
         :description description
         :comment comment
         :postings (remove nil (list
                    (pta-ledger:make-posting
                     :account (or rcv-account (default-account rcv-currency))
                     :amount (pta-ledger:make-amount
                              :quantity rcv-amount
                              :commodity rcv-currency)
                     :total-price (unless (equal rcv-currency snd-currency)
                                    (pta-ledger:make-amount
                                     :quantity (abs snd-amount)
                                     :commodity snd-currency)))
		    (unless (zerop fee)
		      (pta-ledger:make-posting
		       :account *fee-account*
		       :amount (pta-ledger:make-amount
				:quantity fee :commodity snd-currency)))
                    (pta-ledger:make-posting
                     :account (or snd-account (default-account snd-currency))
                     :amount (pta-ledger:make-amount
                              :quantity (- snd-amount fee)
                              :commodity snd-currency)))))))))

(defun handle-auth (login pass)
  (handler-case
      (progn
        (poller-authenticate :revolut (cons login pass))
        (handle-balance))
    (poller-cant-authenticate ()
      (bot-send-message "Чот не смог, пропробуй другие."))))

(defun handle-balance ()
  (bot-send-message
   (handler-case
       (let ((entries (mapcar 'format-pocket-balance (agets (get-user-wallet) "pockets"))))
         (if entries (text-chunks entries) "Не нашлось"))
     (poller-no-secret () "Нужен логин-пароль. /revolut <phone> <pin>")
     (poller-cant-get-token () "Не смог получить данные. Попробуй перелогинься. /revolut <phone> <pin>"))
   :parse-mode "markdown"))

(defun prepare-entries (transactions)
  (let ((pockets (agets (get-user-wallet) "pockets")))
    (delete nil (mapcar (lambda (tr) (transaction->entry tr pockets)) transactions))))

(defun handle-recent (&optional (count 10))
  (bot-send-message
   (handler-case
       (format-entries (prepare-entries (get-transactions-last :count count)))
     (poller-no-secret () "Нужен логин-пароль. /revolut <phone> <pin>")
     (poller-cant-get-token () "Не смог получить данные. Попробуй перелогинься. /revolut <phone> <pin>"))
   :parse-mode "markdown"))

(defun handle-list (enable)
  (lists-set-entry :revolut *chat-id* enable)
  (bot-send-message (if enable "Рассылаю обновления" "Молчу, пока не спросишь")))

(def-message-cmd-handler handle-cmd-revolut (:revolut :revo)
  (let ((a0 (car *args*)))
    (cond
      ((= 2 (length *args*)) (apply 'handle-auth *args*))
      ((equal a0 "on") (handle-list t))
      ((equal a0 "off") (handle-list nil))
      ((or (null *args*) (equal a0 "bal")) (handle-balance))
      (:otherwise (handle-recent (parse-integer a0 :junk-allowed t))))))

(defun process-new (transactions)
  (let ((ledger-package (find-package :chatikbot.plugins.ledger)))
    (if ledger-package
        (let ((new-chat-entry (symbol-function
                               (intern "LEDGER/NEW-CHAT-ENTRY" ledger-package))))
          (dolist (entry transactions)
            (funcall new-chat-entry *chat-id* (pta-ledger:clone-entry entry))))
        (bot-send-message (format-entries transactions) :parse-mode "markdown"))))

(defcron process-revolut ()
  (poller-poll-lists :revolut
		     (lambda () (prepare-entries (get-transactions-last)))
		     #'process-new
		     :key #'pta-ledger:entry-date))