(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-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 :body (append (list "kind" "api#channel" "id" (princ-to-string (uuid:make-v4-uuid)) "type" "web_hook" "address" (quri:render-uri (quri:merge-uris (quri:uri (format nil "/hook/~A" webhook)) (quri:uri *web-path*)))) (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) (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)))))))