(in-package :cl-user) (defpackage chatikbot.plugins.foursquare (:use :cl :chatikbot.common :alexandria)) (in-package :chatikbot.plugins.foursquare) (defparameter *fsq-checkins-url* "https://api.foursquare.com/v2/checkins/recent" "URL of recent checkins API") (defparameter *fsq-api-url* "https://api.foursquare.com/v2/~A" "Foursquare API URL") (defun %fsq-api-call (access-token method &optional params) (let* ((resp (json-request (format nil *fsq-api-url* method) :parameters (list* (cons "oauth_token" access-token) (cons "v" "20150811") params) :timeout 5)) (meta (aget "meta" resp))) (when (not (= 200 (aget "code" meta))) (error (format nil "Foursquare API error, code ~A, errorType '~A', errorDetail '~A'" (aget "code" meta) (aget "errorType" meta) (aget "errorDetail" meta)))) (aget "response" resp))) (defun fsq-fetch-self (access-token) (aget "user" (%fsq-api-call access-token "users/self"))) (defun fsq-fetch-checkins (access-token &optional after-timestamp limit) (aget "recent" (%fsq-api-call access-token "checkins/recent" (list (cons "afterTimestamp" (or after-timestamp "0")) (cons "limit" (or limit "20")))))) (defun fsq-fetch-friends (access-token &optional offset) (list* (fsq-fetch-self access-token) (aget "items" (aget "friends" (%fsq-api-call access-token "users/self/friends" (list (cons "offset" (or offset "0")))))))) ;; Formatting (defun fsq-user-name (user) (when user (format nil "~@[~A~]~@[ ~A~]" (aget "firstName" user) (aget "lastName" user)))) (defun fsq-format-checkin (checkin &optional with-dates) (when checkin (let ((user (aget "user" checkin)) (venue (aget "venue" checkin))) (format nil "📍 ~@[~A~]~@[ ~A~]~@[ в ~A~]~@[ (~A)~]~@[ 📢 ~A~]~:[~; ~A~]" (aget "firstName" user) (aget "lastName" user) (aget "name" venue) (first (aget "formattedAddress" (aget "location" venue))) (aget "shout" checkin) with-dates (local-time:format-timestring nil (local-time:unix-to-timestamp (aget "createdAt" checkin)) :format '(:year "-" (:month 2) "-" (:day 2) " " (:hour 2) ":" (:min 2))))))) ;; Database (def-db-init (db-execute "create table if not exists fsq_tokens (id INTEGER PRIMARY KEY, token)") (db-execute "create table if not exists fsq_chat_tokens (token_id REFERENCES fsq_tokens, chat_id)") (db-execute "create unique index if not exists fsq_chat_tokens_idx on fsq_chat_tokens (token_id, chat_id)") (db-execute "create table if not exists fsq_chat_users (chat_id, user_id)") (db-execute "create index if not exists fsq_chat_users_chat_idx on fsq_chat_users (chat_id)") (db-execute "create index if not exists fsq_chat_users_user_idx on fsq_chat_users (user_id)") (db-execute "create table if not exists fsq_seen (token_id REFERENCES fsq_tokens, checkin_id, created_at)") (db-execute "create index if not exists fsq_seen_idx on fsq_seen (checkin_id)")) (defun db/fsq-ensure-token (token) (db-transaction (or (db-single "select id from fsq_tokens where token = ?" token) (db-execute "insert into fsq_tokens (token) values (?)" token)))) (defun db/fsq-get-chat-token (chat-id) (db-single "select t.token from fsq_chat_tokens ct inner join fsq_tokens t on t.id=ct.token_id where chat_id = ?" chat-id)) (defun db/fsq-set-chat-token-id (chat-id token-id) (db-execute "replace into fsq_chat_tokens (token_id, chat_id) values (?, ?)" token-id chat-id)) (defun db/fsq-get-active-tokens () (db-select "select id, token from fsq_tokens as t where exists (select 1 from fsq_chat_users cu inner join fsq_chat_tokens as ct on cu.chat_id=ct.chat_id and ct.token_id = t.id)")) (defun db/fsq-get-token-chats (token) (flatten (db-select "select chat_id from fsq_chat_tokens inner join fsq_tokens on token_id = id where token = ?" token))) (defun db/fsq-get-chat-users (chat-id) (flatten (db-select "select user_id from fsq_chat_users where chat_id = ?" chat-id))) (defun db/fsq-get-user-chats (user-id) (flatten (db-select "select chat_id from fsq_chat_users where user_id = ?" user-id))) (defun db/fsq-set-chat-users (chat-id users) (db-transaction (db-execute "delete from fsq_chat_users where chat_id = ?" chat-id) (dolist (user-id users) (db-execute "insert into fsq_chat_users (chat_id, user_id) values (?, ?)" chat-id user-id)))) (defun db/fsq-add-seen (token-id checkin-id created-at) (db-execute "insert into fsq_seen (token_id, checkin_id, created_at) values (?, ?, ?)" token-id checkin-id created-at)) (defun db/fsq-has-seen (checkin-id) (db-single "select checkin_id from fsq_seen where checkin_id = ? limit 1" checkin-id)) (defun db/fsq-has-seen-via (token-id checkin-id) (db-single "select checkin_id from fsq_seen where token_id = ? and checkin_id = ? limit 1" token-id checkin-id)) (defun db/fsq-last-created (token-id) (db-single "select created_at from fsq_seen where token_id = ? order by created_at desc limit 1" token-id)) ;; Cron (defcron process-latest-checkins () (let ((checkins (make-hash-table))) (loop for (token-id token) in (db/fsq-get-active-tokens) for ts = (princ-to-string (1+ (or (db/fsq-last-created token-id) -1))) do (dolist (checkin (fsq-fetch-checkins token ts)) (let ((checkin-id (aget "id" checkin)) (created-at (aget "createdAt" checkin)) (user-id (aget "id" (aget "user" checkin)))) (unless (db/fsq-has-seen-via token-id checkin-id) (unless (db/fsq-has-seen checkin-id) (dolist (chat-id (db/fsq-get-user-chats user-id)) (push (fsq-format-checkin checkin) (gethash chat-id checkins)))) (db/fsq-add-seen token-id checkin-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))))) ;; Hooks (defmacro with-fsq-token ((token chat-id) &body body) `(let ((,token (db/fsq-get-chat-token ,chat-id))) (if ,token (progn ,@body) (bot-send-message ,chat-id "Заебош токен через /fsqtoken ")))) (def-message-cmd-handler handle-cmd-fsqtoken (:fsqtoken) (let* ((token (car args)) (self (fsq-fetch-self token)) (token-id (db/fsq-ensure-token token))) (db/fsq-set-chat-token-id chat-id token-id) (bot-send-message chat-id (format nil "~A, твоих друзяш будем палить теперь" (fsq-user-name self))))) (def-message-cmd-handler handle-cmd-post-checkins (:postcheckins) (with-fsq-token (token chat-id) (let ((users (db/fsq-get-chat-users chat-id))) (if (null args) (bot-send-message chat-id (if (null users) "Пока никого не палим" (format nil "Палим ~{~A~^, ~}" (loop for user in (fsq-fetch-friends token) when (member (aget "id" user) users :test #'equal) collect (fsq-user-name user))))) (let ((friends (fsq-fetch-friends token))) (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)) (bot-send-message chat-id (format nil "Больше не палим ~A" username))) (progn (push user users) (bot-send-message chat-id (format nil "Теперь палим ~A" username))))))) (db/fsq-set-chat-users chat-id users)))))) (def-message-cmd-handler handle-cmd-friends (:friends) (with-fsq-token (token chat-id) (let ((users (db/fsq-get-chat-users chat-id)) (friends (fsq-fetch-friends token))) (bot-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)))))))) (def-message-cmd-handler handle-cmd-checkins (:checkins) (with-fsq-token (token chat-id) (let ((users (db/fsq-get-chat-users chat-id))) (when users (bot-send-message chat-id (format nil "~{~A~^~%~}" (or (loop for checkin in (fsq-fetch-checkins token) if (member (aget "id" (aget "user" checkin)) users :test #'equal) collect (fsq-format-checkin checkin t)) '("Нету"))))))))