Merge pull request #20 from 40ants/many-changes

Add inline keyboards, callbacks and more.

.github/workflows/ci.yml

@@ -20,7 +20,7 @@
         "matrix": {
           "lisp": [
             "sbcl-bin",
-            "ccl-bin/1.12.0"
+            "ccl-bin"
           ]
         }
       },
@@ -35,39 +35,12 @@
           "name": "Checkout Code",
           "uses": "actions/checkout@v3"
         },
-        {
-          "name": "Grant All Perms to Make Cache Restoring Possible",
-          "run": "sudo mkdir -p /usr/local/etc/roswell\n                 sudo chown \"${USER}\" /usr/local/etc/roswell\n                 # Here the ros binary will be restored:\n                 sudo chown \"${USER}\" /usr/local/bin",
-          "shell": "bash"
-        },
-        {
-          "name": "Get Current Month",
-          "id": "current-month",
-          "run": "echo \"value=$(date -u \"+%Y-%m\")\" >> $GITHUB_OUTPUT",
-          "shell": "bash"
-        },
-        {
-          "name": "Cache Roswell Setup",
-          "id": "cache",
-          "uses": "actions/cache@v3",
-          "with": {
-            "path": "qlfile\nqlfile.lock\n~/.cache/common-lisp/\n~/.roswell\n/usr/local/etc/roswell\n/usr/local/bin/ros\n/usr/local/Cellar/roswell\n.qlot",
-            "key": "a-${{ steps.current-month.outputs.value }}-${{ env.cache-name }}-ubuntu-latest-quicklisp-${{ matrix.lisp }}-${{ hashFiles('qlfile.lock', '*.asd') }}"
-          }
-        },
-        {
-          "name": "Restore Path To Cached Files",
-          "run": "echo $HOME/.roswell/bin >> $GITHUB_PATH\n                 echo .qlot/bin >> $GITHUB_PATH",
-          "shell": "bash",
-          "if": "steps.cache.outputs.cache-hit == 'true'"
-        },
         {
           "name": "Setup Common Lisp Environment",
-          "uses": "40ants/setup-lisp@v2",
+          "uses": "40ants/setup-lisp@v3",
           "with": {
             "asdf-system": "cl-telegram-bot"
-          },
-          "if": "steps.cache.outputs.cache-hit != 'true'"
+          }
         },
         {
           "name": "Run Tests",

.github/workflows/docs.yml

@@ -54,7 +54,7 @@
         },
         {
           "name": "Setup Common Lisp Environment",
-          "uses": "40ants/setup-lisp@v2",
+          "uses": "40ants/setup-lisp@v3",
           "with": {
             "asdf-system": "cl-telegram-bot-docs"
           },

.github/workflows/linter.yml

@@ -54,7 +54,7 @@
         },
         {
           "name": "Setup Common Lisp Environment",
-          "uses": "40ants/setup-lisp@v2",
+          "uses": "40ants/setup-lisp@v3",
           "with": {
             "asdf-system": "cl-telegram-bot"
           },

.gitignore

@@ -4,3 +4,4 @@
 .#*
 .*.~undo-tree~
 .DS_Store
+*.fasl

docs/changelog.lisp

@@ -9,7 +9,35 @@
                               "ASDF"
                               "API"
                               "REPL"
+                              "CL-TELEGRAM-BOT/MESSAGE:REPLY"
                               "HTTP"))
