chatikbot/plugins/gsheets.lisp

(in-package :cl-user)
(defpackage chatikbot.plugins.gsheets
  (:use :cl :chatikbot.common))
(in-package :chatikbot.plugins.gsheets)

(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" . ,(get-oauth-url))
                             ("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
                                 :content (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
                                   :content (list
                                             (cons "code" code)
                                             (cons "client_id" *gsheets-client-id*)
                                             (cons "client_secret" *gsheets-client-secret*)
                                             (cons "redirect_uri" (get-oauth-url))
                                             (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 hash-body is-retry)
  (alexandria:when-let (access-token (gsheets-get-tokens token-id))
    (let* ((content (when hash-body
                      (with-output-to-string (stream)
                        (yason:encode hash-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
                      :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 :hash-body hash-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-file-watch (token-id file-id webhook &key token expiration payload params)
  (google-api-call token-id
                   (format nil "files/~A/watch" file-id) +gdrive-base-uri+
                   :method :post
                   :hash-body
                   (alexandria:plist-hash-table
                    (append
                     (list "kind" "api#channel"
                           "id" (princ-to-string (uuid:make-v4-uuid))
                           "type" "web_hook"
                           "address" (get-webhook-url webhook))
                     (when token (list "token" token))
                     (when expiration (list "expiration" expiration))
                     (when payload (list "payload" "true"))
                     (when params (list "params" params))))))

(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 ranges &key fields major-dimension)
  (google-api-call token-id
                   (format nil "spreadsheets/~A/values:batchGet" sheet-id) +gsheets-base-uri+
                   :parameters (append
                                (loop for range in (if (listp ranges) ranges (list ranges))
                                   collect (cons "ranges" range))
                                (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 major-dimension)
  (google-api-call token-id
                   (format nil "spreadsheets/~A/values:batchUpdate" sheet-id) +gsheets-base-uri+
                   :method :post
                   :hash-body
                   (alexandria:plist-hash-table
                    (list "valueInputOption" (if raw "RAW" "USER_ENTERED")
                          "data" (loop for (range . values) in range-values
                                    collect (alexandria:plist-hash-table
                                             (append
                                              (list "range" range
                                                    "values" values)
                                              (when major-dimension
                                                (list "majorDimension" major-dimension)))))))))

(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 (list (cons 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)))))))