fsq: proper token handling

db.lisp

@@ -46,3 +46,18 @@
   (with-db (db)
     (db-execute "create table if not exists settings (var, val)")
     (db-execute "create unique index if not exists settings_var_unique on settings (var)")))
+
+(defun load-settings ()
+  (loop for (var val) in (db-select "select var, val from settings")
+     do (setf (symbol-value (intern var))
+              (handler-case (read-from-string val)
+                (error (e) (log:error e))))))
+
+(defun set-setting (symbol value)
+  (handler-case
+      (progn
+        (db-execute "replace into settings (var, val) values (?, ?)"
+                    (symbol-name symbol)
+                    (write-to-string value))
+        (setf (symbol-value symbol) value))
+    (error (e) (log:error e))))

plugins/foursquare.lisp

@@ -5,15 +5,13 @@
 (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)
+(defun %fsq-api-call (access-token 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 "oauth_token" access-token)
                                            (cons "v" "20150811")
                                            params)))
             (bordeaux-threads:timeout () (error "Timeout"))))
@@ -23,22 +21,24 @@
                      (aget "code" meta) (aget "errorType" meta) (aget "errorDetail" meta))))
     (aget "response" resp)))
 
-(defun fsq-fetch-checkins (&optional after-timestamp limit)
+(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 "checkins/recent"
+        (%fsq-api-call access-token "checkins/recent"
                        (list (cons "afterTimestamp" (or after-timestamp "0"))
                              (cons "limit" (or limit "20"))))))
 
-(defun fsq-fetch-friends (&optional offset)
+(defun fsq-fetch-friends (access-token &optional offset)
   (list*
-   (aget "user" (%fsq-api-call "users/self"))
+   (fsq-fetch-self access-token)
    (aget "items"
          (aget "friends"
-               (%fsq-api-call "users/self/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~]"
@@ -61,11 +61,31 @@
 
 ;; 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 (id, created_at)")
-  (db-execute "create index if not exists fsq_seen_idx on fsq_seen (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)))
@@ -79,80 +99,101 @@
     (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-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 (id)
-  (db-single "select id from fsq_seen where id = ? limit 1" 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 ()
-  (db-single "select created_at from fsq_seen order by created_at desc limit 1"))
+(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))
-        (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))))
+  (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 <token>"))))
+
+(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)
-  (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)))))
+  (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)
-  (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)))))))
+  (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)
-  (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)))))))
+  (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~^~%~}"
+                                  (loop for checkin in (fsq-fetch-checkins token)
+                                     if (member (aget "id" (aget "user" checkin)) users :test #'equal)
+                                     collect (fsq-format-checkin checkin t))))))))

utils.lisp

@@ -31,21 +31,6 @@
   `(progn (defvar ,var ,val ,doc)
           (push ',var *settings*)))
 
-(defun load-settings ()
-  (loop for (var val) in (db-select "select var, val from settings")
-     do (setf (symbol-value (intern var))
-              (handler-case (read-from-string val)
-                (error (e) (log:error e))))))
-
-(defun set-setting (symbol value)
-  (handler-case
-      (progn
-        (db-execute "replace into settings (var, val) values (?, ?)"
-                    (symbol-name symbol)
-                    (write-to-string value))
-        (setf (symbol-value symbol) value))
-    (error (e) (log:error e))))
-
 (defvar *backoff-start* 1 "Initial back-off")
 (defvar *backoff-max* 64 "Maximum back-off delay")