Telegram inner workings, cron schedules

chatikbot.asd

@@ -4,13 +4,15 @@
   :author "Innokentiy Enikeev <me@enikesha.net>"
   :license "MIT"
   :depends-on (#:alexandria
-               #:flexi-streams
-               #:yason
                #:cl-oauth
-               #:trivial-utf-8)
+               #:clon
+               #:flexi-streams
+               #:log4cl
+               #:trivial-utf-8
+               #:yason)
   :serial t
   :components ((:file "package")
                (:file "utils")
                (:file "twitter")
-               (:file "chatikbot")
-               ))
+               (:file "telegram")
+               (:file "chatikbot")))

chatikbot.lisp

@@ -8,14 +8,78 @@
   (load file))
 
 
+(defvar *telegram-last-update* nil "Telegram last update_id")
+
+(defun process-updates ()
+  (loop for update in (telegram-get-updates :offset (and *telegram-last-update*
+                                                         (1+ *telegram-last-update*))
+                                            :timeout 60)
+     do (handle-message (aget "message" update))
+     do (setf *telegram-last-update*
+              (max (or *telegram-last-update* 0)
+                   (aget "update_id" update)))))
+
+(defun send-dont-understand (chat-id &optional reply-id)
+  (telegram-send-message chat-id "Ну хуууй знает" :reply-to reply-id))
+
+(defun handle-message (message)
+  (let ((id (aget "message-id" message))
+        (chat-id (aget "id" (aget "chat" message)))
+        (text (aget "text" message)))
+    (log:info "handle-message: ~A" message)
+    (when text
+      (if (equal #\/ (char text 0))
+          (let ((cmd (intern (string-upcase (subseq text 1)) "KEYWORD")))
+            (case cmd
+              (:akb (toggle-akb chat-id id))
+              (otherwise (send-dont-understand chat-id id))))
+          (send-dont-understand chat-id id)))))
 
 (defparameter +akb-user-id+ "3021296351" "Twitter user id of 'B-category anecdotes'")
 (defvar *akb-max-count* 5 "Max number of tweets to return per run")
 (defvar *akb-last-id* nil "id of last AKB tweet")
+(defvar *akb-send-to* nil "List of chat-id's to send AKBs to")
 
-(defun fetch-latest-akb ()
+(defun toggle-akb (chat-id message-id)
+  (let ((message "Хуярим аники"))
+    (if (member chat-id *akb-send-to*)
+        (setf message "Не хуярим больше аники"
+              *akb-send-to* (set-difference *akb-send-to*
+                                            (list chat-id)))
+        (setf *akb-send-to* (cons chat-id *akb-send-to*)))
+    (telegram-send-message chat-id message :reply-to message-id)))
+
+(defun process-latest-akb ()
   (loop for (id . text) in (get-tweets +akb-user-id+
                                        :since-id *akb-last-id*
                                        :count *akb-max-count*)
-     do (setf *akb-last-id* (max (or *akb-last-id* 0) id))
-     collect text))
+     do (handle-akb text)
+     do (setf *akb-last-id* (max (or *akb-last-id* 0) id))))
+
+(defun handle-akb (text)
+  (log:info "handle-akb: ~A" text)
+  (loop for chat-id in *akb-send-to*
+     do (telegram-send-message chat-id
+                               (replace-all text " / " (coerce '(#\Newline) 'string)))))
+
+
+(defvar *crons* (list
+                 (list #'process-latest-akb '(:minute (member 0 5 10 15 20 25 30 35 40 45 50 55)))
+                 )
+  "List of cron functions with their schedules")
+(defvar *cron-timers* nil)
+
+
+(defun start ()
+  (setf *cron-timers*
+        (loop for (function schedule) in *crons*
+           do (log:info "Starting cron" function schedule)
+           collect
+             (clon:schedule-function
+              (lambda () (funcall function))
+              (clon:make-scheduler
+               (apply #'clon:make-typed-cron-schedule schedule)
+               :allow-now-p t)
+              :thread t)))
+  (loop
+       do (process-updates)))

package.lisp

@@ -1,5 +1,5 @@
 (defpackage #:chatikbot
   (:use #:cl)
-  (:export #:*twitter-access-token*))
+  (:export #:start))
 
 (in-package #:chatikbot)

telegram.lisp

@@ -0,0 +1,36 @@
+(in-package #:chatikbot)
+
+(defvar *telegram-token* nil "Telegram bot token")
+(defparameter +telegram-api-format+ "https://api.telegram.org/bot~A/~A")
+
+(defun %telegram-api-call (method &optional args)
+  (let* ((params (loop for (k . v) in args collect (cons
+                                                    (princ-to-string k)
+                                                    (princ-to-string v))))
+         (response (yason:parse
+                   (flexi-streams:octets-to-string
+                    (drakma:http-request (format nil +telegram-api-format+ *telegram-token* method)
+                                         :method :post
+                                         :parameters params
+                                         :external-format-out :utf8)
+                    :external-format :utf8)
+                   :object-as :alist)))
+    (unless (aget "ok" response)
+      (error (aget "description" response)))
+    (aget "result" response)))
+
+(defun telegram-get-updates (&key offset limit timeout)
+  (%telegram-api-call
+   "getUpdates"
+   (list (cons "offset" offset)
+         (cons "limit" limit)
+         (cons "timeout" timeout))))
+
+(defun telegram-send-message (chat-id text &key disable-web-preview reply-to reply-markup)
+  (%telegram-api-call
+   "sendMessage"
+   (list (cons "chat_id" chat-id)
+         (cons "text" text)
+         (cons "disable_web_page_preview" disable-web-preview)
+         (cons "reply_to_message_id" reply-to)
+         (cons "reply_markup" reply-markup))))

twitter.lisp

@@ -24,5 +24,5 @@
                    *twitter-access-token*))
                  :object-as :alist)
      collect (cons
-              (cdr (assoc "id" status :test #'equal))
-              (cdr (assoc "text" status :test #'equal)))))
+              (aget "id" status)
+              (aget "text" status))))

utils.lisp

@@ -1,16 +1,19 @@
 (in-package #:chatikbot)
 
 (defun replace-all (string part replacement &key (test #'char=))
-"Returns a new string in which all the occurences of the part
+  "Returns a new string in which all the occurences of the part
 is replaced with replacement."
-    (with-output-to-string (out)
-      (loop with part-length = (length part)
-            for old-pos = 0 then (+ pos part-length)
-            for pos = (search part string
-                              :start2 old-pos
-                              :test test)
-            do (write-string string out
-                             :start old-pos
-                             :end (or pos (length string)))
-            when pos do (write-string replacement out)
-            while pos)))
+  (with-output-to-string (out)
+    (loop with part-length = (length part)
+       for old-pos = 0 then (+ pos part-length)
+       for pos = (search part string
+                         :start2 old-pos
+                         :test test)
+       do (write-string string out
+                        :start old-pos
+                        :end (or pos (length string)))
+       when pos do (write-string replacement out)
+       while pos)))
+
+(defmacro aget (key alist)
+  `(cdr (assoc ,key ,alist :test #'equal)))