chatikbot/plugins/foursquare.lisp

(in-package #:chatikbot)

(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")

(defsetting *fsq-access-token* nil "Access token for a user under which the process is run")

(defun %fsq-api-call (method &optional params)
  (let* ((resp
          (handler-case
              (bordeaux-threads:with-timeout (5)
                (json-request (format nil *fsq-api-url* method)
                              :parameters (list*
                                           (cons "oauth_token" *fsq-access-token*)
                                           (cons "v" "20150811")
                                           params)))
            (bordeaux-threads:timeout () (error "Timeout"))))
         (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-checkins (&optional after-timestamp limit)
  (aget "recent"
        (%fsq-api-call "checkins/recent"
                       (list (cons "afterTimestamp" (or after-timestamp "0"))
                             (cons "limit" (or limit "20"))))))

(defun fsq-fetch-friends (&optional offset)
  (list*
   (aget "user" (%fsq-api-call "users/self"))
   (aget "items"
         (aget "friends"
               (%fsq-api-call "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_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 (id, created_at)")
  (db-execute "create index if not exists fsq_seen_idx on fsq_seen (id)"))

(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 (id created-at)
  (db-execute "insert into fsq_seen (id, created_at) values (?, ?)" id created-at))

(defun db/fsq-has-seen (id)
  (db-single "select id from fsq_seen where id = ? limit 1" id))

(defun db/fsq-last-created ()
  (db-single "select created_at from fsq_seen order by created_at desc limit 1"))

;; Cron
(defcron process-latest-checkins ()
  (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)))))

;; Hooks
(def-message-cmd-handler handle-cmd-post-checkins (:postcheckins)
  (let ((users (db/fsq-get-chat-users chat-id))
        (friends (fsq-fetch-friends)))
    (if (null args)
        (bot-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))
                      (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)
  (let ((users (db/fsq-get-chat-users chat-id))
        (friends (fsq-fetch-friends)))
    (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)
  (let ((users (db/fsq-get-chat-users chat-id)))
    (when users
      (bot-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)))))))