3 files changed, 113 insertions, 51 deletions

diff --git a/src/bot/advanced.lisp b/src/bot/advanced.lisp
index a6ad9ba..241b04d 100644
--- a/src/bot/advanced.lisp
+++ b/src/bot/advanced.lisp
@@ -2,7 +2,7 @@
 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
 (defpackage :ukkoclot/bot/advanced
   (:use :c2cl :ukkoclot/bot/impl :ukkoclot/bot/methods :ukkoclot/tg-types)
-  (:export :bot-id :bot-username :reply-message))
+  (:export :bot-id :bot-username :reply-animation :reply-message :try-delete-message))
 (in-package :ukkoclot/bot/advanced)
 
 (defun bot-id (bot)
@@ -17,6 +17,20 @@
         (get-me bot)
         (bot-username% bot))))
 
+;; TODO: Some kind of caching for files?
+(defun reply-animation (bot msg animation &key allow-sending-without-reply text parse-mode caption-above)
+  (send-animation bot
+                  :chat-id (message-chat-id msg)
+                  :animation animation
+                  :caption text
+                  :parse-mode parse-mode
+                  :show-caption-above-media caption-above
+                  :reply-parameters
+                  (make-reply-parameters
+                   :allow-sending-without-reply allow-sending-without-reply
+                   :message-id (message-id msg)
+                   :chat-id (message-chat-id msg))))
+
 (defun reply-message (bot msg text &key parse-mode allow-sending-without-reply)
   (send-message bot
                 :chat-id (message-chat-id msg)
@@ -27,3 +41,14 @@
                  :allow-sending-without-reply allow-sending-without-reply
                  :message-id (message-id msg)
                  :chat-id (message-chat-id msg))))
+
+(defun try-delete-message (bot msg)
+  (handler-case
+      (delete-message bot
+                      :chat-id (message-chat-id msg)
+                      :message-id (message-id msg))
+    (error ()
+      (handler-case
+          (reply-animation bot msg #P"blob/do-not.mp4"
+                           :allow-sending-without-reply nil)
+        (error () nil)))))
diff --git a/src/bot/impl.lisp b/src/bot/impl.lisp
index b57e2d3..57a9572 100644
--- a/src/bot/impl.lisp
+++ b/src/bot/impl.lisp
@@ -8,41 +8,62 @@
   (:local-nicknames
    (:jzon :com.inuoe.jzon))
   (:export
-   :arg-encode :bot :bot-p :make-bot :do-call
+   :bot :bot-p :make-bot :fixup-value :do-call :parse-value
 
    :bot-config :bot-db :bot-base-uri :bot-power-on :bot-username% :bot-id%))
 (in-package :ukkoclot/bot/impl)
 
