1
0

gsheets.lisp 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215
  1. (in-package #:chatikbot)
  2. (defsetting *gsheets-client-id* nil "google oauth2 client id")
  3. (defsetting *gsheets-client-secret* nil "client secret")
  4. (defparameter +google-oauth-endpoint+ "https://accounts.google.com/o/oauth2/v2/auth" "Google OAuth2.0 endpoint")
  5. (defparameter +google-token-endpoint+ "https://www.googleapis.com/oauth2/v4/token" "Google OAuth2 token endpoint")
  6. (defparameter +gsheets-scope+ "https://www.googleapis.com/auth/drive.readonly https://www.googleapis.com/auth/spreadsheets" "Google Sheets API scopes to find edit sheets")
  7. (defparameter +gsheets-base-uri+ "https://sheets.googleapis.com/v4/")
  8. (defparameter +gdrive-base-uri+ "https://www.googleapis.com/drive/v3/")
  9. (defun update-alist-settings (symbol key value)
  10. (set-setting symbol
  11. (cons (cons key value)
  12. (remove key (symbol-value symbol) :key #'car))))
  13. (defvar *gsheets-from-tokens* nil "ALIST of (token-id . (access_token . refresh_token))")
  14. (defun gsheets-get-tokens (token-id)
  15. (let ((tokens (aget token-id *gsheets-from-tokens*)))
  16. (values (car tokens) (cdr tokens))))
  17. (defun gsheets-set-tokens (token-id access-token &optional refresh-token)
  18. (update-alist-settings '*gsheets-from-tokens* token-id (cons access-token refresh-token)))
  19. (defun gsheets-get-authorization-url (state)
  20. (quri:render-uri
  21. (quri:merge-uris
  22. (quri:make-uri :query (quri:url-encode-params
  23. `(("response_type" . "code")
  24. ("client_id" . ,*gsheets-client-id*)
  25. ("redirect_uri" . ,(quri:render-uri
  26. (quri:merge-uris (quri:uri "/oauth")
  27. (quri:uri *web-path*))))
  28. ("scope" . ,+gsheets-scope+)
  29. ("state" . ,(encode-oauth-state :gsheets state))
  30. ("access_type" . "offline")
  31. ("prompt" . "consent"))))
  32. (quri:uri +google-oauth-endpoint+))))
  33. (defun gsheets-refresh-access-token (token-id)
  34. (multiple-value-bind (old-access-token refresh-token) (gsheets-get-tokens token-id)
  35. (declare (ignore old-access-token))
  36. (when refresh-token
  37. (let* ((resp (json-request +google-token-endpoint+ :method :post
  38. :parameters (list
  39. (cons "refresh_token" refresh-token)
  40. (cons "client_id" *gsheets-client-id*)
  41. (cons "client_secret" *gsheets-client-secret*)
  42. (cons "grant_type" "refresh_token"))))
  43. (access-token (aget "access_token" resp)))
  44. (log:info resp)
  45. (when access-token
  46. (gsheets-set-tokens token-id access-token refresh-token)
  47. access-token)))))
  48. (def-oauth-section-handler gsheets-oauth-handler (:gsheets)
  49. (if code
  50. (progn
  51. (log:info code state)
  52. (let* ((resp (json-request +google-token-endpoint+ :method :post
  53. :parameters (list
  54. (cons "code" code)
  55. (cons "client_id" *gsheets-client-id*)
  56. (cons "client_secret" *gsheets-client-secret*)
  57. (cons "redirect_uri" (quri:render-uri
  58. (quri:merge-uris (quri:uri "/oauth")
  59. (quri:uri *web-path*))))
  60. (cons "grant_type" "authorization_code"))))
  61. (access-token (aget "access_token" resp))
  62. (refresh-token (aget "refresh_token" resp))
  63. (token-id (parse-integer state)))
  64. (log:info token-id access-token refresh-token resp)
  65. (if access-token
  66. (progn
  67. (gsheets-set-tokens token-id access-token refresh-token)
  68. (hunchentoot:redirect "/oauth/success"))
  69. (hunchentoot:redirect "/oauth/fail"))))
  70. (progn
  71. (log:info error)
  72. (hunchentoot:redirect "/oauth/fail"))))
  73. (defun %gsheets-send-auth (chat-id token-id)
  74. (bot-send-message chat-id "Нет токена"
  75. :reply-markup (telegram-inline-keyboard-markup
  76. (list (list (list :text "Авторизоваться!"
  77. :url (gsheets-get-authorization-url token-id)))))))
  78. (defun google-api-call (token-id path base-url &key (method :get) parameters body is-retry)
  79. (alexandria:when-let (access-token (gsheets-get-tokens token-id))
  80. (let* ((content (when body
  81. (with-output-to-string (stream)
  82. (yason:encode (alexandria:plist-hash-table body) stream))))
  83. (response (json-request
  84. (quri:render-uri (quri:merge-uris (quri:make-uri :path path) (quri:uri base-url)))
  85. :method method :parameters parameters :content content
  86. :additional-headers (list (cons "Authorization" (format nil "Bearer ~A" access-token)))))
  87. (err (aget "error" response)))
  88. (if (and err (equal 401 (aget "code" err)) (not is-retry) (gsheets-refresh-access-token token-id))
  89. ;; Retry in case of auth error and successful token refresh
  90. (google-api-call token-id path base-url :method method :parameters parameters :body body :is-retry t)
  91. response))))
  92. (defun gsheets-find-files (token-id &optional next-page-token)
  93. (google-api-call token-id "files" +gdrive-base-uri+
  94. :parameters `(("pageSize" . "10")
  95. ("q" . "mimeType='application/vnd.google-apps.spreadsheet'")
  96. ("pageToken" . ,next-page-token))))
  97. (defun gsheets-get-sheet (token-id sheet-id &key fields ranges include-grid-data)
  98. (google-api-call token-id
  99. (format nil "spreadsheets/~A" sheet-id) +gsheets-base-uri+
  100. :parameters (append
  101. (when fields (list (cons "fields" fields)))
  102. (when ranges (list (cons "ranges" ranges)))
  103. (when include-grid-data (list (cons "includeGridData" include-grid-data))))))
  104. (defun gsheets-get-sheet-values (token-id sheet-id range &key fields major-dimension)
  105. (google-api-call token-id
  106. (format nil "spreadsheets/~A/values/~A" sheet-id range) +gsheets-base-uri+
  107. :parameters (append
  108. (when fields (list (cons "fields" fields)))
  109. (when major-dimension (list (cons "majorDimension" major-dimension))))))
  110. (defun gsheets-put-sheet-values (token-id sheet-id range values &key raw)
  111. (google-api-call token-id
  112. (format nil "spreadsheets/~A/values/~A" sheet-id range) +gsheets-base-uri+
  113. :method :put
  114. :parameters (list (cons "valueInputOption" (if raw "RAW" "USER_ENTERED")))
  115. :body (list "values" values)))
  116. (defvar *gsheets-chat-sheets* nil "ALIST of (chat-id . sheet-id)")
  117. (defvar *gsheets-chat-sheet-sessions* nil "ALIST of (chat-id . (files . next)) for sheet selection")
  118. (defun %gsheets-files-markup-update-session (chat-id token-id &optional next-page-token)
  119. (let* ((resp (gsheets-find-files token-id next-page-token))
  120. (files (aget "files" resp))
  121. (next-page (aget "nextPageToken" resp)))
  122. (when resp
  123. (update-alist-settings '*gsheets-chat-sheet-sessions* chat-id (cons files next-page))
  124. (telegram-inline-keyboard-markup
  125. (append
  126. (loop
  127. for file in files
  128. for index from 0
  129. collect (list (list :text (format nil "📑 ~A" (aget "name" file))
  130. :callback-data (encode-callback-data
  131. chat-id :gs (format nil "s-~A" index)))))
  132. (list (list (list :text (if next-page "➡ Вперед" "🔁 Сначала")
  133. :callback-data (encode-callback-data chat-id :gs "n-1")))))))))
  134. (defun %gsheets-get-file-title-update-session (chat-id token-id sheet-id)
  135. (when sheet-id
  136. (let* ((sheet (gsheets-get-sheet token-id sheet-id :fields "properties.title"))
  137. (title (aget "title" (aget "properties" sheet))))
  138. (when title
  139. (update-alist-settings '*gsheets-chat-sheets* chat-id sheet-id)
  140. title))))
  141. (def-message-cmd-handler sheets-handler (:sheets :sheet)
  142. (cond
  143. (args
  144. ;; Set active sheet
  145. (let* ((uri (quri:uri (car args)))
  146. (scheme (quri:uri-scheme uri))
  147. (path (quri:uri-path uri))
  148. (sheet-id (cond
  149. ((and (equal scheme "https")
  150. (equal (subseq path 0 (min 16 (length path))) "/spreadsheets/d/"))
  151. (subseq path 16 (position #\/ path :start 16)))
  152. ((null scheme) path)))
  153. (title (%gsheets-get-file-title-update-session chat-id from-id sheet-id)))
  154. (bot-send-message chat-id
  155. (if title
  156. (format nil "Выбран 📑 ~A" title)
  157. "Нет такого документа (или доступа)"))))
  158. (:otherwise
  159. ;; Show list of available files
  160. (let ((files-markup (%gsheets-files-markup-update-session chat-id from-id)))
  161. (if files-markup
  162. (bot-send-message chat-id "Выбери документ:" :reply-markup files-markup)
  163. (%gsheets-send-auth chat-id from-id))))))
  164. (def-message-cmd-handler sheet-read-handler (:sheet-read)
  165. (let ((sheet-id (aget chat-id *gsheets-chat-sheets*)))
  166. (if sheet-id
  167. (let* ((range (car args))
  168. (resp (gsheets-get-sheet-values from-id sheet-id range))
  169. (values (aget "values" resp)))
  170. (bot-send-message chat-id (format nil "```~%~{~{~A~^ ~}~^~%~}```" values)
  171. :parse-mode "markdown"))
  172. (bot-send-message chat-id "Выбери документ сначала: /sheets"))))
  173. (def-message-cmd-handler sheet-write-handler (:sheet-write)
  174. (let ((sheet-id (aget chat-id *gsheets-chat-sheets*)))
  175. (if sheet-id
  176. (let* ((range (car args))
  177. (values (list (cdr args)))
  178. (resp (gsheets-put-sheet-values from-id sheet-id range values)))
  179. (bot-send-message chat-id (format nil "Записал в ~A" (aget "updatedRange" resp))))
  180. (bot-send-message chat-id "Выбери документ сначала: /sheets"))))
  181. (def-callback-section-handler cb-handle-gss (:gs)
  182. (destructuring-bind (type id) (split-sequence:split-sequence #\- data :count 2)
  183. (case (intern (string-upcase type) "KEYWORD")
  184. (:s (let* ((file (elt (car (aget chat-id *gsheets-chat-sheet-sessions*)) (parse-integer id)))
  185. (title (%gsheets-get-file-title-update-session chat-id from-id (aget "id" file))))
  186. (telegram-edit-message-text
  187. (if title (format nil "Выбран 📑 ~A" title) "Чот лажа")
  188. :chat-id chat-id :message-id message-id)
  189. (update-alist-settings '*gsheets-chat-sheet-sessions* chat-id nil)))
  190. (:n (let* ((token-next (cdr (aget chat-id *gsheets-chat-sheet-sessions*)))
  191. (files-markup (%gsheets-files-markup-update-session chat-id from-id token-next)))
  192. (if files-markup
  193. (telegram-edit-message-reply-markup files-markup :chat-id chat-id :message-id message-id)
  194. (telegram-edit-message-text "Чот лажа" :chat-id chat-id :message-id message-id)))))))