chatikbot/plugins/finance.lisp

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

(defparameter +yahoo-url+ "https://query1.finance.yahoo.com/v7/finance/quote?lang=en-US&region=US&corsDomain=finance.yahoo.com&fields=regularMarketPrice" "Yahoo Finance API endpoint")
(defparameter +brent-url+ "http://www.cmegroup.com/CmeWS/mvc/Quotes/Future/424/G")

(defvar *default-symbols* '("USDRUB=X" "EURRUB=X" "GBPRUB=X"))

(defparameter +chart-ranges+ (list (cons "day" (* 24 60))
                                   (cons "week" (* 7 24 60))
                                   (cons "month" (* 30 24 60))
                                   (cons "quarter" (* 91 24 60))
                                   (cons "year" (* 365 24 60))))

(defun get-rates (&optional (symbols *default-symbols*))
  (let ((response (agets (json-request
                          +yahoo-url+
                          :parameters `(("symbols" . ,(format nil "~{~A~^,~}" symbols))))
                         "quoteResponse")))
    (when (aget "error" response)
      (error "Error in rates request"))
    (loop for rate in (agets response "result")
       collect (cons (aget "symbol" rate)
                     (aget "regularMarketPrice" rate)))))

(defun get-brent ()
  (handler-case
      (let ((last (read-from-string
                   (aget "last" (first (aget "quotes" (json-request  +brent-url+)))))))
        (when (numberp last)
          last))
    (error (e) (log:error e))))

(defparameter +btc-e-usd-url+ "https://btc-e.com/api/2/btc_usd/ticker" "BTC-e BTC/USD ticker url")
(defun get-btc-e ()
  (handler-case
      (aget "last" (aget "ticker" (json-request +btc-e-usd-url+)))
    (error (e) (log:error e))))

(defparameter +coindesk-btc-usd-url+ "https://api.coindesk.com/site/headerdata.json?currency=BTC" "coindesk.com api endpoint")
(defun get-coindesk-btc-usd ()
  (handler-case
      (agets (json-request +coindesk-btc-usd-url+)
             "bpi" "USD" "rate_float")
    (error (e) (log:error "~A" e))))


;; Formatting
(defvar *symbol-aliases*
  (alexandria:plist-hash-table
   '("BTCUSD" ("btc" "bitcoin" "биток")
     "BRENT" ("чёрная" "нефть" "brent" "oil")
     "USDRUB=X" ("зелёный" "бакс" "доллар" "usd")
     "EURRUB=X" ("гейро" "eur" "евро")
     "GBPRUB=X" ("британец" "gbp" "фунт" "стерлинг")
     "CZKRUB=X" ("чешка" "czk")
     "DKKRUB=X" ("дашка" "dkk"))
   :test #'equal))

(defun get-symbol-label (symbol)
  (let ((aliases (gethash symbol *symbol-aliases*)))
    (if aliases
        (car aliases)
        (let ((lower (string-downcase symbol)))
          (when (equal "=x" (subseq lower (- (length lower) 2)))
            (setf lower (subseq lower 0 (- (length lower) 2))))
          (if (= 6 (length lower))
              (format nil "~A/~A" (subseq lower 0 3) (subseq lower 3))
              lower)))))

;; Charts
(defun get-serie (series symbol)
  (mapcar #'(lambda (r) (list (car r) (caddr r)))
          (remove symbol series :key #'cadr :test-not #'equal)))

(defun range (seq &key (key 'identity))
  (loop
     for item in seq
     for value = (funcall key item)
     minimizing value into min
     maximizing value into max
     finally (return (values min max))))

(defvar *chart-points* 800 "Data points in chart")
(defun make-chart (series symbols)
  (let* ((r (multiple-value-list (range series :key #'car)))
         (fmt (if (<= (- (second r) (first r))
                      (* 60 60 36))
                  '((:hour 2) ":" (:min 2))
                  '((:day 2) "." (:month 2) " " (:hour 2) ":" (:min 2)))))
    (adw-charting:with-line-chart ((+ 90 *chart-points*)
                                   (floor (* 3 *chart-points*) 4))
      (loop for symbol in symbols
         do (adw-charting:add-series (get-symbol-label symbol)
                                     (get-serie series symbol)))
      (adw-charting:set-axis
       :x "Time" :draw-gridlines-p t
       :label-formatter #'(lambda (v)
                            (local-time:format-timestring
                             nil
                             (local-time:unix-to-timestamp v)
                             :format fmt)))
      (adw-charting:set-axis :y "RUB" :draw-gridlines-p t :label-formatter "~,2F")
      (adw-charting:save-file "chart.png"))))

;; Database
(def-db-init
  (db-execute "create table if not exists finance_ticker (ts, symbol, price, primary key (ts, symbol)) without rowid")
  (db-execute "create table if not exists finance_chat_symbols (chat_id, symbol, primary key (chat_id, symbol)) without rowid"))

(defun migrate ()
  (db-execute "delete from finance_ticker")
  (db-execute "insert or ignore into finance_ticker (ts, symbol, price) select ts, ?, usd from finance where usd is not null" "USDRUB=X")
  (db-execute "insert or ignore into finance_ticker (ts, symbol, price) select ts, ?, eur from finance where eur is not null" "EURRUB=X")
  (db-execute "insert or ignore into finance_ticker (ts, symbol, price) select ts, ?, gbp from finance where gbp is not null" "GBPRUB=X")
  (db-execute "insert or ignore into finance_ticker (ts, symbol, price) select ts, ?, brent from finance where brent is not null" "BRENT")
  (db-execute "insert or ignore into finance_ticker (ts, symbol, price) select ts, ?, btc from finance where btc is not null" "BTCUSD"))

(defun db/add-finance (ts symbol price)
  (db-execute "insert into finance_ticker (ts, symbol, price) values (?, ?, ?)" ts symbol price))

(defun db/get-last-finance (&optional (symbols *default-symbols*))
  (loop for symbol in symbols
       for last = (db-select "select ts, symbol, price from finance_ticker where symbol = ? order by ts desc limit 1"
                             symbol)
       when last append last))

(defun db/get-chat-symbols (&optional chat-id)
  (mapcar #'car
          (if chat-id
              (db-select "select symbol from finance_chat_symbols where chat_id = ?" chat-id)
              (db-select "select distinct symbol from finance_chat_symbols"))))

(defun db/set-chat-symbols (chat-id symbols)
  (db-transaction
    (db-execute "delete from finance_chat_symbols where chat_id = ?" chat-id)
    (dolist (symbol symbols)
      (db-execute "insert into finance_chat_symbols (chat_id, symbol) values (?, ?)"
                  chat-id symbol))))

(defun db/get-series (after-ts &optional (symbols *default-symbols*) (avg 60))
  (when symbols
    (let ((sql (format nil
                       "select ts/~a*~:*~a, symbol, avg(price) from finance_ticker where ts >= ? and symbol in (~{?~*~^, ~}) group by ts/~a, symbol order by ts"
                       avg symbols avg)))
      (apply #'db-select sql (local-time:timestamp-to-unix after-ts) symbols))))

;; Cron
(defcron process-rates ()
  (let* ((ts (local-time:timestamp-to-unix (local-time:now)))
         (symbols (db/get-chat-symbols))
         (rates (when symbols (get-rates symbols)))
         (brent (get-brent))
         (btc (get-coindesk-btc-usd)))
    (loop for (symbol . price) in rates
       do (db/add-finance ts symbol price))
    (when brent
      (db/add-finance ts "BRENT" brent))
    (when btc
      (db/add-finance ts "BTCUSD" btc))))

;;; Hooks
(defun get-label-symbol (label)
  (or
   (loop for symbol being the hash-keys in *symbol-aliases* using (hash-value aliases)
      when (member label aliases :test #'string-equal)
      do (return symbol))
   (string-upcase label)))

(def-message-cmd-handler handler-rates (:rates)
  (when args
    (db/set-chat-symbols chat-id (mapcar #'get-label-symbol args)))
  (let ((last (db/get-last-finance (or (db/get-chat-symbols chat-id) *default-symbols*))))
    (bot-send-message chat-id
                      (if last
                          (format nil "~{~A *~$*~^, ~} @ _~A_"
                                  (loop for (ts symbol price) in last
                                     append (list (get-symbol-label symbol) price))
                                  (format-ts (local-time:unix-to-timestamp (caar last))))
                          "Пока нет данных. Если тикер реальный, проверь через минуту")
                      :parse-mode "markdown")))

(def-message-cmd-handler handler-charts (:charts)
  (telegram-send-chat-action chat-id "upload_photo")
  (let* ((args (mapcar 'string-downcase args))
         (all-symbols (db/get-chat-symbols))
         (symbols (or (intersection (mapcar #'get-label-symbol args) all-symbols :test 'equal) all-symbols))
         (day-range (some #'(lambda (a) (aget a +chart-ranges+)) args))
         (number (some #'(lambda (a) (parse-integer a :junk-allowed t)) args))
         (avg (* 60 (cond
                      (day-range (round day-range *chart-points*))
                      (number)
                      (:otherwise 1))))
         (after-ts (local-time:timestamp- (local-time:now)
                                          (* avg *chart-points*) :sec))
         (rates (db/get-last-finance symbols))
         (chart (make-chart (db/get-series after-ts symbols avg) symbols)))
    (telegram-send-photo chat-id chart
                         :caption
                         (format nil "~{~A ~$~^, ~} @ ~A"
                                 (loop for (ts symbol price) in rates
                                    append (list (get-symbol-label symbol) price))
                                 (format-ts (local-time:unix-to-timestamp (caar rates)))))))