-(defgeneric will-arg-encode (object)
-  (:documentation "Whether the OBJECT has any transformation done to it by arg-encode")
-  (:method (obj)
-    nil)
-  (:method ((obj cons))
-    (or (will-arg-encode (car obj))
-        (will-arg-encode (cdr obj)))))
+(defgeneric parse-value (type json)
+  (:documentation "Parse value of TYPE from the parsed JSON")
+  (:method (type json)
+    (log-error "I don't know how to parse simple type ~A!" type)
+    (error "I don't know how to parse simple type ~A!" type))
+  (:method ((type (eql 'boolean)) json)
+    (check-type json boolean)
+    json)
+  (:method ((type (eql 'integer)) json)
+    (check-type json integer)
+    json)
+  (:method ((type (eql 'null)) json)
+    (check-type json null)
+    json)
+  (:method ((type (eql 'string)) json)
+    (check-type json string)
+    json))
 
-(defgeneric arg-encode (object)
-  (:documentation "Encode the OBJECT to a form that our HTTP code is happy about.")
-  (:method (obj)
-    obj)
-  (:method ((obj cons))
-    (if (not (will-arg-encode obj))
-        obj
-        (cons (arg-encode (car obj))
-              (arg-encode (cdr obj))))))
+(defun try-parse-value (type json)
+  (handler-case (values t (parse-value type json))
+    (error () (values nil nil))))
 
-(defgeneric fixup-arg (value)
-  (:documentation "Make sure Telegram & QURI & whatever like the arg")
+(defmethod parse-value ((type cons) json)
+  (cond ((and (eq (car type) 'array)
+              (null (cddr type)))
+         (when json
+           (let ((element-type (cadr type)))
+             (iter (for element in-vector json)
+               (collect (parse-value element-type element) result-type vector)))))
+        ((eq (car type) 'or)
+         (iter (for el-type in (cdr type))
+           (multiple-value-bind (success res) (try-parse-value el-type json)
+             (when success
+               (return res)))
+           (finally
+            (error "Failed to parse ~S as ~A!" json type))))
+        (t
+         (error "I don't know how to parse complex type ~A!" type))))
+
+(defgeneric fixup-value (value)
+  (:documentation "Fixup top-level VALUE before passing it onto telegram")
   (:method (value)
-    (error "Unsupported argument type ~S (~S)" (class-name (class-of value)) value))
+    (jzon:stringify value))
   (:method ((value null))
     value)
   (:method ((value number))
     value)
-  (:method ((value string))
+  (:method ((value pathname))
     value)
-  (:method ((value hash-table))
-    (jzon:stringify value)))
+  (:method ((value string))
+    value))
 
 (defstruct (bot (:constructor make-bot%))
   (config (error "No value given for config") :read-only t)
@@ -58,39 +79,35 @@
                                (config-bot-token config) "/")))
     (make-bot% :config config :db db :base-uri base-uri)))
 
-(defun args-plist->alist (args-plist)
-  (iter (for (old-key value) on args-plist by #'cddr)
+(defun fixup-args (args)
+  (iter (for (key . value) in args)
     (collect
-        (let ((new-key (string-downcase (lisp->snake-case (symbol-name old-key)))))
-          (cons new-key value)))))
-
-(defun fixup-args (args-alist)
-  (iter (for (name . value) in args-alist)
-    (collecting (cons name (fixup-arg (arg-encode value))))))
+        (cons (string-downcase (lisp->snake-case (symbol-name key)))
+              (fixup-value value)))))
 
 (defun req (uri method content)
   ;; We deal with this manually
   (handler-bind ((dex:http-request-too-many-requests #'dex:ignore-and-continue))
     (dex:request uri :method method :content content)))
 
-(defun do-call% (bot method uri mapfn args-encoded)
+(defun do-call% (bot method uri type args-encoded)
   (let ((body (req uri method args-encoded)))
     (let ((hash (jzon:parse body)))
       (acond
-        ((gethash "ok" hash) (funcall mapfn (gethash "result" hash)))
+        ((gethash "ok" hash) (parse-value type (gethash "result" hash)))
         ((aand (gethash "parameters" hash)
                (gethash "retry_after" it))
          (log-info "Should sleep for ~A seconds" it)
          (sleep it)
          (log-info "Good morning!")
-         (do-call% bot method uri mapfn args-encoded))
+         (do-call% bot method uri type args-encoded))
         (t (error "TG error ~A: ~A ~:A"
                   (gethash "error_code" hash)
                   (gethash "description" hash)
                   (gethash "parameters" hash)))))))
 
-(defun do-call (bot method path mapfn args-plist)
+(defun do-call (bot method path type args)
   (let ((uri (concatenate 'string (bot-base-uri bot) path))
-        (args-encoded (fixup-args (args-plist->alist args-plist))))
+        (args-encoded (fixup-args args)))
     (log-debug "~A .../~A ~S" method path args-encoded)
-    (do-call% bot method uri mapfn args-encoded)))
+    (do-call% bot method uri type args-encoded)))
diff --git a/src/bot/methods.lisp b/src/bot/methods.lisp
index 99b6411..7ccc4ad 100644
--- a/src/bot/methods.lisp
+++ b/src/bot/methods.lisp
@@ -2,22 +2,22 @@
 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
 (defpackage :ukkoclot/bot/methods
   (:use :c2cl :ukkoclot/bot/impl :ukkoclot/tg-types :ukkoclot/tg-types/macros)
-  (:export :answer-callback-query :delete-message :edit-message-text :get-me :get-updates :send-message :set-my-name))
+  (:export :answer-callback-query :delete-message :send-animation :edit-message-text :get-me :get-updates :send-message :set-my-name))
 (in-package :ukkoclot/bot/methods)
 
-(define-tg-method (answer-callback-query boolean "answerCallbackQuery" #'identity)
+(define-tg-method (answer-callback-query boolean "answerCallbackQuery")
   (callback-query-id string)
   (text (or string null) nil)
   (show-alert boolean nil)
   (url (or string null) nil)
   (cache-time (or integer null) nil))
 
-(define-tg-method (delete-message boolean "deleteMessage" #'identity)
+(define-tg-method (delete-message boolean "deleteMessage")
   (chat-id (or integer string))
   (message-id integer))
 
 ;; TODO: Add a way to simply specify :message msg :)
-(define-tg-method (edit-message-text message "editMessageText" #'hash->message)
+(define-tg-method (edit-message-text message "editMessageText")
   (business-connection-id (or string null) nil)
   (chat-id (or integer string null) nil)
   (message-id (or integer null) nil)
@@ -28,7 +28,7 @@
   (link-preview-options (or link-preview-options null) nil)
   (reply-markup (or inline-keyboard-markup null) nil))
 
-(define-tg-method (get-me% user "getMe" #'hash->user :GET))
+(define-tg-method (get-me% user "getMe" :GET))
 
 (defun get-me (bot)
   (let ((res (get-me% bot)))
@@ -36,16 +36,39 @@
     (setf (bot-username% bot) (user-username res))
     res))
 
-(define-tg-method (get-my-name bot-name "getMyName" #'hash->bot-name :GET)
+(define-tg-method (get-my-name bot-name "getMyName" :GET)
   (language-code (or string null) nil))
 
-(define-tg-method (get-updates (array update) "getUpdates" #'parse-update-array)
+(define-tg-method (get-updates (array update) "getUpdates")
   (offset (or integer null) nil)
   (limit (or integer null) nil)
   (timeout (or integer null) nil)
   (allowed-updates (or string null) nil))
 
-(define-tg-method (send-message message "sendMessage" #'hash->message)
+(define-tg-method (send-animation message "sendAnimation")
+  (business-connection-id (or string null) nil)
+  (chat-id (or integer string))
+  (message-thread-id (or integer null) nil)
+  (direct-messages-topic-id (or integer null) nil)
+  (animation (or pathname string))
+  (duration (or integer null) nil)
+  (width (or integer null) nil)
+  (height (or integer null) nil)
+  (thumbnail (or pathname string null) nil)
+  (caption (or string null) nil)
+  (parse-mode (or string null) nil)
+  (caption-entities (or (array message-entity) null) nil)
+  (show-caption-above-media boolean nil)
+  (has-spoiler boolean nil)
+  (disable-notification boolean nil)
+  (protect-content boolean nil)
+  (allow-paid-broadcast boolean nil)
+  (message-effect-id (or string null) nil)
+  (suggested-post-parameters (or suggested-post-parameters null) nil)
+  (reply-parameters (or reply-parameters null) nil)
+  (reply-markup (or inline-keyboard-markup reply-keyboard-markup reply-keyboard-remove force-reply null) nil))
+
+(define-tg-method (send-message message "sendMessage")
   (business-connection-id (or string null) nil)
   (chat-id (or integer string))
   (message-thread-id (or integer null) nil)
@@ -58,12 +81,9 @@
   (protect-content (or boolean null) nil)
   (message-effect-id (or string null) nil)
   (reply-parameters (or reply-parameters null) nil)
-  (reply-markup (or inline-keyboard-markup
-                    ;; TODO: reply-keyboard-markup
-                    ;; TODO: reply-keyboard-remove
-                    force-reply null) nil))
+  (reply-markup (or inline-keyboard-markup reply-keyboard-markup reply-keyboard-remove force-reply null) nil))
 
-(define-tg-method (set-my-name% boolean "setMyName" #'identity)
+(define-tg-method (set-my-name% boolean "setMyName")
   (name (or string null) nil)
   (language-code (or string null) nil))