Преглед изворни кода

[finance] Support all cex.io pairs, enchance labels parsing

Innokentii Enikeev пре 3 година
родитељ
комит
fe09faa1d8
1 измењених фајлова са 35 додато и 16 уклоњено
  1. 35 16
      plugins/finance.lisp

+ 35 - 16
plugins/finance.lisp

@@ -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