+  (0.5.0 2024-02-18
+         "
+Added
+=====
+
+* Now bot can be started in debug mode. When this mode is on, then interactive debugger will pop up on errors.
+* If bot defines some commands implementing CL-TELEGRAM-BOT/ENTITIES/COMMAND:ON-COMMAND generic-function, then
+  these commands will be reported to the telegram server automatically and it will show the to user when he
+  starts text with `/`.
+* Added support for buttons with callbacks. To define a callback, implement a method for
+  CL-TELEGRAM-BOT/CALLBACK:ON-CALLBACK generic-function. After that, you can construct an inline keyboard
+  using CL-TELEGRAM-BOT/INLINE-KEYBOARD:INLINE-KEYBOARD function and CL-TELEGRAM-BOT/INLINE-KEYBOARD:CALLBACK-BUTTON function.
+  This keyboard object can be supplied as :REPLY-MARKUP argument to CL-TELEGRAM-BOT/RESPONSE:REPLY function.
+* New functions CL-TELEGRAM-BOT/RESPONSE:ALERT and CL-TELEGRAM-BOT/RESPONSE:NOTIFY were added. An example usage of these functions
+  along with inline keyboard was added to `example/bot.lisp`.
+* Function CL-TELEGRAM-BOT/RESPONSE-PROCESSING:INTERRUPT-PROCESSING was added in case if you want to interrupt processing of
+  current message and skip the rest of the handler.
+* Function CL-TELEGRAM-BOT/MESSAGE:GET-CURRENT-MESSAGE was added.
+* Function CL-TELEGRAM-BOT/MESSAGE:GET-CURRENT-CHAT was added.
+
+Removed
+=======
+
+* Function CL-TELEGRAM-BOT/MESSAGE:REPLY was removed and replaced with CL-TELEGRAM-BOT/RESPONSE:REPLY function.
+  Previously it interrupted the processing flow and you only was able to reply once. With the new function
+  you can respond with different pieces, for example to show user a image and text with inline keyboard.
+")
   (0.4.0 2023-04-22
          "
 * Changed a lot of imports some symbols not bound to functions were removed, some readers and accessors are exported.

example/bot.lisp

@@ -0,0 +1,64 @@
+(uiop:define-package #:example-bot/bot
+  (:use #:cl)
+  (:import-from #:cl-telegram-bot
+                #:start-processing
+                #:on-message
+                #:defbot)
+  (:import-from #:cl-telegram-bot/chat
+                #:private-chat
+                #:get-username)
+  (:import-from #:cl-telegram-bot/message
+                #:get-current-chat)
+  (:import-from #:serapeum
+                #:dict
+                #:fmt)
+  (:import-from #:cl-telegram-bot/response
+                #:alert
+                #:notify
+                #:reply)
+  (:import-from #:cl-telegram-bot/inline-keyboard
+                #:callback-button
+                #:inline-keyboard))
+(in-package #:example-bot/bot)
+
+
+(defbot example-bot)
+
+
+(defmethod on-message ((bot example-bot)
+                       text)
+  (let* ((chat (get-current-chat))
+         (username (get-username chat)))
+    (log:info "Talking to" username)
+    (let ((keyboard (when (string-equal text "show")
+                      (inline-keyboard
+                       (list 
+                        (callback-button "Alert" "alert")
+                        (callback-button "Notify" "notify")
+                        (callback-button "Text me" "text"))))))
+      (reply (fmt "Привет ~A!"
+                  username)
+             :reply-markup keyboard))))
+
+
+(defmethod cl-telegram-bot/callback:on-callback ((bot example-bot)
+                                                 callback)
+  (let ((data (cl-telegram-bot/callback:callback-data callback)))
+    (cond
+      ((string-equal data
+                     "alert")
+       (cl-telegram-bot/response:alert "You pressed alert button!"))
+
+      ((string-equal data
+                     "notify")
+       (cl-telegram-bot/response:reply "Just replying with text.")
+       (cl-telegram-bot/response:notify "You pressed notify button!"))
+      (t
+       (cl-telegram-bot/response:reply "Just replying with text.")))))
+
+
+(defun start (&key token)
+  (start-processing (make-example-bot (or token
+                                          (uiop:getenv "TELEGRAM_TOKEN")
+                                          (error "Define TELEGRAM_TOKEN env var.")))
+                    :debug t))

qlfile.lock

@@ -1,11 +1,11 @@
 ("quicklisp" .
  (:class qlot/source/dist:source-dist
   :initargs (:distribution "http://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest)
-  :version "2023-02-15"))
+  :version "2023-10-21"))
 ("ultralisp" .
  (:class qlot/source/dist:source-dist
   :initargs (:distribution "http://dist.ultralisp.org/" :%version :latest)
-  :version "20230422181501"))
+  :version "20240218111502"))
 ("slynk" .
  (:class qlot/source/github:source-github
   :initargs (:repos "svetlyak40wt/sly" :ref nil :branch "patches" :tag nil)

src/bot.lisp

@@ -3,13 +3,15 @@
   (:import-from #:log4cl)
   (:import-from #:dexador)
   (:import-from #:jonathan)
-  (:export #:bot
-           #:get-last-update-id
+  (:export #:api-uri
+           #:bot
+           #:debug-mode
            #:defbot
-           #:token
            #:file-endpoint
-           #:api-uri
-           #:get-endpoint))
+           #:get-endpoint
+           #:get-last-update-id
+           #:token
+           #:sent-commands-cache))
 
 (in-package cl-telegram-bot/bot)
 
@@ -36,7 +38,18 @@
     :initarg :file-endpoint
     :accessor file-endpoint
     :documentation "HTTPS file-endpoint"
-    :initform nil)))
+    :initform nil)
+   (debug-mode
+    :initform nil
+    :initarg :debug-mode
+    :accessor debug-mode
+    :documentation "When debug mode is T, then interactive debugger will be called on each error.")
+   (sent-commands-cache :initform nil
+                        :documentation "Command processing code will use this cache to update commands list on the server
+                                        when a new method for CL-TELEGRAM-BOT/ENTITIES/COMMAND:ON-COMMAND generic-function is defined.
+
+                                        This slot is for internal use."
+                        :accessor sent-commands-cache)))
 
 
 (defmacro defbot (name)

src/callback.lisp

@@ -0,0 +1,80 @@
+(uiop:define-package #:cl-telegram-bot/callback
+  (:use #:cl)
+  (:import-from #:cl-telegram-bot/message
+                #:message
+                #:get-chat
+                #:*current-message*
+                #:get-rest-args
+                #:get-text
+                #:*current-bot*
+                #:send-message)
+  (:import-from #:cl-telegram-bot/pipeline
+                #:process)
+  (:import-from #:cl-telegram-bot/chat
+                #:get-chat-id)
+  (:import-from #:cl-telegram-bot/response-processing
+                #:process-response)
+  (:export #:callback-data
+           #:callback
+           #:make-callback
+           #:on-callback
+           #:callback-id
+           #:callback-message
+           #:callback-chat))
+(in-package #:cl-telegram-bot/callback)
+
+
+(defclass callback ()
+  ((id :initarg :id
+       :type string
+       :reader callback-id)
+   (data :initarg :data
+         :type string
+         :reader callback-data)
+   (message :initarg :message
+            :type message
+            :reader callback-message)))
+
+
+(defgeneric on-callback (bot callback)
+  (:documentation "Called when user clicks callback button. Second argument is an object of CALLBACK type.")
+  (:method ((bot t) (callback t))
+    ;; Doing nothing
+    (values)))
+
+
+(defgeneric make-callback (bot callback-data)
+  (:documentation "Called when user clicks callback button. Should return an instance of CALLBACK class.
+
+                   Application may override this method to return objects of different callback classes depending on
+                   callback-data string. This way it mab be easier to define more specific methods for
+                   ON-CALLBACK generic-function.")
+  (:method ((bot t) (callback-data t))
+    (let ((id (getf callback-data :|id|))
+          (data (getf callback-data :|data|))
+          (message-data (getf callback-data :|message|)))
+      (make-instance 'callback
+                     :id id
+                     :data data
+                     :message (cl-telegram-bot/message:make-message message-data)))))
+
+
+(defmethod process ((bot t) (callback callback))
+  ""
+  (log:debug "Processing callback" callback)
+
+  (let ((*current-bot* bot)
+        (*current-message* callback))
+    (handler-case
+        (on-callback bot callback)
+      (cl-telegram-bot/response-processing:interrupt-processing (condition)
+        (declare (ignore condition))
+        (log:debug "Interrupting callback processing" callback))))
+  (values))
+
+
+(defgeneric callback-chat (callback)
+  (:documentation "Returns a chat from where callback was sent.")
+
+  (:method ((callback callback))
+    (cl-telegram-bot/message:get-chat (callback-message callback))))

src/ci.lisp

@@ -32,11 +32,9 @@
   :on-push-to "clos-everywhere"
   :by-cron "0 10 * * 1"
   :on-pull-request t
-  :cache t
+  ;; :cache t
   :jobs ((run-tests
           :asdf-system "cl-telegram-bot"
           :lisp ("sbcl-bin"
-                 ;; Issue https://github.com/roswell/roswell/issues/534
-                 ;; is still reproduces on 2023-02-06:
-                 "ccl-bin/1.12.0")
+                 "ccl-bin")
           :coverage t)))

src/commands.lisp

@@ -0,0 +1,44 @@
+(uiop:define-package #:cl-telegram-bot/commands
+  (:use #:cl)
+  (:import-from #:log4cl)
+  (:import-from #:cl-telegram-bot/chat
+                #:get-chat-id
+                #:make-chat
+                #:chat)
+  (:import-from #:cl-telegram-bot/entities/core
+                #:make-entity)
+  (:import-from #:cl-telegram-bot/network
+                #:make-request)
+  (:import-from #:cl-telegram-bot/pipeline
+                #:process)
+  (:import-from #:cl-telegram-bot/bot
+                #:bot)
+  (:import-from #:serapeum
+                #:soft-alist-of
+                #:defvar-unbound)
+  (:import-from #:cl-telegram-bot/utils
+                #:def-telegram-call)
+  (:import-from #:cl-telegram-bot/response-processing
+                #:process-response
+                #:interrupt-processing)
+  (:export))
+(in-package #:cl-telegram-bot/commands)
+
+
+(declaim (ftype (function (bot (or (soft-alist-of string string)
+                                   (serapeum:soft-list-of string)))
+                          (values))
+                set-my-commands))
+
+;; TODO: Support scope and language optional arguments
+(defun set-my-commands (bot commands)
+  "https://core.telegram.org/bots/api#setmycommands"
+  (log:debug "Sending commands to the server" commands)
+  (make-request bot "setMyCommands"
+                :|commands| (loop for command in commands
+                                  collect (etypecase command
+                                            (string (list :|command| command
+                                                          :|description| "No documentation."))
+                                            (cons (list :|command| (car command)
+                                                        :|description| (cdr command))))))
+  (values))