From 4da3ad1f569832845b58c3ce35149633a2bb665c Mon Sep 17 00:00:00 2001
From: Uko Kokņevičs
Date: Thu, 9 Oct 2025 21:58:43 +0300
Subject: Initial commit

---
 src/bot/impl.lisp    | 96 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/bot/methods.lisp | 88 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 184 insertions(+)
 create mode 100644 src/bot/impl.lisp
 create mode 100644 src/bot/methods.lisp

(limited to 'src/bot')

diff --git a/src/bot/impl.lisp b/src/bot/impl.lisp
new file mode 100644
index 0000000..b57e2d3
--- /dev/null
+++ b/src/bot/impl.lisp
@@ -0,0 +1,96 @@
+;; SPDX-License-Identifier: EUPL-1.2
+;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
+(defpackage :ukkoclot/bot/impl
+  (:use :c2cl :iterate :ukkoclot/config :ukkoclot/log)
+  (:import-from :anaphora :aand :acond :it)
+  (:import-from :dex)
+  (:import-from :ukkoclot/strings :lisp->snake-case)
+  (:local-nicknames
+   (:jzon :com.inuoe.jzon))
+  (:export
+   :arg-encode :bot :bot-p :make-bot :do-call
+
+   :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 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))))))
+
+(defgeneric fixup-arg (value)
+  (:documentation "Make sure Telegram & QURI & whatever like the arg")
+  (:method (value)
+    (error "Unsupported argument type ~S (~S)" (class-name (class-of value)) value))
+  (:method ((value null))
+    value)
+  (:method ((value number))
+    value)
+  (:method ((value string))
+    value)
+  (:method ((value hash-table))
+    (jzon:stringify value)))
+
+(defstruct (bot (:constructor make-bot%))
+  (config (error "No value given for config") :read-only t)
+  (db (error "No value given for DB") :read-only t)
+  (base-uri (error "No value given for base-uri") :read-only t)
+  (power-on t :type boolean)
+  (username% nil :type (or string null))
+  (id% nil :type (or integer null)))
+
+(defun make-bot (config db)
+  (let ((base-uri (concatenate 'string
+                               "https://api.telegram.org/bot"
+                               (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)
+    (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))))))
+
+(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)
+  (let ((body (req uri method args-encoded)))
+    (let ((hash (jzon:parse body)))
+      (acond
+        ((gethash "ok" hash) (funcall mapfn (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))
+        (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)
+  (let ((uri (concatenate 'string (bot-base-uri bot) path))
+        (args-encoded (fixup-args (args-plist->alist args-plist))))
+    (log-debug "~A .../~A ~S" method path args-encoded)
+    (do-call% bot method uri mapfn args-encoded)))
diff --git a/src/bot/methods.lisp b/src/bot/methods.lisp
new file mode 100644
index 0000000..b0eca5c
--- /dev/null
+++ b/src/bot/methods.lisp
@@ -0,0 +1,88 @@
+;; SPDX-License-Identifier: EUPL-1.2
+;; 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 :bot-id :bot-username :delete-message :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)
+  (callback-query-id string)
+  (text (or string null) nil)
+  (show-alert boolean nil)
+  (url (or string null) nil)
+  (cache-time (or integer null) nil))
+
+(defun bot-id (bot)
+  (or (bot-id% bot)
+      (progn
+        (get-me bot)
+        (bot-id% bot))))
+
+(defun bot-username (bot)
+  (or (bot-username% bot)
+      (progn
+        (get-me bot)
+        (bot-username% bot))))
+
+(define-tg-method (delete-message boolean "deleteMessage" #'identity)
+  (chat-id (or integer string))
+  (message-id integer))
+
+(define-tg-method (edit-message-text message "editMessageText" #'hash->message)
+  (business-connection-id (or string null) nil)
+  (chat-id (or integer string null) nil)
+  (message-id (or integer null) nil)
+  (inline-message-id (or string null) nil)
+  (text string)
+  (parse-mode (or string null) nil)
+  (entities (or (array message-entity) null) nil)
+  (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))
+
+(defun get-me (bot)
+  (let ((res (get-me% bot)))
+    (setf (bot-id% bot) (user-id res))
+    (setf (bot-username% bot) (user-username res))
+    res))
+
+(define-tg-method (get-my-name bot-name "getMyName" #'hash->bot-name :GET)
+  (language-code (or string null) nil))
+
+(define-tg-method (get-updates (array update) "getUpdates" #'parse-update-array)
+  (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)
+  (business-connection-id (or string null) nil)
+  (chat-id (or integer string))
+  (message-thread-id (or integer null) nil)
+  (text string)
+  ;; TODO: parse-mode should maybe be keywords?
+  (parse-mode (or string null) nil)
+  (entities (or (array message-entity) null) nil)
+  (link-preview-options (or link-preview-options null) nil)
+  (disable-notification (or boolean null) nil)
+  (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))
+
+(define-tg-method (set-my-name% boolean "setMyName" #'identity)
+  (name (or string null) nil)
+  (language-code (or string null) nil))
+
+(defun set-my-name (bot &key (name nil) (language-code nil))
+  (block nil
+    (when name
+      (let ((curr-name (get-my-name bot :language-code language-code)))
+        (when (string= name (bot-name-name curr-name))
+          (return))))
+    (unless (set-my-name% bot :name name :language-code language-code)
+      (error "Failed to set name"))))
-- 
cgit v1.2.3