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