chatikbot/inline.lisp

(in-package :cl-user)
(defpackage chatikbot.inline
  (:use :cl :chatikbot.utils :chatikbot.telegram :chatikbot.crypto
        :chatikbot.macros)
  (:export :get-inline-keyboard
           :inline-button))
(in-package :chatikbot.inline)

(defstruct button callback created)
(defparameter +max-id+ 2000000 "Buttons store key range")
(defparameter +max-tries+ 100 "Tries to find free store key")
(defparameter +ttl+ (* 60 60 24 7) "Weekly TTL for buttons in store")

(defvar *inline-buttons* (make-hash-table) "Hashtable storing button actions")
(defvar *buttons-lock* (bt:make-recursive-lock "inline buttons lock"))

(defun add-button (callback)
  (bt:with-recursive-lock-held (*buttons-lock*)
    (let ((id (loop for id = (random +max-id+) then (random +max-id+)
                 for try from 1
                 unless (gethash id *inline-buttons*)
                 do (return id)
                 when (> try +max-tries+)
                 do (error "Can't get inline button id in ~A tries" try))))
      (setf (gethash id *inline-buttons*)
            (make-button :callback callback
                         :created (get-universal-time)))
      id)))

(defun prune-buttons ()
  (bt:with-recursive-lock-held (*buttons-lock*)
    (let ((now (get-universal-time)))
      (loop for id being the hash-keys in *inline-buttons* using (hash-value button)
         when (> (- now (button-created button))
                 +ttl+)
         do (remhash id *inline-buttons*)))))

(defcron process-prune-buttons ()
  (prune-buttons))

(defmacro inline-button ((text) &body body)
  (alexandria:with-gensyms (g-callback)
    `(cons ,text
           (lambda (,g-callback)
             (with-parsed-callback ,g-callback
               (handler-case (progn ,@body)
                 (error (e)
                   (log:error "~A" e)
                   (telegram-answer-callback-query
                    *query-id*
                    :text (format nil "Ошибочка вышла~@[: ~A~]"
                                  (when (is-admin) e))))))))))

(defun get-inline-keyboard (buttons &optional (chat-id *chat-id*))
  (telegram-inline-keyboard-markup
   (loop for row in buttons
      when row
      collect (loop for (text . callback) in row
                 when text
                 collect (list
                          :text text
                          :callback-data
                          (encode-callback-data
                           chat-id :inline (add-button callback) +ttl+))))))

(def-callback-section-handler cb-handle-inline (:inline)
  (let ((button (gethash (parse-integer *data*) *inline-buttons*)))
    (if button
        (funcall (button-callback button) *callback*)
        (progn
          (log:error "Can't find button id ~A" *data*)
          (telegram-answer-callback-query *query-id* :text "Ошибка")))))