plugins/aoc.lisp

@@ -3,15 +3,16 @@
   (:use :cl :chatikbot.common))
 (in-package :chatikbot.plugins.aoc)
 
-(defparameter +api-uri+ "https://adventofcode.com/2020/leaderboard/private/view/24158.json")
-(defparameter +leader-board-link+ "https://adventofcode.com/2020/leaderboard/private/view/24158")
-(defparameter +advent-time+ (encode-universal-time 0 0 8 25 12 2020 -3))
+(defvar *year* 2021)
+(defvar *api-uri* (format nil "https://adventofcode.com/~A/leaderboard/private/view/24158.json" *year*))
+(defvar *leader-board-link* (format nil "https://adventofcode.com/~A/leaderboard/private/view/24158" *year*))
+(defvar *advent-time* (encode-universal-time 0 0 8 25 12 *year* -3))
 
 (defmethod poller-request ((module (eql :aoc)) method &rest params)
   (declare (ignorable params))
   (let ((cookie (format nil "session=~a" *poller-token*)))
     (handler-case
-        (agets (json-request +api-uri+ :headers `((:cookie . ,cookie))))
+        (agets (json-request *api-uri* :headers `((:cookie . ,cookie))))
       (dex:http-request-failed (e) e))))
 
 (defmethod poller-validate ((module (eql :aoc)) response)
@@ -30,7 +31,7 @@
              collect (list (parse-integer uid) (agets member "name") (parse-integer num) (length completion)))))
 
 (defun get-advent-days-active ()
-  (max 0 (min 25 (- 25 (ceiling (/ (- +advent-time+ (get-universal-time)) 86400))))))
+  (max 0 (min 25 (- 25 (ceiling (/ (- *advent-time* (get-universal-time)) 86400))))))
 
 (defun format-stars(completions)
   (format nil "~{~a~}" (loop for daynum from 1 to (get-advent-days-active)
@@ -43,7 +44,7 @@
                                        (agets member "local_score")
                                        (format-stars (agets member "completion_day_level"))))
                       #'> :key #'second)))
-    (format nil "🏆***Chad AoC Leaderboard***🏆~%~a~%~%~{~a. ~a: ~a ~% ~a~^~%~}" +leader-board-link+
+    (format nil "🏆***Chad AoC Leaderboard***🏆~%~a~%~%~{~a. ~a: ~a ~% ~a~^~%~}" *leader-board-link*
             (apply 'append (mapcar #'cons (alexandria:iota (length sorted) :start 1) sorted)))))
 
 (defun handle-leaderboard ()
@@ -55,7 +56,7 @@
    :parse-mode "markdown"))
 
 (defun format-completion-state-change (diff)
-  (format nil "Обновился лидерборд 🏆***AoC*** 🏆~%~a~%~{~a!~^~%~}" +leader-board-link+ (loop for (uid name daynum completed) in diff
+  (format nil "Обновился лидерборд 🏆***AoC*** 🏆~%~a~%~{~a!~^~%~}" *leader-board-link* (loop for (uid name daynum completed) in diff
                            collect (format nil "***~a*** ебнул ~a задачку ~a дня" name completed daynum))))
 
 (defcron process-aoc (:minute '(member 0 15 30 45))

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

plugins/music.lisp

@@ -10,7 +10,7 @@
 (defvar *chad-music-stats-url* "http://localhost:5000/api/stats")
 (defvar *chad-music-rescan-url* "http://localhost:5000/api/rescan")
 (defvar *slskd-api* "http://localhost:5015/api/v0")
-(defvar *slskd-downloads-dir* "/data/uploads/batch2/")
+(defvar *slskd-downloads-dir* "/data/upload/batch2/")
 
 (defun jojo-request (url &rest args &key method parameters content headers basic-auth bearer cookie-jar keep-alive use-connection-pool timeout ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent (as :plist))
   (declare (ignore method parameters basic-auth cookie-jar keep-alive use-connection-pool timeout ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent))

utils.lisp

@@ -256,7 +256,7 @@ is replaced with replacement."
       (setf (quri:uri-scheme uri) "http"))
     (values uri userinfo)))
 
-(defun http-request (url &rest args &key method version parameters content headers basic-auth cookie-jar keep-alive use-connection-pool (max-redirects 5) read-timeout force-binary want-stream ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent)
+(defun http-request (url &rest args &key method version parameters content headers basic-auth cookie-jar (keep-alive t) (use-connection-pool t) (max-redirects 5) read-timeout force-binary want-stream ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent)
   (declare (ignore method version content basic-auth cookie-jar keep-alive use-connection-pool max-redirects read-timeout force-binary want-stream ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path))
   (multiple-value-bind (uri userinfo)
       (http-default url parameters)
@@ -272,7 +272,7 @@ is replaced with replacement."
     (apply #'dex:request uri :headers headers args)))
 
 ;; XML processing
-(defun xml-request (url &rest args &key method parameters content headers basic-auth cookie-jar keep-alive use-connection-pool read-timeout ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent encoding)
+(defun xml-request (url &rest args &key method parameters content headers basic-auth cookie-jar keep-alive (use-connection-pool t) read-timeout ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent encoding)
   (declare (ignore method parameters headers content basic-auth cookie-jar keep-alive use-connection-pool read-timeout ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent))
   (remf args :encoding)
   (multiple-value-bind (raw-body status headers uri)