[finance] hodl WIP

plugins/finance.lisp

@@ -56,7 +56,8 @@
      "EURRUB=X" ("гейро" "eur" "евро")
      "GBPRUB=X" ("британец" "gbp" "фунт" "стерлинг")
      "CZKRUB=X" ("чешка" "czk")
-     "DKKRUB=X" ("дашка" "dkk"))
+     "DKKRUB=X" ("дашка" "dkk")
+     "ETHUSD=X" ("eth" "etherium" "эфир" "эфирум" "виталик"))
    :test #'equal))
 
 (defun get-symbol-label (symbol)
@@ -108,7 +109,8 @@
 ;; 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"))
+  (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)"))
 
 (defun migrate ()
   (db-execute "delete from finance_ticker")
@@ -123,15 +125,19 @@
 
 (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))
+     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-finance-at (symbol ts)
+  (db-single "select price from finance_ticker where symbol = ? and ts <= ? order by ts desc limit 1"
+             symbol ts))
 
 (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"))))
+              (db-select "select distinct symbol from finance_chat_symbols union select symbol from finance_orders"))))
 
 (defun db/set-chat-symbols (chat-id symbols)
   (db-transaction
@@ -147,6 +153,17 @@
                        avg symbols avg)))
       (apply #'db-select sql (local-time:timestamp-to-unix after-ts) symbols))))
 
+(defun db/order-buy (chat-id user-id user-name symbol amount open open-at)
+  (db-execute "insert into finance_orders (chat_id, user_id, user_name, symbol, amount, open, open_at) values (?, ?, ?, ?, ?, ?, ?)"
+              chat-id user-id user-name symbol amount open open-at))
+
+(defun db/order-sell (row-id amount close close-at)
+  (db-execute "update finance_orders set amount = ?, close = ?, close_at = ? WHERE rowid = ?"
+              amount close close-at row-id))
+
+(defun db/orders-get (chat-id)
+  (db-select "select rowid, user_id, user_name, symbol, amount, open, open_at, close, close_at from finance_orders where chat_id = ? order by open_at, close_at" chat-id))
+
 ;; Cron
 (defcron process-rates ()
   (let* ((ts (local-time:timestamp-to-unix (local-time:now)))
@@ -183,6 +200,58 @@
                           "Пока нет данных. Если тикер реальный, задай через /setrates <tickers>")
                       :parse-mode "markdown")))
 
+(defun get-order-info (order)
+  (destructuring-bind (row-id user-id user-name symbol amount-text open-text open-at close-text close-at)
+      order
+    (let* ((amount (parse-float amount-text))
+           (open (parse-float open-text))
+           (open-amount (* amount open))
+           (close-at (or close-at (local-time:timestamp-to-unix (local-time:now))))
+           (close (if close-text
+                     (parse-float close-text)
+                     (db/get-finance-at symbol close-at)))
+           (close-amount (when close (* amount close)))
+           (duration (- close-at open-at))
+           (income (when close-amount (- close-amount open-amount)))
+           (roi (when income (/ income open-amount)))
+           (annual (when roi (* (/ roi duration) (* +day+ 365.25)))))
+      `((:row-id . ,row-id)
+        (:user-id . ,user-id)
+        (:user-name . ,user-name)
+        (:symbol . ,symbol)
+        (:amount . ,amount)
+        (:open . ,open)
+        (:open-at . ,open-at)
+        (:open-amount . ,open-amount)
+        (:open-p . ,(null close-text))
+        (:close . ,close)
+        (:close-at . ,close-at)
+        (:close-amount . ,close-amount)
+        (:duration . ,duration)
+        (:income . ,income)
+        (:roi . ,roi)
+        (:annual . ,annual)))))
+
+(defun print-order-info (info)
+  (format nil "~A ~A ~A ~A @ ~$ - ~A @ ~$, заработал ~$, ROI ~$%"
+          (agets info :user-name)
+          (agets info :amount)
+          (get-symbol-label (agets info :symbol))
+          (format-ts (local-time:unix-to-timestamp (agets info :open-at)))
+          (agets info :open)
+          (if (agets info :open-p) "now" (format-ts (local-time:unix-to-timestamp (agets info :close-at))))
+          (agets info :close)
+          (agets info :income)
+          (* 100 (agets info :roi))))
+
+(def-message-cmd-handler handle-hodl (:hodl :hodlers)
+  (let ((orders (db/orders-get chat-id)))
+    (bot-send-message chat-id
+                      (if orders (format nil "~{~A~^~%~}"
+                                         (loop for order in orders
+                                            collect (print-order-info (get-order-info order))))
+                          "Нет ходлеров :("))))
+
 (def-message-cmd-handler handler-charts (:charts)
   (telegram-send-chat-action chat-id "upload_photo")
   (let* ((args (mapcar 'string-downcase args))

utils.lisp

@@ -363,7 +363,9 @@ is replaced with replacement."
 (defun parse-float (string)
   (let ((*read-eval* nil))
     (with-input-from-string (stream string)
-      (read stream nil nil))))
+      (let ((in (read stream nil nil)))
+        (when (numberp in)
+          in)))))
 
 (defun smart-f (arg &optional digits)
   (with-output-to-string (s)