[banking] ledger add

common.lisp

@@ -69,6 +69,7 @@
            :telegram-edit-message-text
            :telegram-edit-message-caption
            :telegram-edit-message-reply-markup
+           :telegram-delete-message
            :telegram-answer-inline-query
            :telegram-file-contents
            :telegram-inline-keyboard-markup
@@ -106,6 +107,7 @@
            :cmd
            :args
            :def-callback-handler
+           :callback
            :query-id
            :from
            :raw-data

plugins/ledger.lisp

@@ -50,13 +50,14 @@
 
 (defun git-append-latest-file (repo path text message)
   (bt:with-recursive-lock-held ((git-get-repo-lock repo))
-    (let ((repo-path (merge-pathnames path (legit:location repo))))
+    (let ((repo-path (merge-pathnames path (uiop:ensure-directory-pathname
+                                            (legit:location repo)))))
       (dotimes (tries 5)
         (let ((current (or (ignore-errors (git-read-latest-file repo path)) "")))
           (uiop/stream:with-output-file (s repo-path
                                            :if-exists :supersede
                                            :if-does-not-exist :create)
-            (format s "~A~A~%" current text)))
+            (format s "~A~A" current text)))
         (legit:add repo repo-path)
         (legit:commit repo message)
         (handler-case
@@ -66,6 +67,13 @@
           (legit:git-error ())))
       (error "Tried 5 times to push ~A to ~A" path (legit:remote-url repo)))))
 
+(defun ledger/add-git (chat-id remote path text message)
+  (let* ((location (git-get-chat-location chat-id remote))
+         (repo (git-get-repo location remote)))
+    (git-append-latest-file repo path
+                            (format nil "~%~A~%" text)
+                            message)))
+
 (defun ledger/get-hook-url (chat-id)
   (get-webhook-url "ledger" chat-id (token-hmac (write-to-string chat-id))))
 
@@ -182,3 +190,53 @@
                 (setf (gethash chat-id *ledger/chat-journals*) nil)
                 (get-chat-journal-info chat-id info)
                 "OK"))))))))
+
+;; New entries
+(defun format-entry (entry)
+  (format nil "```~%~A```" (pta-ledger:render entry)))
+
+(defparameter +new-entry-actions+
+  `(("a" . "➕")
+    ("e" . "💲")
+    ("c" . "✖️")))
+
+(defun ledger/new-chat-entry (chat-id entry)
+  (bot-send-message chat-id (format-entry entry)
+                    :parse-mode "markdown"
+                    :reply-markup (telegram-inline-keyboard-markup
+                                   (list (loop for (a . l) in +new-entry-actions+
+                                            collect (list :text l
+                                                          :callback-data
+                                                          (encode-callback-data
+                                                           chat-id :ln a 86400)))))))
+(defun ledger/format-add-entry-message (from)
+  (format nil "Ledger add from ~A ~A at ~A"
+          (aget "first_name" from) (aget "last_name" from)
+          (ledger/format-time (get-universal-time))))
+
+(defun ledger/process-add-entry (chat-id callback)
+  (with-secret (info (list :ledger chat-id))
+    (if info
+        (cond
+          ((consp info)
+           (handler-case (progn
+                           (ledger/add-git
+                            chat-id
+                            (car info) (cadr info)
+                            (agets callback "message" "text")
+                            (ledger/format-add-entry-message (agets callback "from")))
+                           "Добавил!")
+             (error (e)
+               (log:error "~A" e)
+               "Не смог :(")))
+          (:otherwise "Добавляю только в git журнал :("))
+      "Добавь git журнал.")))
+
+(def-callback-section-handler cb-handle-ln (:ln)
+  (case (keyify data)
+    (:a (telegram-answer-callback-query query-id :text "Добавляю...")
+        (telegram-send-message chat-id (ledger/process-add-entry
+                                        chat-id callback))
+        (telegram-edit-message-reply-markup nil :chat-id chat-id :message-id message-id))
+    (:e (telegram-answer-callback-query query-id :text "TBD"))
+    (:c (telegram-delete-message chat-id message-id))))

plugins/raiffeisen.lisp

@@ -256,12 +256,18 @@
 (defcron process-raiffeisen (:minute '(member 0 5 10 15 20 25 30 35 40 45 50 55))
   (dolist (chat-id (lists-get :raiffeisen))
     (let ((old (gethash chat-id *last-entries*))
-          (new (get-chat-last-entries chat-id (* 7 +day+))))
+          (new (get-chat-last-entries chat-id (* 7 +day+)))
+          (ledger-package (find-package :chatikbot.plugins.ledger)))
       (when new
         (when old
           (alexandria:when-let (changes (set-difference new old :test #'equalp))
             (log:info changes)
-            (bot-send-message chat-id (format-changes changes) :parse-mode "markdown")))
+            (if ledger-package
+                (let (new-chat-entry (symbol-function
+                                      (intern "LEDGER/NEW-CHAT-ENTRIES" ledger-package)))
+                  (dolist (entry changes)
+                    (funcall new-chat-entry chat-id entry)))
+                (bot-send-message chat-id (format-entries changes) :parse-mode "markdown"))))
         (setf (gethash chat-id *last-entries*) new)))))
 
 (def-message-cmd-handler handler-raif (:raif)

plugins/tinkoff.lisp

@@ -212,12 +212,18 @@
 (defcron process-tinkoff (:minute '(member 0 5 10 15 20 25 30 35 40 45 50 55))
   (dolist (chat-id (lists-get :tinkoff))
     (let ((old (gethash chat-id *last-entries*))
-          (new (get-chat-last-entries chat-id (* 7 24 60 60))))
+          (new (get-chat-last-entries chat-id (* 7 24 60 60)))
+          (ledger-package (find-package :chatikbot.plugins.ledger)))
       (when new
         (when old
           (alexandria:when-let (changes (set-difference new old :test #'equalp))
             (log:info changes)
-            (bot-send-message chat-id (format-entries changes) :parse-mode "markdown")))
+            (if ledger-package
+                (let (new-chat-entry (symbol-function
+                                      (intern "LEDGER/NEW-CHAT-ENTRIES" ledger-package)))
+                  (dolist (entry changes)
+                    (funcall new-chat-entry chat-id entry)))
+                (bot-send-message chat-id (format-entries changes) :parse-mode "markdown"))))
         (setf (gethash chat-id *last-entries*) new)))))
 
 (def-message-cmd-handler handler-tink (:tink)

telegram.lisp

@@ -22,6 +22,7 @@
            :telegram-edit-message-text
            :telegram-edit-message-caption
            :telegram-edit-message-reply-markup
+           :telegram-delete-message
            :telegram-answer-inline-query
            :telegram-file-contents
            :telegram-inline-keyboard-markup
@@ -205,6 +206,11 @@
          (cons "inline_message_id" inline-message-id)
          (cons "reply_markup" reply-markup))))
 
+(defun telegram-delete-message (chat-id message-id)
+  (%telegram-api-call
+   "deleteMessage" (list (cons "chat_id" chat-id)
+                         (cons "message_id" message-id))))
+
 (defun telegram-answer-inline-query (query-id results &key cache-time is-personal next-offset switch-pm-text switch-pm-parameter)
   (%telegram-api-call
    "answerInlineQuery"

utils.lisp

@@ -50,6 +50,7 @@
            :text
            :cmd
            :args
+           :callback
            :query-id
            :from
            :raw-data