chatikbot/plugins/foursquare.lisp

(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 "Нет токена"
                    :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)
                         :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)
         (%send-auth chat-id))))

(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
                        (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 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))
                                   '("Нету"))))))))