(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 *rate-pairs* '("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 (pairs *rate-pairs*)) (let ((response (agets (json-request +yahoo-url+ :parameters `(("symbols" . ,(format nil "~{~A~^,~}" pairs)))) "quoteResponse"))) (when (aget "error" response) (error "Error in rates request")) (loop for rate in (agets response "result") collect (cons (or (aget "shortName" rate) (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)))) (defun get-serie (series idx) (loop for row in series when (elt row idx) collect (list (first row) (elt row idx)))) (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 names) (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 serie in names for idx from 1 do (adw-charting:add-series serie (get-serie series idx))) (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 (ts, usd, eur, gbp, brent, btc)") (db-execute "create index if not exists fin_ts_ids on finance (ts)")) (defun db/add-finance (ts usd eur gbp brent btc) (db-execute "insert into finance (ts, usd, eur, gbp, brent, btc) values (?, ?, ?, ?, ?, ?)" ts usd eur gbp brent btc)) (defun db/get-last-finance () (values-list (first (db-select "select ts, usd, eur, gbp, brent, btc from finance order by ts desc limit 1")))) (defparameter +finance-db-map+ '(("usd" . "USD/RUB") ("eur" . "EUR/RUB") ("gbp" . "GBP/RUB") ("brent" . "Brent") ("btc" . "BTC/USD"))) (defun db/get-series (after-ts &optional (fields '("usd" "eur" "gbp" "brent")) (avg 60)) (when fields (let ((sql (format nil "select ts/~a*~:*~a,~{avg(~a) as ~:*~a~^,~} from finance where ts >= ? group by ts/~a order by ts" avg fields avg))) (values (db-select sql (local-time:timestamp-to-unix after-ts)) (sublis +finance-db-map+ fields :test #'equal))))) ;; Cron (defcron process-rates () (let ((ts (local-time:timestamp-to-unix (local-time:now))) (rates (get-rates)) (brent (get-brent)) (btc (get-coindesk-btc-usd))) (db/add-finance ts (aget "USDRUB=X" rates) (aget "EUR/RUB" rates) (aget "GBP/RUB" rates) brent btc))) ;;; Hooks (def-message-cmd-handler handler-rates (:rates) (multiple-value-bind (ts usd eur gbp brent btc) (db/get-last-finance) (bot-send-message chat-id (format nil "Зеленый *~,2F*, гейро *~,2F*, британец *~,2F*, чёрная *~,2F*, btc *~,2F* @ _~A_" usd eur gbp brent btc (format-ts (local-time:unix-to-timestamp ts))) :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-fields (mapcar #'car +finance-db-map+)) (fields (or (intersection args all-fields :test 'equal) all-fields)) (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 (multiple-value-list (db/get-last-finance))) (chart (apply #'make-chart (multiple-value-list (db/get-series after-ts fields avg))))) (telegram-send-photo chat-id chart :caption (format nil "Зеленый ~,2F, гейро ~,2F, британец ~,2F, чёрная ~,2F, btc ~,2F @ ~A" (elt rates 1) (elt rates 2) (elt rates 3) (elt rates 4) (elt rates 5) (format-ts (local-time:unix-to-timestamp (elt rates 0)))))))