chatikbot/chatikbot.lisp

(in-package #:chatikbot)

(defvar *admins* nil "Admins chat-ids")
(defvar *bot-user-id* nil "Bot user_id")

;; Load config file
(alexandria:when-let (file (probe-file
                            (merge-pathnames "config.lisp"
                                             (asdf:component-pathname
                                              (asdf:find-system '#:chatikbot)))))
  (load file))

;; Init database
(db-init)
;; Load settings
(load-settings)
;; Load plugins
(defsetting *plugins* nil "List of enabled plugins")
(dolist (plugin *plugins*)
  (handler-case
      (load (merge-pathnames (format nil "plugins/~A.lisp" plugin)
                             (asdf:component-pathname
                              (asdf:find-system '#:chatikbot))))
    (error (e) (log:error e))))
;; Init plugin's database
(with-db (db)
  (run-hooks :db-init))

(defvar *telegram-last-update* 0 "Telegram last update_id")

;; getUpdates handling
(defun process-updates ()
  (loop for update in (telegram-get-updates :offset (and *telegram-last-update*
                                                         (1+ *telegram-last-update*))
                                            :timeout 300)
     ;; do (setf *telegram-last-update*
     ;;          (max *telegram-last-update* (aget "update_id" update)))
     do (handle-update update)))

(defun handle-update (update)
  (log:info update)
  (let ((update-id (aget "update_id" update))
        (reply-to (aget "id" (aget "from" (aget "reply_to_message" (aget "message" update))))))
    (if (> update-id *telegram-last-update*)
        (progn
          (if (and reply-to (not (equal reply-to *bot-user-id*)))
              (log:info "Reply not to bot")
              (loop for (key . value) in update
                 unless (equal "update_id" key)
                 do (run-hooks (keyify (format nil "update-~A" key)) value)))
          (setf *telegram-last-update* update-id))
        (log:warn "Out-of-order update" update-id))))

(defvar *start-message* "Hello" "Welcome message. Override it")
(def-message-cmd-handler handle-start (:start)
  (send-response chat-id *start-message*))

(def-message-admin-cmd-handler handle-admin-settings (:settings)
  (send-response chat-id
                 (format nil "~{~{~A~@[ (~A)~]: ~A~}~^~%~}"
                         (loop for symbol in *settings*
                            collect (list symbol (documentation symbol 'variable) (symbol-value symbol))))))

(def-message-admin-cmd-handler handle-admin-setsetting (:setsetting)
  (let* ((*package* (find-package :chatikbot))
         (var (read-from-string (car args)))
         (val (read-from-string (format nil "~{~A~^ ~}" (rest args)))))
    (send-response chat-id (format nil "OK, ~A" (set-setting var val)))))

(defcron process-watchdog ()
  (close
   (open (merge-pathnames ".watchdog"
                          (asdf:component-pathname
                           (asdf:find-system '#:chatikbot)))
         :direction :output
         :if-exists :supersede
         :if-does-not-exist :create)))


(defun cleanup ()
  ;; Clear prev threads
  (mapc #'trivial-timers:unschedule-timer (trivial-timers:list-all-timers))
  (let ((old-updates (find "process-updates"
                           (bordeaux-threads:all-threads)
                           :key #'bordeaux-threads:thread-name
                           :test #'equal)))
    (when old-updates
      (bordeaux-threads:destroy-thread old-updates))))

(defun start ()
  ;; Test telegram token
  (setf *bot-name* (concatenate 'string "@" (aget "username" (telegram-get-me)))
        *bot-user-id* (parse-integer *telegram-token* :end (position #\: *telegram-token*)))

  (cleanup)

  ;; Run 'starting' hooks to set up schedules
  (run-hooks :starting)

  (if *web-path*
      ;; If *web-path* is set, use webhooks
      (telegram-set-webhook (format nil "~A/~A" *web-path* *telegram-token*))
      ;; else start getUpdates thread
      (progn
        (telegram-set-webhook "") ;; Disable webhooks if present
        (bordeaux-threads:make-thread
         (lambda () (loop-with-error-backoff #'process-updates))
         :name "process-updates")))

  ;; Notify admins
  (dolist (admin *admins*)
    (ignore-errors
      (telegram-send-message admin (format nil "~A started at ~A" *bot-name* (format-ts (local-time:now)))))))