|
|
@@ -46,12 +46,28 @@
|
|
|
"bpi" "USD" "rate_float")
|
|
|
(error (e) (log:error "~A" e))))
|
|
|
|
|
|
-(defparameter +cex-btc-usd-url+ "https://cex.io/api/last_price/BTC/USD" "cex.io api endpoint")
|
|
|
-(defun get-cex-io-btc-usd ()
|
|
|
+
|
|
|
+(defparameter +cex-currency-limits-url+ "https://cex.io/api/currency_limits" "cex.io currency limits endpoint")
|
|
|
+(defparameter +cex-last-prices-url+ "https://cex.io/api/last_prices/" "cex.io last prices api endpoint")
|
|
|
+(defun cex-pair-symbol (pair)
|
|
|
+ (concatenate 'string (agets pair "symbol1") "/" (agets pair "symbol2")))
|
|
|
+(defun get-cex-io-symbols ()
|
|
|
(handler-case
|
|
|
- (parse-float (agets (json-request +cex-btc-usd-url+) "lprice"))
|
|
|
+ (mapcar 'cex-pair-symbol (agets (json-request +cex-currency-limits-url+) "data" "pairs"))
|
|
|
(error (e) (log:error "~A" e))))
|
|
|
|
|
|
+(defvar *cex-io-symbols* (get-cex-io-symbols) "List of all cex.io supported symbols. Will be loaded on init")
|
|
|
+
|
|
|
+(defun get-cex-io-last-prices (&rest symbols)
|
|
|
+ (handler-case
|
|
|
+ (let* ((ends (remove-duplicates (mapcar (lambda (s) (subseq s (1+ (position #\/ s)))) symbols)
|
|
|
+ :test 'equal))
|
|
|
+ (data (agets (json-request (format nil "~a~{~a~^/~}" +cex-last-prices-url+ ends)) "data")))
|
|
|
+ (loop for pair in data
|
|
|
+ for symbol = (cex-pair-symbol pair)
|
|
|
+ when (member symbol symbols :test 'equal)
|
|
|
+ collect (cons symbol (parse-float (agets pair "lprice")))))
|
|
|
+ (error (e) (log:error "~A" e))))
|
|
|
|
|
|
;; Formatting
|
|
|
(defvar *symbol-aliases*
|
|
|
@@ -116,7 +132,8 @@
|
|
|
(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")
|
|
|
- (db-execute "create table if not exists finance_orders (chat_id, user_id, user_name, symbol, amount, open, open_at, close, close_at)"))
|
|
|
+ (db-execute "create table if not exists finance_orders (chat_id, user_id, user_name, symbol, amount, open, open_at, close, close_at)")
|
|
|
+ (db-execute "create index if not exists idx_finance_ticker_ts on finance_ticker(ts desc)"))
|
|
|
|
|
|
(defun migrate ()
|
|
|
(db-execute "delete from finance_ticker")
|
|
|
@@ -181,23 +198,25 @@
|
|
|
(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-cex-io-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))))
|
|
|
+ (cex-symbols (intersection symbols *cex-io-symbols* :test 'equal))
|
|
|
+ (rest-symbols (set-difference symbols cex-symbols))
|
|
|
+ (rates (when rest-symbols (get-rates rest-symbols)))
|
|
|
+ (cex-prices (when cex-symbols (apply 'get-cex-io-last-prices cex-symbols))))
|
|
|
+ (loop for (symbol . price) in (append rates cex-prices)
|
|
|
+ do (db/add-finance ts symbol price))))
|
|
|
|
|
|
;;; 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)))
|
|
|
+ do (return symbol))
|
|
|
+ (let ((upper (string-upcase label)))
|
|
|
+ (if (member upper *cex-io-symbols* :test 'equal) upper
|
|
|
+ (if (and (= 7 (length label))
|
|
|
+ (equal (elt label 3) #\/))
|
|
|
+ (concatenate 'string (remove #\/ upper) "=X")
|
|
|
+ upper)))))
|
|
|
|
|
|
(def-message-cmd-handler handler-rates (:rates)
|
|
|
(let* ((symbols (or (mapcar #'get-label-symbol *args*)
|
|
|
@@ -268,7 +287,7 @@
|
|
|
collect (print-order-info idx (get-order-info order))))
|
|
|
"Нет ходлеров :(")
|
|
|
:parse-mode "markdown"
|
|
|
- :disable-notification 1)))
|
|
|
+ :disable-notification 1)))
|
|
|
|
|
|
(defun handle-hodl-buy ()
|
|
|
(handler-case
|