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

Large update.

cl-telegram-bot.asd

@@ -11,3 +11,6 @@
   :pathname "src"
   :depends-on ("cl-telegram-bot/core")
   :in-order-to ((test-op (test-op "cl-telegram-bot-tests"))))
+
+
+(asdf:register-system-packages "log4cl" '("LOG"))

docs/changelog.lisp

@@ -11,6 +11,30 @@
                               "REPL"
                               "CL-TELEGRAM-BOT/MESSAGE:REPLY"
                               "HTTP"))
+  (0.6.0 2024-10-15
+         "
+Changed
+=======
+
+* CL-TELEGRAM-BOT/CHAT:GET-CHAT generic-function is now exported from cl-telegram-bot/chat package instead of cl-telegram-bot/message.
+  Also, now it is applicable to updates, and other objects which can be associated with a chat.
+* `callback-chat` function was removed from cl-telegram-bot/callback package. Use abovementionned `get-chat` generic-function.
+
+Added
+=====
+
+* CL-TELEGRAM-BOT/BOT:BOT-INFO was added to CL-TELEGRAM-BOT/BOT:BOT class.
+* Macro CL-TELEGRAM-BOT/BOT:DEFBOT now accepts optional slots and options like DEFCLASS macro does.
+* Class CL-TELEGRAM-BOT/ENTITIES/COMMAND:BOT-COMMAND now has bot-username slot and CL-TELEGRAM-BOT/ENTITIES/COMMAND:ON-COMMAND
+  generic-function is called in a group chat only if the command was addressed to a current bot. Previously, bot was not
+  able to process commands in group chats.
+* Some kinds of messages are wrapped into an envelope class now to distinguish between edited message, channel posts, and edited channel post. These envelope classes are gathered in package cl-telegram-bot/envelope.
+* CL-TELEGRAM-BOT/MESSAGE:GET-SENDER-CHAT was added.
+* CL-TELEGRAM-BOT/MESSAGE:GET-CURRENT-BOT function was added.
+* Functions CL-TELEGRAM-BOT/PAYMENTS:SEND-INVOICE, CL-TELEGRAM-BOT/PAYMENTS:ANSWER-SHIPPING-QUERY and CL-TELEGRAM-BOT/PAYMENTS:ANSWER-PRE-CHECKOUT-QUERY were fixed.
+* Package cl-telegram-bot/user was added with a bunch of classes and functions.
+
+")
   (0.5.0 2024-02-18
          "
 Added

docs/index.lisp

@@ -43,6 +43,7 @@
                                    "HTTP"
                                    "HTTPS"
                                    "MIME"
+                                   "CL"
                                    "TODO"
                                    "MIT"
                                    "API"

src/bot.lisp

@@ -11,9 +11,9 @@
            #:get-endpoint
            #:get-last-update-id
            #:token
-           #:sent-commands-cache))
-
-(in-package cl-telegram-bot/bot)
+           #:sent-commands-cache
+           #:bot-info))
+(in-package #:cl-telegram-bot/bot)
 
 
 (defclass bot ()
@@ -39,6 +39,9 @@
     :accessor file-endpoint
     :documentation "HTTPS file-endpoint"
     :initform nil)
+   (bot-info :initform nil
+             :documentation "This slot will be filled with CL-TELEGRAM-BOT/USER:USER object on first access using a call to CL-TELEGRAM-BOT/USER:GET-ME function."
+             :reader bot-info)
    (debug-mode
     :initform nil
     :initarg :debug-mode
@@ -52,10 +55,12 @@
                         :accessor sent-commands-cache)))
 
 
-(defmacro defbot (name)
+(defmacro defbot (name &optional slots options)
+  "Use this macro to define a class of your Telegram bot."
   `(progn
      (defclass ,name (bot)
-       ())
+       ,slots
+       ,@options)
 
      (defun ,(alexandria:symbolicate 'make- name) (token &rest args)
        (apply 'make-instance
@@ -79,5 +84,3 @@
       (bot stream :type t)
     (format stream
             "id=~A" (get-last-update-id bot))))
-
-

src/callback.lisp

@@ -2,7 +2,6 @@
   (:use #:cl)
   (:import-from #:cl-telegram-bot/message
                 #:message
-                #:get-chat
                 #:*current-message*
                 #:get-rest-args
                 #:get-text
@@ -11,6 +10,7 @@
   (:import-from #:cl-telegram-bot/pipeline
                 #:process)
   (:import-from #:cl-telegram-bot/chat
+                #:get-chat
                 #:get-chat-id)
   (:import-from #:cl-telegram-bot/response-processing
                 #:process-response)
@@ -19,8 +19,7 @@
            #:make-callback
            #:on-callback
            #:callback-id
-           #:callback-message
-           #:callback-chat))
+           #:callback-message))
 (in-package #:cl-telegram-bot/callback)
 
 
@@ -73,8 +72,5 @@
   (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))))
+(defmethod get-chat ((callback callback))
+  (get-chat (callback-message callback)))

src/chat.lisp

@@ -47,7 +47,8 @@
            #:get-slow-mode-delay
            #:get-join-by-request
            #:get-join-to-send-messages
-           #:get-can-set-sticker-set))
+           #:get-can-set-sticker-set
+           #:get-chat))
 (in-package cl-telegram-bot/chat)
 
 
@@ -237,3 +238,13 @@
 
 (def-telegram-call send-chat-action (chat action)
   "https://core.telegram.org/bots/api#sendchataction")
+
+
+
+(defgeneric get-chat (obj)
+  (:documentation "Returns a chat associated with object.
+
+                   Object could be a message, update, callback, etc. Should return an object of CHAT class or NIL.
+                   Some types of updates aren't bound to a chat. In this case a method should return NIL.")
+  (:method ((obj t))
+    (values nil)))

src/entities/command.lisp

@@ -1,9 +1,10 @@
 (uiop:define-package #:cl-telegram-bot/entities/command
   (:use #:cl)
   (:import-from #:log4cl)
-  (:import-from #:cl-telegram-bot/entities/core
-                #:entity
+  (:import-from #:cl-telegram-bot/entities/generic
                 #:make-entity-internal)
+  (:import-from #:cl-telegram-bot/entities/core
+                #:entity)
   (:import-from #:cl-telegram-bot/message
                 #:message
                 #:get-text)
@@ -12,6 +13,7 @@
   (:import-from #:cl-telegram-bot/pipeline
                 #:process)
   (:import-from #:cl-telegram-bot/bot
+                #:bot-info
                 #:bot
                 #:sent-commands-cache)
   (:import-from #:alexandria
@@ -26,8 +28,11 @@
                 #:set-my-commands)
   (:import-from #:str
                 #:replace-all)
+  (:import-from #:cl-telegram-bot/user
+                #:username)
   (:export #:get-command
            #:bot-command
+           #:bot-username
            #:get-rest-text
            #:on-command))
 (in-package #:cl-telegram-bot/entities/command)
@@ -37,27 +42,37 @@
   ((command :type keyword
             :initarg :command
             :reader get-command)
+   (bot-username :type (or null string)
+                 :initarg :bot-username
+                 :reader bot-username)
    (rest-text :type string
               :initarg :rest-text
               :reader get-rest-text)))
 
 
 (defmethod make-entity-internal ((entity-type (eql :bot-command))
                                  (payload message) data)
-  (declare (ignorable payload entity-type))
+  (declare (ignorable entity-type))
   (let* ((text (get-text payload))
          (offset (getf data :|offset|))
          (length (getf data :|length|))
-         (command (make-keyword (subseq text
-                                        (+ offset 1)
-                                        (+ offset length))))
+         (command-and-probably-bot-username
+           (subseq text
+                   (+ offset 1)
+                   (+ offset length)))
          (rest-text (string-trim " "
                                  (subseq text
                                          (+ offset length)))))
-    (make-instance 'bot-command
-                   :command command
-                   :rest-text rest-text
-                   :raw-data data)))
+    (destructuring-bind (command &optional bot-username)
+        (str:split #\@ command-and-probably-bot-username
+                   :omit-nulls t
+                   :limit 2)
+      (make-instance 'bot-command
+                     :command (make-keyword command)
+                     :payload payload
+                     :bot-username bot-username
+                     :rest-text rest-text
+                     :raw-data data))))
 
 
 (defgeneric on-command (bot command rest-text)
@@ -129,7 +144,11 @@
       (setf (sent-commands-cache bot)
             (update-commands bot
                              :command-name-to-check command-str-name)))
-
-    (on-command bot
-                command-name
-                (get-rest-text command))))
+
+    (when (or (null (bot-username command))
+              (string-equal (bot-username command)
+                            (username (bot-info bot))))
+        (on-command bot
+                    command-name
+                    (get-rest-text command)))))
+

src/entities/core.lisp

@@ -1,42 +1,37 @@
-(defpackage #:cl-telegram-bot/entities/core
+(uiop:define-package #:cl-telegram-bot/entities/core
   (:use #:cl)
   (:import-from #:cl-telegram-bot/utils
                 #:make-keyword)
   (:import-from #:arrows
                 #:->)
-  (:nicknames #:cl-telegram-bot/entities)
-  (:export
-   #:make-entity
-   #:make-entity-internal))
+  (:import-from #:cl-telegram-bot/message
+                #:message)
+  (:import-from #:cl-telegram-bot/chat
+                #:get-chat)
+  (:import-from #:cl-telegram-bot/entities/generic
+                #:make-entity-internal)
+  (:nicknames #:cl-telegram-bot/entities))
 (in-package cl-telegram-bot/entities/core)
 
 
 (defclass entity ()
-  ((raw-data :initarg :raw-data
+  ((payload :type message
+            :initarg :payload
+            :reader get-payload)
+   (raw-data :initarg :raw-data
              :reader get-raw-data)))
 
 
 (defclass unsupported-entity (entity)
   ())
 
 
-(defgeneric make-entity-internal (entity-type payload data)
-  (:documentation "Extendable protocol to support entities of different kinds.
-                   First argument is a keyword, denoting a type of the entity.
-                   Payload is an object of type `message'.
-                   And data is a plist with data, describing the entity."))
-
-
 (defmethod make-entity-internal (entity-type payload data)
   (declare (ignorable payload entity-type))
   (make-instance 'unsupported-entity
-                 :raw-data data))
+                 :raw-data data
+                 :payload payload))
 
 
-(defun make-entity (payload data)
-  (let ((entity-type (-> data
-                         (getf :|type|)
-                         (make-keyword))))
-    (make-entity-internal entity-type
-                          payload
-                          data)))
+(defmethod get-chat ((command entity))
+  (get-chat (get-payload command)))

src/entities/generic.lisp

@@ -0,0 +1,25 @@
+(uiop:define-package #:cl-telegram-bot/entities/generic
+  (:use #:cl)
+  (:import-from #:cl-telegram-bot/utils
+                #:make-keyword)
+  (:import-from #:arrows
+                #:->)
+  (:export #:make-entity
+           #:make-entity-internal))
+(in-package #:cl-telegram-bot/entities/generic)
+
+
+(defgeneric make-entity-internal (entity-type payload data)
+  (:documentation "Extendable protocol to support entities of different kinds.
+                   First argument is a keyword, denoting a type of the entity.
+                   Payload is an object of type `message'.
+                   And data is a plist with data, describing the entity."))
+
+
+(defun make-entity (payload data)
+  (let ((entity-type (-> data
+                         (getf :|type|)
+                         (make-keyword))))
+    (make-entity-internal entity-type
+                          payload
+                          data)))

src/envelope.lisp

@@ -0,0 +1,65 @@
+(uiop:define-package #:cl-telegram-bot/envelope
+  (:use #:cl)
+  (:import-from #:cl-telegram-bot/pipeline
+                #:process)
+  (:export #:wrapped-message
+           #:envelope
+           #:edited-message
+           #:channel-post
+           #:edited-channel-post
+           #:edited-message-p
+           #:channel-post-p))
+(in-package #:cl-telegram-bot/envelope)
+
+
+(defvar *wrappers* nil
+  "This var will hold a list of wrappers during the call to PROCESS generic-function. It is used by functions CHANNEL-POST-P and EDITED-MESSAGE-P.")
+
+
+(defclass envelope ()
+  ((message :initarg :message
+            :reader wrapped-message))
+  (:documentation "This is the container for a message. From the type of container we can understand if this message was sent to a channel or maybe edited, etc."))
+
+
+(defclass edited-message (envelope)
+  ()
+  (:documentation "This container wraps CL-TELEGRAM-BOT/MESSAGE:MESSAGE when user edits a message."))
+
+
+(defclass channel-post (envelope)
+  ()
+  (:documentation "This container wraps CL-TELEGRAM-BOT/MESSAGE:MESSAGE when somebody sends a message to a channel."))
+
+
+(defclass edited-channel-post (envelope)
+  ()
+  (:documentation "This container wraps CL-TELEGRAM-BOT/MESSAGE:MESSAGE when somebody edits a message in a channel."))
+
+
+(defmethod process ((bot t) (envelope envelope))
+  "By default, just calls `process' on the wrapped message."
+  (log:debug "Processing envelope" envelope)
+  (let ((message (wrapped-message envelope))
+        (*wrappers* (cons envelope *wrappers*)))
+    (process bot message)))
+
+
+(declaim (ftype (function () boolean)
+                channel-post-p))
+
+(defun channel-post-p ()
+  "Returns T if current message was posted to a channel."
+  (loop for wrapper in *wrappers*
+        thereis (or (typep wrapper 'channel-post)
+                    (typep wrapper 'edited-channel-post))))
+
+
+(declaim (ftype (function () boolean)
+                edited-message-p))
+
+(defun edited-message-p ()
+  "Returns T if current message is an update for existing message in the channel of group chat."
+  (loop for wrapper in *wrappers*
+        thereis (or (typep wrapper 'edited-message)
+                    (typep wrapper 'edited-channel-post))))