(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") (defparameter +fsq-oauth-url+ "https://foursquare.com/oauth2/authenticate") (defparameter +fsq-token-url+ "https://foursquare.com/oauth2/access_token") (defsetting *client-id* nil "App Client ID") (defsetting *client-secret* nil "App Client Secret") (defun get-authorization-url (chat-id) (quri:render-uri (quri:merge-uris (quri:make-uri :query (quri:url-encode-params `(("response_type" . "code") ("client_id" . ,*client-id*) ("redirect_uri" . ,(get-oauth-url)) ("state" . ,(encode-oauth-state :fsq chat-id))))) (quri:uri +fsq-oauth-url+)))) (def-oauth-section-handler oauth-handler (:fsq) (if *code* (progn (log:info *code* *state*) (let* ((resp (json-request +fsq-token-url+ :method :post :content (list (cons "code" *code*) (cons "client_id" *client-id*) (cons "client_secret" *client-secret*) (cons "redirect_uri" (get-oauth-url)) (cons "grant_type" "authorization_code")))) (access-token (aget "access_token" resp)) (chat-id (parse-integer state))) (log:info chat-id access-token resp) (if access-token (let ((token-id (db/fsq-ensure-token access-token))) (db/fsq-set-chat-token-id chat-id token-id) (hunchentoot:redirect "/oauth/success")) (hunchentoot:redirect "/oauth/fail")))) (progn (log:info error) (hunchentoot:redirect "/oauth/fail")))) (defun %send-auth (chat-id) (bot-send-message "Нет токена" :chat-id chat-id :reply-markup (telegram-inline-keyboard-markup (list (list (list :text "Авторизоваться!" :url (get-authorization-url chat-id))))))) (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) :read-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) (bot-send-message (format nil "~{~A~^~%~}" texts) :chat-id chat-id)))) ;; Hooks (defmacro with-fsq-token ((token) &body body) `(let ((,token (db/fsq-get-chat-token *chat-id*))) (if ,token (progn ,@body) (%send-auth *chat-id*)))) (def-message-cmd-handler handle-cmd-post-checkins (:postcheckins) (with-fsq-token (token) (let ((users (db/fsq-get-chat-users *chat-id*))) (if (null *args*) (bot-send-message (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 (format nil "Больше не палим ~A" username))) (progn (push user users) (bot-send-message (format nil "Теперь палим ~A" username))))))) (db/fsq-set-chat-users *chat-id* users)))))) (def-message-cmd-handler handle-cmd-friends (:friends) (with-fsq-token (token) (let ((users (db/fsq-get-chat-users *chat-id*)) (friends (fsq-fetch-friends token))) (bot-send-message (text-chunks (loop for user in friends collect (format nil "~A: ~:[~;📍 ~]~A" (aget "id" user) (member (aget "id" user) users :test #'equal) (fsq-user-name user))) :text-sep " " :pre-pre "" :pre-post ""))))) (def-message-cmd-handler handle-cmd-checkins (:checkins) (with-fsq-token (token) (let ((users (db/fsq-get-chat-users *chat-id*))) (when users (bot-send-message (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)) '("Нету"))))))))