Refactored payments example to use states and actions.

cl-telegram-bot2-examples.asd

@@ -11,5 +11,6 @@
   :pathname "examples"
   :depends-on ("cl-telegram-bot2-examples/calc"
                "cl-telegram-bot2-examples/commands"
-               "cl-telegram-bot2-examples/gallery")
+               "cl-telegram-bot2-examples/gallery"
+               "cl-telegram-bot2-examples/payments")
   :in-order-to ((test-op (test-op "cl-telegram-bot2-tests"))))

examples/payments.lisp

@@ -8,6 +8,12 @@
   (:import-from #:cl-telegram-bot2/high
                 #:reply
                 #:chat-state)
+  (:import-from #:cl-telegram-bot2/actions/send-invoice
+                #:send-invoice)
+  (:import-from #:cl-telegram-bot2/state-with-commands
+                #:global-command
+                #:command
+                #:state-with-commands-mixin)
   (:import-from #:serapeum
                 #:fmt)
   (:import-from #:cl-telegram-bot2/pipeline
@@ -24,80 +30,57 @@
                 #:on-pre-checkout-query
                 #:on-result
                 #:on-state-activation
-                #:process))
+                #:process)
+  (:import-from #:cl-telegram-bot2/state
+                #:state)
+  (:import-from #:cl-telegram-bot2/actions/send-text
+                #:send-text)
+  (:import-from #:cl-telegram-bot2/term/back
+                #:back-to-id))
 (in-package #:cl-telegram-bot2-examples/payments)
 
 
-(defclass initial-state (state-with-commands-mixin)
-  ()
-  (:default-initargs
-   :commands (list
-              (command "/pay" (make-instance 'send-invoice)
-                       :description "Send invoice."))))
-
-
-(defclass send-invoice ()
-  ())
-
-
-;; (defmethod on-state-activation ((state initial-state))
-;;   ;; (reply "Use command /pay to start payment process.")
-;;   (values))
-
-
-(defmethod on-result ((state initial-state) result)
-  (reply "Welcome back! Give /pay command to start pyament process.")
-  (values))
-
-
-(defmethod process ((state initial-state) update)
-  (reply "Give /pay command to start payment process.")
-  (values))
-
-
-(defmethod on-state-activation ((state send-invoice))
-  (cl-telegram-bot2/api::send-invoice
-   (cl-telegram-bot2/api::chat-id cl-telegram-bot2/vars::*current-chat*)
-   ;; title
-   "Подписка на поиск судебных дел в течении месяца"
-   ;; description
-   "В течении месяца бот будет уведомлять вас о появлении новых судебных дел по вашим запросам."
-   ;; payload
-   "foo-bar-payload"
-   ;; provider token
-   "381764678:TEST:100070"
-   ;; currency
-   "RUB"
-   ;; prices
-   (list (serapeum:dict "label" "Руб"
-                        "amount" (* 120
-                                    ;; Выражать цену надо в копейках
-                                    100))))
-  (values))
-
-
-(defmethod process ((state send-invoice) update)
-  (let* ((message
-           (cl-telegram-bot2/api:update-message
-            update))
-         (successful-payment
-           (cl-telegram-bot2/api:message-successful-payment message)))
-    (when successful-payment
-      (reply "Спасибо за покупку!"))
-    'initial-state))
-
-
-
 (defbot test-bot ()
   ()
-  (:initial-state 'initial-state))
+  (:initial-state
+   (state (send-text "Use command /pay to start payment process.")
+          :id "initial"
+          :on-update (send-text "Give /pay command to start payment process.")
+          :on-result (send-text "Welcome back! Give /pay command to start payment process.")
+          :commands (list (command "/pay"
+                                   (send-invoice
+                                    ;; title
+                                    "Payment for the service"
+                                    ;; description
+                                    "This is the test service which will not be provided."
+                                    ;; payload
+                                    "foo-bar-payload"
+                                    ;; provider token
+                                    "381764678:TEST:100070"
+                                    ;; currency
+                                    "RUB"
+                                    ;; prices
+                                    (list (serapeum:dict "label" "Руб"
+                                                         "amount" (* 120
+                                                                     ;; Выражать цену надо в копейках
+                                                                     100)))
+                                    :on-success (list (send-text "Thank you for the payment!")
+                                                      (back-to-id "initial"))
+                                    :commands (list (command "/back"
+                                                             ;; TODO: найти способ удалить invoice message
+                                                             (list
+                                                              (send-text "Invoice canceled!")
+                                                              (back-to-id "initial"))))))))))
 
 
 (defmethod on-pre-checkout-query ((bot test-bot) (query pre-checkout-query))
   (answer-pre-checkout-query (cl-telegram-bot2/api:pre-checkout-query-id query)
-                             t))
+                             t)
+  (values))
 
 
+;; Technical parts:
+
 (defvar *bot* nil)
 
 
@@ -124,3 +107,11 @@
                  (str:starts-with? "timer-wheel" (bt:thread-name tr))
                  (str:starts-with? "telegram-bot" (bt:thread-name tr)))
         do (bt:destroy-thread tr)))
+
+
+(defun current-state ()
+  (first
+   (sento.actor-cell:state
+    (first
+     (sento.actor-context:all-actors
+      (cl-telegram-bot2/bot::actors-system *bot*))))))

v2/action.lisp

@@ -1,8 +1,34 @@
 (uiop:define-package #:cl-telegram-bot2/action
   (:use #:cl)
-  (:export #:action))
+  (:export #:action
+           #:call-if-action))
 (in-package #:cl-telegram-bot2/action)
 
 
 (defclass action ()
   ())
+
+
+
+(defun call-if-action (obj func &rest args)
+  "Useful in CL-TELEGRAM-BOT2/GENERICS:PROCESS handlers in case if
+   state has additional handler stored in the slot and this
+   slot can be either state or action.
+
+   This function is recursive, because processing of an action
+   could return another action and we should call FUNC until
+   a new state or NIL will be returned."
+  (typecase obj
+    (list
+       ;; Some handlers may represent a list of actions
+       ;; and states, thus we need to call FUNC
+       ;; while a non-nil and non-action object will be returned.
+       (loop for item in obj
+             thereis (apply #'call-if-action
+                            item func args)))
+    (action
+       (apply #'call-if-action
+              (apply func obj args)
+              args))
+    (t
+       obj)))

v2/actions/send-invoice.lisp

@@ -0,0 +1,136 @@
+(uiop:define-package #:cl-telegram-bot2/actions/send-invoice
+  (:use #:cl)
+  (:import-from #:cl-telegram-bot2/action
+                #:action)
+  (:import-from #:cl-telegram-bot2/generics
+                #:on-result
+                #:process
+                #:on-state-activation)
+  (:import-from #:cl-telegram-bot2/high
+                #:reply)
+  (:import-from #:serapeum
+                #:soft-list-of
+                #:->)
+  (:import-from #:cl-telegram-bot2/utils
+                #:call-if-needed)
+  (:import-from #:cl-telegram-bot2/workflow
+                #:workflow-blocks
+                #:workflow-block)
+  (:import-from #:cl-telegram-bot2/states/wait-for-payment
+                #:wait-for-payment)
+  (:import-from #:cl-telegram-bot2/state-with-commands
+                #:command)
+  (:export #:send-invoice))
+(in-package #:cl-telegram-bot2/actions/send-invoice)
+
+
+(deftype prices-list ()
+  '(soft-list-of hash-table))
+
+
+(defclass send-invoice (action)
+  ((title :initarg :title
+          :type (or string
+                    symbol)
+          :reader title)
+   (description :initarg :description
+                :type (or string
+                          symbol)
+                :reader description)
+   (payload :initarg :payload
+            :type (or string
+                      symbol)
+            :reader payload)
+   (provider-token :initarg :provider-token
+                   :type (or string
+                             symbol)
+                   :reader provider-token)
+   (currency :initarg :currency
+             :type (or string
+                       symbol)
+             :reader currency)
+   (prices :initarg :prices
+           :type (or prices-list
+                     symbol)
+           :reader prices)
+   (on-success :initarg :on-success
+               :type (or workflow-block
+                         workflow-blocks
+                         symbol)
+               :reader on-success)
+   (commands :initarg :commands
+             :initform nil
+             :type (soft-list-of command)
+             :reader commands)))
+
+
+(-> send-invoice ((or string symbol)
+                  (or string symbol)
+                  (or string symbol)
+                  (or string symbol)
+                  (or string symbol)
+                  (or prices-list symbol)
+                  &key
+                  (:on-success (or workflow-block
+                                   workflow-blocks
+                                   symbol))
+                  (:commands (soft-list-of command)))
+    (values send-invoice &optional))
+
+(defun send-invoice (title description payload provider-token currency prices &key on-success commands)
+  (make-instance 'send-invoice
+                 :title title
+                 :description description
+                 :payload payload
+                 :provider-token provider-token
+                 :currency currency
+                 :prices prices
+                 :on-success on-success
+                 :commands commands))
+
+
+(defmethod print-object ((obj send-invoice) stream)
+  (print-unreadable-object (obj stream :type t)
+    (format stream "~S"
+            (title obj))))
+
+
+(-> perform-action (send-invoice)
+    (values wait-for-payment &optional))
+
+(defun perform-action (action)
+  (cl-telegram-bot2/api::send-invoice
+   (cl-telegram-bot2/api::chat-id cl-telegram-bot2/vars::*current-chat*)
+   ;; title
+   (call-if-needed
+    (title action))
+   ;; description
+   (call-if-needed
+    (description action))
+   ;; payload
+   (call-if-needed
+    (payload action))
+   ;; provider token
+   (call-if-needed
+    (provider-token action))
+   ;; currency
+   (call-if-needed
+    (currency action))
+   ;; prices
+   (call-if-needed
+    (prices action)))
+
+  (wait-for-payment :on-success (on-success action)
+                    :commands (commands action)))
+
+
+(defmethod on-state-activation ((action send-invoice))
+  (perform-action action))
+
+
+(defmethod process ((action send-invoice) update)
+  (perform-action action))
+
+
+(defmethod on-result ((action send-invoice) result)
+  (perform-action action))

v2/generics.lisp

@@ -91,16 +91,19 @@
 
 
 (defgeneric on-pre-checkout-query (bot query)
+  (:documentation  "Pre-checkout-query object will be passed as this single arguement and
+                    function should return a boolean. When the function return True, user
+                    may proceed to the payment.
+
+                    Pre-checkout queries are not bound the the chat, so
+                    current-chat and current-state are not available during processing.
+                    This is why methods of this generic function should be defined on bot class.
+
+                    You can use CL-TELEGRAM-BOT2/API:PRE-CHECKOUT-QUERY-INVOICE-PAYLOAD function
+                    to extract payload from the query and find associated invoice.")
+
   (:method ((bot t) (query pre-checkout-query))
     (log:debug "Method on-pre-checkout-query is not defined for ~S."
                (class-name
                 (class-of bot)))
     (values)))
-
-
-;; (defgeneric on-command (bot command rest-text)
-;;   (:documentation "This method will be called for each command.
-;;                    First argument is a keyword. If user input was /save_note, then
-;;                    first argument will be :save-note.
-
-;;                    By default, logs call and does nothing."))