(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®ion=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) (let* ((symbols (or (when args (mapcar #'get-label-symbol args)) (db/get-chat-symbols chat-id) *default-symbols*)) (last (db/get-last-finance 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)))) "Пока нет данных. Если тикер реальный, задай через /setrates ") :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))))))) (def-message-cmd-handler handler-set-rates (:setrates) (when args (db/set-chat-symbols chat-id (mapcar #'get-label-symbol args))) (bot-send-message chat-id (format nil "Пишем ~{_~a_~#[~; и ~:;, ~]~}" (mapcar #'get-symbol-label (db/get-chat-symbols chat-id))) :parse-mode "markdown"))