Google sheets basic operations

plugins/gsheets.lisp

@@ -0,0 +1,215 @@
+(in-package #:chatikbot)
+
+(defsetting *gsheets-client-id* nil "google oauth2 client id")
+(defsetting *gsheets-client-secret* nil "client secret")
+
+(defparameter +google-oauth-endpoint+ "https://accounts.google.com/o/oauth2/v2/auth" "Google OAuth2.0 endpoint")
+(defparameter +google-token-endpoint+ "https://www.googleapis.com/oauth2/v4/token" "Google OAuth2 token endpoint")
+
+(defparameter +gsheets-scope+ "https://www.googleapis.com/auth/drive.readonly https://www.googleapis.com/auth/spreadsheets" "Google Sheets API scopes to find edit sheets")
+(defparameter +gsheets-base-uri+ "https://sheets.googleapis.com/v4/")
+(defparameter +gdrive-base-uri+ "https://www.googleapis.com/drive/v3/")
+
+(defun update-alist-settings (symbol key value)
+  (set-setting symbol
+               (cons (cons key value)
+                     (remove key (symbol-value symbol) :key #'car))))
+
+(defvar *gsheets-from-tokens* nil "ALIST of (token-id . (access_token . refresh_token))")
+(defun gsheets-get-tokens (token-id)
+  (let ((tokens (aget token-id *gsheets-from-tokens*)))
+    (values (car tokens) (cdr tokens))))
+
+(defun gsheets-set-tokens (token-id access-token &optional refresh-token)
+  (update-alist-settings '*gsheets-from-tokens* token-id (cons access-token refresh-token)))
+
+(defun gsheets-get-authorization-url (state)
+  (quri:render-uri
+   (quri:merge-uris
+    (quri:make-uri :query (quri:url-encode-params
+                           `(("response_type" . "code")
+                             ("client_id" . ,*gsheets-client-id*)
+                             ("redirect_uri" . ,(quri:render-uri
+                                                 (quri:merge-uris (quri:uri "/oauth")
+                                                                  (quri:uri *web-path*))))
+                             ("scope" . ,+gsheets-scope+)
+                             ("state" . ,(encode-oauth-state :gsheets state))
+                             ("access_type" . "offline")
+                             ("prompt" . "consent"))))
+    (quri:uri +google-oauth-endpoint+))))
+
+(defun gsheets-refresh-access-token (token-id)
+  (multiple-value-bind (old-access-token refresh-token) (gsheets-get-tokens token-id)
+    (declare (ignore old-access-token))
+    (when refresh-token
+      (let* ((resp (json-request +google-token-endpoint+ :method :post
+                                 :parameters (list
+                                              (cons "refresh_token" refresh-token)
+                                              (cons "client_id" *gsheets-client-id*)
+                                              (cons "client_secret" *gsheets-client-secret*)
+                                              (cons "grant_type" "refresh_token"))))
+             (access-token (aget "access_token" resp)))
+        (log:info resp)
+        (when access-token
+          (gsheets-set-tokens token-id access-token refresh-token)
+          access-token)))))
+
+(def-oauth-section-handler gsheets-oauth-handler (:gsheets)
+  (if code
+      (progn
+        (log:info code state)
+        (let* ((resp (json-request +google-token-endpoint+ :method :post
+                                   :parameters (list
+                                                (cons "code" code)
+                                                (cons "client_id" *gsheets-client-id*)
+                                                (cons "client_secret" *gsheets-client-secret*)
+                                                (cons "redirect_uri" (quri:render-uri
+                                                                      (quri:merge-uris (quri:uri "/oauth")
+                                                                                       (quri:uri *web-path*))))
+                                                (cons "grant_type" "authorization_code"))))
+               (access-token (aget "access_token" resp))
+               (refresh-token (aget "refresh_token" resp))
+               (token-id (parse-integer state)))
+          (log:info token-id access-token refresh-token resp)
+          (if access-token
+              (progn
+                (gsheets-set-tokens token-id access-token refresh-token)
+                (hunchentoot:redirect "/oauth/success"))
+              (hunchentoot:redirect "/oauth/fail"))))
+      (progn
+        (log:info error)
+        (hunchentoot:redirect "/oauth/fail"))))
+
+(defun %gsheets-send-auth (chat-id token-id)
+  (bot-send-message chat-id "Нет токена"
+                    :reply-markup (telegram-inline-keyboard-markup
+                                   (list (list (list :text "Авторизоваться!"
+                                                     :url (gsheets-get-authorization-url token-id)))))))
+(defun google-api-call (token-id path base-url &key (method :get) parameters body is-retry)
+  (alexandria:when-let (access-token (gsheets-get-tokens token-id))
+    (let* ((content (when body
+                      (with-output-to-string (stream)
+                        (yason:encode (alexandria:plist-hash-table body) stream))))
+           (response (json-request
+                      (quri:render-uri (quri:merge-uris (quri:make-uri :path path) (quri:uri base-url)))
+                      :method method :parameters parameters :content content
+                      :additional-headers (list (cons "Authorization" (format nil "Bearer ~A" access-token)))))
+           (err (aget "error" response)))
+      (if (and err (equal 401 (aget "code" err)) (not is-retry) (gsheets-refresh-access-token token-id))
+          ;; Retry in case of auth error and successful token refresh
+          (google-api-call token-id path base-url :method method :parameters parameters :body body :is-retry t)
+          response))))
+
+(defun gsheets-find-files (token-id &optional next-page-token)
+  (google-api-call token-id "files" +gdrive-base-uri+
+                   :parameters `(("pageSize" . "10")
+                                 ("q" . "mimeType='application/vnd.google-apps.spreadsheet'")
+                                 ("pageToken" . ,next-page-token))))
+
+(defun gsheets-get-sheet (token-id sheet-id &key fields ranges include-grid-data)
+  (google-api-call token-id
+                   (format nil "spreadsheets/~A" sheet-id) +gsheets-base-uri+
+                   :parameters (append
+                                (when fields (list (cons "fields" fields)))
+                                (when ranges (list (cons "ranges" ranges)))
+                                (when include-grid-data (list (cons "includeGridData" include-grid-data))))))
+
+(defun gsheets-get-sheet-values (token-id sheet-id range &key fields major-dimension)
+  (google-api-call token-id
+                   (format nil "spreadsheets/~A/values/~A" sheet-id range) +gsheets-base-uri+
+                   :parameters (append
+                                (when fields (list (cons "fields" fields)))
+                                (when major-dimension (list (cons "majorDimension" major-dimension))))))
+
+(defun gsheets-put-sheet-values (token-id sheet-id range values &key raw)
+  (google-api-call token-id
+                   (format nil "spreadsheets/~A/values/~A" sheet-id range) +gsheets-base-uri+
+                   :method :put
+                   :parameters (list (cons "valueInputOption" (if raw "RAW" "USER_ENTERED")))
+                   :body (list "values" values)))
+
+(defvar *gsheets-chat-sheets* nil "ALIST of (chat-id . sheet-id)")
+(defvar *gsheets-chat-sheet-sessions* nil "ALIST of (chat-id . (files . next)) for sheet selection")
+
+(defun %gsheets-files-markup-update-session (chat-id token-id &optional next-page-token)
+  (let* ((resp (gsheets-find-files token-id next-page-token))
+         (files (aget "files" resp))
+         (next-page (aget "nextPageToken" resp)))
+    (when resp
+      (update-alist-settings '*gsheets-chat-sheet-sessions* chat-id (cons files next-page))
+      (telegram-inline-keyboard-markup
+       (append
+        (loop
+           for file in files
+           for index from 0
+           collect (list (list :text (format nil "📑 ~A" (aget "name" file))
+                               :callback-data (encode-callback-data
+                                               chat-id :gs (format nil "s-~A" index)))))
+        (list (list (list :text (if next-page "➡ Вперед" "🔁 Сначала")
+                          :callback-data (encode-callback-data chat-id :gs "n-1")))))))))
+
+(defun %gsheets-get-file-title-update-session (chat-id token-id sheet-id)
+  (when sheet-id
+    (let* ((sheet (gsheets-get-sheet token-id sheet-id :fields "properties.title"))
+           (title (aget "title" (aget "properties" sheet))))
+      (when title
+        (update-alist-settings '*gsheets-chat-sheets* chat-id sheet-id)
+        title))))
+
+(def-message-cmd-handler sheets-handler (:sheets :sheet)
+  (cond
+    (args
+     ;; Set active sheet
+     (let* ((uri (quri:uri (car args)))
+            (scheme (quri:uri-scheme uri))
+            (path (quri:uri-path uri))
+            (sheet-id (cond
+                        ((and (equal scheme "https")
+                              (equal (subseq path 0 (min 16 (length path))) "/spreadsheets/d/"))
+                         (subseq path 16 (position #\/ path :start 16)))
+                        ((null scheme) path)))
+            (title (%gsheets-get-file-title-update-session chat-id from-id sheet-id)))
+       (bot-send-message chat-id
+                         (if title
+                             (format nil "Выбран 📑 ~A" title)
+                             "Нет такого документа (или доступа)"))))
+    (:otherwise
+     ;; Show list of available files
+     (let ((files-markup (%gsheets-files-markup-update-session chat-id from-id)))
+       (if files-markup
+           (bot-send-message chat-id "Выбери документ:" :reply-markup files-markup)
+           (%gsheets-send-auth chat-id from-id))))))
+
+(def-message-cmd-handler sheet-read-handler (:sheet-read)
+  (let ((sheet-id (aget chat-id *gsheets-chat-sheets*)))
+    (if sheet-id
+        (let* ((range (car args))
+               (resp (gsheets-get-sheet-values from-id sheet-id range))
+               (values (aget "values" resp)))
+          (bot-send-message chat-id (format nil "```~%~{~{~A~^ ~}~^~%~}```" values)
+                            :parse-mode "markdown"))
+        (bot-send-message chat-id "Выбери документ сначала: /sheets"))))
+
+(def-message-cmd-handler sheet-write-handler (:sheet-write)
+  (let ((sheet-id (aget chat-id *gsheets-chat-sheets*)))
+    (if sheet-id
+        (let* ((range (car args))
+               (values (list (cdr args)))
+               (resp (gsheets-put-sheet-values from-id sheet-id range values)))
+          (bot-send-message chat-id (format nil "Записал в ~A" (aget "updatedRange" resp))))
+        (bot-send-message chat-id "Выбери документ сначала: /sheets"))))
+
+(def-callback-section-handler cb-handle-gss (:gs)
+  (destructuring-bind (type id) (split-sequence:split-sequence #\- data :count 2)
+    (case (intern (string-upcase type) "KEYWORD")
+      (:s (let* ((file (elt (car (aget chat-id *gsheets-chat-sheet-sessions*)) (parse-integer id)))
+                 (title (%gsheets-get-file-title-update-session chat-id from-id (aget "id" file))))
+            (telegram-edit-message-text
+             (if title (format nil "Выбран 📑 ~A" title) "Чот лажа")
+             :chat-id chat-id :message-id message-id)
+            (update-alist-settings '*gsheets-chat-sheet-sessions* chat-id nil)))
+      (:n (let* ((token-next (cdr (aget chat-id *gsheets-chat-sheet-sessions*)))
+                 (files-markup (%gsheets-files-markup-update-session chat-id from-id token-next)))
+            (if files-markup
+                (telegram-edit-message-reply-markup files-markup :chat-id chat-id :message-id message-id)
+                (telegram-edit-message-text "Чот лажа" :chat-id chat-id :message-id message-id)))))))

server.lisp

@@ -27,7 +27,33 @@
         (handle-update (yason:parse stream :object-as :alist)))
     (error (e) (log:error e))))
 
-(hunchentoot:define-easy-handler (oauth-handler :uri "/oauth")
-    (code state error (error-description :real-name "error_description"))
-  (setf (hunchentoot:content-type*) "text/plain")
-  (format nil "Hey~@[ ~A~]~@[ ~A~]~@[ ~A~]~@[ ~A~]!" code state error error-description))
+(hunchentoot:define-easy-handler (oauth-handler :uri "/oauth") (code error state)
+  (handler-case
+      (run-hooks :oauth code error state)
+    (error (e)
+      (log:error e)
+      (hunchentoot:redirect "/error"))))
+
+(hunchentoot:define-easy-handler (error-handler :uri "/error") ()
+  "<html>
+<head><title>Internal error</title></head>
+<body>
+<h1>Error :'(</h1>
+<p>Internal server error</p>
+</html>")
+
+(hunchentoot:define-easy-handler (oauth-success-handler :uri "/oauth/success") ()
+  "<html>
+<head><title>Auth Success</title></head>
+<body>
+<h1>Success!</h1>
+<p>OAuth successfully completed. You could close this tab and go back to telegram bot</p>
+</html>")
+
+(hunchentoot:define-easy-handler (oauth-fail-handler :uri "/oauth/fail") ()
+  "<html>
+<head><title>Auth failed</title></head>
+<body>
+<h1>Failed :(</h1>
+<p>OAuth failed. You probably didn't allow the access. Try again.</p>
+</html>")

utils.lisp

@@ -140,12 +140,11 @@ is replaced with replacement."
     (values (intern (string-upcase cmd) "KEYWORD") (rest args))))
 
 (defun http-default (url)
-  (let ((uri (puri:uri url)))
-    (puri:render-uri
-     (if (null (puri:uri-scheme uri))
-         (puri:uri (format nil "http://~A" url))
-         uri)
-     nil)))
+  (let ((uri (quri:uri url)))
+    (quri:render-uri
+     (if (null (quri:uri-scheme uri))
+         (quri:uri (format nil "http://~A" url))
+         uri))))
 
 ;; XML processing
 (defun xml-request (url &key encoding parameters)
@@ -195,9 +194,12 @@ is replaced with replacement."
     (string-trim '(#\Newline #\Space #\Return) (plump:text (elt (clss:select selector node) 0)))))
 
 ;; JSON processing
-(defun json-request (url &key (method :get) parameters (object-as :alist))
+(defun json-request (url &key (method :get) parameters content additional-headers (object-as :alist))
   (multiple-value-bind (stream status headers uri http-stream)
-      (drakma:http-request (http-default url) :method method :parameters parameters
+      (drakma:http-request (http-default url) :method method
+                           :parameters parameters
+                           :content content :content-type "application/json"
+                           :additional-headers additional-headers
                            :external-format-out :utf-8
                            :force-binary t :want-stream t :decode-content t)
     (declare (ignore status headers))
@@ -360,6 +362,30 @@ is replaced with replacement."
            ,@body
            t)))))
 
+(defun encode-oauth-state (section state)
+  (format nil "~A$~A" section state))
+(defun decode-oauth-state (raw-state)
+  (destructuring-bind (section data)
+      (split-sequence:split-sequence #\$ raw-state :count 2)
+    (values data (intern (string-upcase section) "KEYWORD"))))
+
+(defmacro def-oauth-handler (name (code error state) &body body)
+  `(progn
+     (defun ,name (,code ,error ,state)
+       (declare (ignorable ,code ,error ,state))
+       (handler-case (progn ,@body)
+         (error (e)
+           (log:error "~A" e)
+           (hunchentoot:redirect "/error"))))
+     (add-hook :oauth ',name)))
+
+(defmacro def-oauth-section-handler (name (&rest sections) &body body)
+  `(def-oauth-handler ,name (code error raw-state)
+     (multiple-value-bind (state section) (decode-oauth-state raw-state)
+       (when (member section (list ,@sections))
+         ,@body
+         t))))
+
 ;; Schedule
 (defmacro defcron (name (&rest schedule) &body body)
   (let ((schedule (or schedule '(:minute '* :hour '*))))