(in-package #:chatikbot) ;; 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) (defvar *telegram-last-update* nil "Telegram last update_id") (defvar *admins* nil "Admins chat-ids") (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 (or *telegram-last-update* 0) (aget "update_id" update))) do (handle-message (aget "message" update)))) (defun send-response (chat-id response &optional reply-id) (if (consp response) (if (keywordp (car response)) (case (car response) (:text (telegram-send-message chat-id (cdr response) :reply-to reply-id)) (:sticker (telegram-send-sticker chat-id (cdr response) :reply-to reply-id))) (mapc #'(lambda (r) (send-response chat-id r reply-id)) response)) (telegram-send-message chat-id response :reply-to reply-id))) (defun send-dont-understand (chat-id &optional text reply-id) (let ((resp (eliza text))) (log:info text resp) (when resp (send-response chat-id resp reply-id)))) (defvar *chat-locations* nil "ALIST of chat->location") (defun preprocess-input (text) (when text (let ((first-word (subseq text 0 (position #\Space text)))) (if (equal first-word "@chatikbot") (preprocess-input (subseq text 11)) (replace-all text "@chatikbot" "ты"))))) (defun handle-message (message) (let ((id (aget "message_id" message)) (chat-id (aget "id" (aget "chat" message))) (text (aget "text" message)) (location (aget "location" message)) (sticker (aget "file_id" (aget "sticker" message)))) (log:info "handle-message" message) (when text (if (equal #\/ (char text 0)) (let ((cmd (intern (string-upcase (subseq text 1 (position #\Space text))) "KEYWORD")) (args (when (position #\Space text) (split-sequence:split-sequence #\Space (subseq text (1+ (position #\Space text))))))) (case cmd (:postakb (handle-cmd-post-akb chat-id id args)) (:akb (handle-cmd-akb chat-id id args)) (:weather (handle-cmd-weather chat-id id args)) (:hourly (handle-cmd-weather chat-id id '("hourly"))) (:daily (handle-cmd-weather chat-id id '("daily"))) (:rates (handle-cmd-rates chat-id id args)) (:charts (handle-cmd-charts chat-id id args)) (:postcheckins (handle-cmd-post-checkins chat-id id args)) (:friends (handle-cmd-fsq-friends chat-id id args)) (:checkins (handle-cmd-checkins chat-id id args)) (:rss (handle-cmd-rss chat-id id args)) (:feeds (handle-cmd-feeds chat-id id args)) (:lastrss (handle-cmd-last-rss chat-id id args)) (otherwise (handle-admin-cmd chat-id text cmd args)))) (send-dont-understand chat-id (preprocess-input text)))) (when location (push (cons chat-id location) *chat-locations*) (telegram-send-message chat-id "Взял на карандаш") (save-settings)) (when sticker (send-dont-understand chat-id)))) (defmacro handling-errors (&body body) `(handler-case (progn ,@body) (simple-condition (err) (format *error-output* "~&~A: ~%" (class-name (class-of err))) (apply (function format) *error-output* (simple-condition-format-control err) (simple-condition-format-arguments err)) (format *error-output* "~&")) (condition (err) (format *error-output* "~&~A: ~% ~S~%" (class-name (class-of err)) err)))) (defun rep (input) (when input (with-output-to-string (*standard-output*) (let ((*package* (find-package 'chatikbot)) (*error-output* *standard-output*)) (handling-errors (format t "~{~S~^ ;~% ~}~%" (multiple-value-list (eval (read-from-string input))))))))) (defun handle-admin-cmd (chat-id text cmd args) (if (find chat-id *admins*) (case cmd (:eval (telegram-send-message chat-id (rep (format nil "~{~A~^ ~}" args)))) (otherwise (send-dont-understand chat-id (preprocess-input (subseq text 1))))) (send-dont-understand chat-id (preprocess-input (subseq text 1))))) ;; AKB (defparameter +akb-vk-domain+ "baneks" "VK.com username of 'B-category anekdotes'") (defvar *akb-send-to* nil "List of chat-id's to send AKBs to") (defun handle-cmd-post-akb (chat-id message-id args) (log:info "handle-cmd-post-akb" chat-id message-id args) (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) (save-settings))) (defvar *akb-max-count* 5 "Max number of tweets to return per run") (defvar *akb-last-id* 0 "id of last AKB tweet") (defun format-akb (post) (let* ((id (aget "id" post)) (url (format nil "https://vk.com/~A?w=wall~A_~A" +akb-vk-domain+ (aget "from_id" post) id))) (format nil "~A~%~A" (aget "text" post) url))) (defun process-latest-akb () (handler-case (dolist (post (reverse (aget "items" (vk-wall-get :domain +akb-vk-domain+ :count *akb-max-count*)))) (let ((id (aget "id" post))) (when (> id *akb-last-id*) (send-akb (format-akb post)) (setf *akb-last-id* id) (save-settings)))) (error (e) (log:error e)))) (defun send-akb (text) (log:info "send-akb: ~A" text) (dolist (chat-id *akb-send-to*) (handler-case (telegram-send-message chat-id text :disable-web-preview 1) (error (e) (log:error e))))) (defun handle-cmd-akb (chat-id message-id args) (log:info "handle-cmd-akb" chat-id message-id args) (handler-case (progn (let ((total-aneks (aget "count" (vk-wall-get :domain +akb-vk-domain+ :count 1 :offset 10000000)))) (dolist (post (aget "items" (vk-wall-get :domain +akb-vk-domain+ :count (or (ignore-errors (parse-integer (car args))) 1) :offset (random total-aneks)))) (handler-case (telegram-send-message chat-id (format-akb post) :disable-web-preview 1) (error (e) (log:error e)))))) (error (e) (log:error e) (telegram-send-message chat-id "Ошибочка вышла")))) ;; Finance (defun process-rates () (handler-case (let ((ts (local-time:timestamp-to-unix (local-time:now))) (rates (get-rates)) (brent (get-brent))) (db-add-finance ts (aget "USD/RUB" rates) (aget "EUR/RUB" rates) (aget "GBP/RUB" rates) brent)) (error (e) (log:error e)))) (defun handle-cmd-rates (chat-id message-id args) (log:info "handle-cmd-rates" chat-id message-id args) (multiple-value-bind (ts usd eur gbp brent) (db-get-last-finance) (telegram-send-message chat-id (format nil "Зеленый ~,2F, гейро ~,2F, британец ~,2F, чёрная ~,2F @ ~A" usd eur gbp brent (format-ts (local-time:unix-to-timestamp ts)))))) (defun handle-cmd-charts (chat-id message-id args) (log:info "handle-cmd-charts" chat-id message-id args) (telegram-send-chat-action chat-id "upload_photo") (handler-case (let* ((usd (or (null args) (find "usd" args :test #'equal))) (eur (or (null args) (find "eur" args :test #'equal))) (gbp (or (null args) (find "gbp" args :test #'equal))) (brent (or (null args) (find "brent" args :test #'equal))) (avg (or (some #'(lambda (a) (when (find (princ-to-string a) args :test #'equal) (* a 60))) '(240 60 30 15 10 6 5 4 3 2 1)) 60)) (rates (multiple-value-list (db-get-last-finance)))) (if (or usd eur gbp brent) (let ((data (db-get-series (local-time:timestamp- (local-time:now) (* 800 avg) :sec) usd eur gbp brent avg))) (telegram-send-photo chat-id (make-chart data :usd usd :eur eur :gbp gbp :brent brent) :caption (format nil "Зеленый ~,2F, гейро ~,2F, британец ~,2F, чёрная ~,2F @ ~A" (elt rates 1) (elt rates 2) (elt rates 3) (elt rates 4) (format-ts (local-time:unix-to-timestamp (elt rates 0)))))) (telegram-send-message chat-id "Хуй тебе"))) (error (e) (log:error e) (telegram-send-message chat-id "Хуйня какая-то")))) ;; Weather (defun handle-cmd-weather (chat-id message-id args) (log:info "handle-cmd-weather" chat-id message-id args) (let ((location (cdr (assoc chat-id *chat-locations*)))) (telegram-send-message chat-id (if location (handler-case (forecast-format (forecast (aget "latitude" location) (aget "longitude" location) :hourly (find "hourly" args :key #'string-downcase :test #'equal) :daily (find "daily" args :key #'string-downcase :test #'equal))) (error (e) (log:error e) "Ошибочка вышла")) "Так а ты чьих будешь?")))) ;; Foursquare (defun fsq-user-name (user) (when user (format nil "~@[~A~]~@[ ~A~]" (aget "firstName" user) (aget "lastName" user)))) (defun handle-cmd-post-checkins (chat-id message-id args) (log:info "handle-cmd-post-checkins" chat-id message-id args) (handler-case (let ((users (db-fsq-get-chat-users chat-id)) (friends (fsq-fetch-friends))) (if (null args) (telegram-send-message chat-id (if (null users) "Пока никого не палим" (format nil "Палим ~{~A~^, ~}" (loop for user in friends when (member (aget "id" user) users :test #'equal) collect (fsq-user-name user))))) (progn (dolist (user args) (let ((username (fsq-user-name (find user friends :test #'equal :key #'(lambda (f) (aget "id" f)))))) (when username (if (member user users :test #'equal) (progn (setf users (remove user users :test #'equal)) (telegram-send-message chat-id (format nil "Больше не палим ~A" username))) (progn (push user users) (telegram-send-message chat-id (format nil "Теперь палим ~A" username))))))) (db-fsq-set-chat-users chat-id users)))) (error (e) (log:error e) (telegram-send-message chat-id "Ошибочка вышла")))) (defun handle-cmd-fsq-friends (chat-id message-id args) (log:info "handle-cmd-fsq-friends" chat-id message-id args) (handler-case (let ((users (db-fsq-get-chat-users chat-id)) (friends (fsq-fetch-friends))) (telegram-send-message chat-id (format nil "~{~A: ~:[~;📍 ~]~A~^~%~}" (loop for user in friends append (list (aget "id" user) (member (aget "id" user) users :test #'equal) (fsq-user-name user)))))) (error (e) (log:error e)))) (defun handle-cmd-checkins (chat-id message-id args) (log:info "handle-cmd-checkins" chat-id message-id args) (handler-case (let ((users (db-fsq-get-chat-users chat-id))) (when users (telegram-send-message chat-id (format nil "~{~A~^~%~}" (loop for checkin in (fsq-fetch-checkins) if (member (aget "id" (aget "user" checkin)) users :test #'equal) collect (fsq-format-checkin checkin t)))))) (error (e) (log:error e)))) (defun process-latest-checkins () (handler-case (let ((checkins (make-hash-table)) (ts (princ-to-string (1+ (or (db-fsq-last-created) -1))))) (dolist (checkin (fsq-fetch-checkins ts)) (let ((id (aget "id" checkin)) (created-at (aget "createdAt" checkin)) (user (aget "id" (aget "user" checkin)))) (unless (db-fsq-has-seen id) (dolist (chat-id (db-fsq-get-user-chats user)) (push (fsq-format-checkin checkin) (gethash chat-id checkins))) (db-fsq-add-seen id created-at)))) (loop for chat-id being the hash-keys in checkins using (hash-value texts) do (log:info "Sending checkins" chat-id texts) (telegram-send-message chat-id (format nil "~{~A~^~%~}" texts)))) (error (e) (log:error e)))) ;; RSS (defun handle-cmd-feeds (chat-id message-id args) (log:info "handle-cmd-feeds" chat-id message-id args) (handler-case (telegram-send-message chat-id (if (null args) "URL давай" (format nil "~:[Не нашел RSS там~;~:*~{~{~A - ~A~}~^~%~}~]" (find-rss-links (car args)))) :disable-web-preview 1) (error (e) (log:error e) (telegram-send-message chat-id "Ошибочка вышла")))) (defun %send-feeds (chat-id feeds) (telegram-send-message chat-id (if (null feeds) "Пока ничего не постим" (format nil "Постим~%~{~A) ~A: ~A~^~%~}" (loop for feed in feeds for index from 1 append (list index (feed-title feed) (feed-url feed))))) :disable-web-preview 1)) (defun %fetch-new-items (feed) (loop for item in (refresh-feed feed #'db-rss-item-exists) do (db-rss-add-item item) collect item)) (defun %get-feed (url) (when url (or (db-rss-get-feed-by-url url) (alexandria:when-let (feed (build-feed url)) (log:info "Added feed" feed) (db-rss-add-feed feed) (%fetch-new-items feed) feed)))) (defun handle-cmd-rss (chat-id message-id args) (log:info "handle-cmd-rss" chat-id message-id args) (handler-case (let ((feeds (db-rss-get-chat-feeds chat-id))) (if (null args) (%send-feeds chat-id feeds) (progn (dolist (url args) (handler-case (let ((idx (parse-integer url))) (when (<= idx (length feeds)) (setf feeds (remove (nth (1- idx) feeds) feeds)))) (parse-error () (alexandria:when-let (feed (%get-feed (or (cadar (find-rss-links url)) url))) (let ((existing (find (feed-url feed) feeds :key #'feed-url :test #'equal))) (if existing (setf feeds (remove existing feeds)) (push feed feeds))))) (error (e) (log:error e)))) (log:info feeds) (db-rss-set-chat-feeds chat-id feeds) (%send-feeds chat-id feeds)))) (error (e) (log:error e) (telegram-send-message chat-id "Ошибочка вышла")))) (defun handle-cmd-last-rss (chat-id message-id args) (log:info "handle-cmd-last-rss" chat-id message-id args) (handler-case (let ((feeds (db-rss-get-chat-feeds chat-id))) (if (null args) (%send-feeds chat-id feeds) (let* ((idx (1- (parse-integer (car args)))) (limit (min 20 (if (> (length args) 1) (parse-integer (second args)) 5))) (items (db-rss-last-feed-items (nth idx feeds) limit))) (telegram-send-message chat-id (format nil "~{~A~^~%~%~}" (mapcar #'format-feed-item items)) :disable-web-preview 1)))) (error (e) (log:error e) (telegram-send-message chat-id "Ошибочка вышла")))) (defun process-feeds () (handler-case (dolist (feed (remove-if-not #'need-fetch-p (db-rss-get-active-feeds))) (log:info "Fetching new items" (feed-url feed)) (dolist (item (%fetch-new-items feed)) (dolist (chat-id (db-rss-get-feed-chats feed)) (telegram-send-message chat-id (format-feed-item item) :disable-web-preview 1))) (db-rss-update-feed feed)) ;; Update next fetch and period (error (e) (log:error e)))) (defvar *save-settings-lock* (bordeaux-threads:make-lock "save-settings-lock") "Lock for multithreading access to write settings file") (defun save-settings() (bordeaux-threads:with-lock-held (*save-settings-lock*) (with-open-file (s (merge-pathnames "settings.lisp" (asdf:component-pathname (asdf:find-system '#:chatikbot))) :direction :output :if-exists :supersede :if-does-not-exist :create) (write '(in-package #:chatikbot) :stream s) (write `(setf *chat-locations* ',*chat-locations* *akb-send-to* ',*akb-send-to* *akb-last-id* ,*akb-last-id*) :stream s) (values)))) (defvar *schedules* '(process-latest-akb process-latest-checkins process-rates process-feeds) "Enabled schedules") (defun start () ;; 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))) ;; Load settings file (alexandria:when-let (file (probe-file (merge-pathnames "settings.lisp" (asdf:component-pathname (asdf:find-system '#:chatikbot))))) (load file)) ;; Start timers (dolist (func *schedules*) (clon:schedule-function func (clon:make-scheduler (clon:make-typed-cron-schedule :minute '* :hour '*) :allow-now-p t) :name func :thread t)) ;; Start getUpdates thread (bordeaux-threads:make-thread (lambda () (in-package #:chatikbot) (loop-with-error-backoff #'process-updates)) :name "process-updates"))