diff options
Diffstat (limited to 'lisp/mastodon-http.el')
| -rw-r--r-- | lisp/mastodon-http.el | 225 |
1 files changed, 199 insertions, 26 deletions
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index ba0a259..c0fa101 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -2,9 +2,10 @@ ;; Copyright (C) 2017-2019 Johnson Denen ;; Author: Johnson Denen <johnson.denen@gmail.com> -;; Version: 0.9.0 -;; Package-Requires: ((emacs "24.4")) -;; Homepage: https://github.com/jdenen/mastodon.el +;; Maintainer: Marty Hiatt <martianhiatus@riseup.net> +;; Version: 0.10.0 +;; Package-Requires: ((emacs "27.1") (request "0.3.0")) +;; Homepage: https://git.blast.noho.st/mouse/mastodon.el ;; This file is not part of GNU Emacs. @@ -30,16 +31,23 @@ ;;; Code: (require 'json) +(require 'request) ; for attachments upload + (defvar mastodon-instance-url) +(defvar mastodon-toot--media-attachment-ids) +(defvar mastodon-toot--media-attachment-filenames) + (autoload 'mastodon-auth--access-token "mastodon-auth") +(autoload 'mastodon-toot--update-status-fields "mastodon-toot") + (defvar mastodon-http--api-version "v1") -(defconst mastodon-http--timeout 5 +(defconst mastodon-http--timeout 15 "HTTP request timeout, in seconds. Has no effect on Emacs < 26.1.") (defun mastodon-http--api (endpoint) - "Return Mastondon API URL for ENDPOINT." + "Return Mastodon API URL for ENDPOINT." (concat mastodon-instance-url "/api/" mastodon-http--api-version "/" endpoint)) @@ -60,15 +68,33 @@ (string-match "[0-9][0-9][0-9]" status-line) (match-string 0 status-line))) +(defun mastodon-http--url-retrieve-synchronously (url) + "Retrieve URL asynchronously. + +This is a thin abstraction over the system +`url-retrieve-synchronously`. Depending on which version of this +is available we will call it with or without a timeout." + (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) + (url-retrieve-synchronously url) + (url-retrieve-synchronously url nil nil mastodon-http--timeout))) + (defun mastodon-http--triage (response success) "Determine if RESPONSE was successful. Call SUCCESS if successful. -Open RESPONSE buffer if unsuccessful." +Message status and JSON error from RESPONSE if unsuccessful." (let ((status (with-current-buffer response (mastodon-http--status)))) (if (string-prefix-p "2" status) (funcall success) - (switch-to-buffer response)))) + (switch-to-buffer response) + (let ((json-response (mastodon-http--process-json))) + (message "Error %s: %s" status (alist-get 'error json-response)))))) + +(defun mastodon-http--read-file-as-string (filename) + "Read a file FILENAME as a string. Used to generate image preview." + (with-temp-buffer + (insert-file-contents filename) + (string-to-unibyte (buffer-string)))) (defun mastodon-http--post (url args headers &optional unauthenticed-p) "POST synchronously to URL with ARGS and HEADERS. @@ -91,35 +117,182 @@ Authorization header is included by default unless UNAUTHENTICED-P is non-nil." '(("Content-Type" . "application/x-www-form-urlencoded"))) headers))) (with-temp-buffer - (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) - (url-retrieve-synchronously url) - (url-retrieve-synchronously url nil nil mastodon-http--timeout))))) + (mastodon-http--url-retrieve-synchronously url)))) (defun mastodon-http--get (url) - "Make GET request to URL. + "Make synchronous GET request to URL. Pass response buffer to CALLBACK function." (let ((url-request-method "GET") (url-request-extra-headers `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))))) - (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4) - (url-retrieve-synchronously url) - (url-retrieve-synchronously url nil nil mastodon-http--timeout)))) + (mastodon-http--url-retrieve-synchronously url))) (defun mastodon-http--get-json (url) - "Make GET request to URL. Return JSON response vector." - (let ((json-vector - (with-current-buffer (mastodon-http--get url) - (goto-char (point-min)) - (re-search-forward "^$" nil 'move) - (let ((json-string - (decode-coding-string - (buffer-substring-no-properties (point) (point-max)) - 'utf-8))) - (kill-buffer) - (json-read-from-string json-string))))) - json-vector)) + "Make synchronous GET request to URL. Return JSON response." + (with-current-buffer (mastodon-http--get url) + (mastodon-http--process-json))) + +(defun mastodon-http--process-json () + "Process JSON response." + (goto-char (point-min)) + (re-search-forward "^$" nil 'move) + (let ((json-string + (decode-coding-string + (buffer-substring-no-properties (point) (point-max)) + 'utf-8))) + (kill-buffer) + (unless (or (string-equal "" json-string) (null json-string)) + (json-read-from-string json-string)))) + +(defun mastodon-http--delete (url) + "Make DELETE request to URL." + (let ((url-request-method "DELETE") + (url-request-extra-headers + `(("Authorization" . ,(concat "Bearer " + (mastodon-auth--access-token)))))) + (with-temp-buffer + (mastodon-http--url-retrieve-synchronously url)))) + +;; search functions: +(defun mastodon-http--process-json-search () + "Process JSON returned by a search query to the server." + (goto-char (point-min)) + (re-search-forward "^$" nil 'move) + (let ((json-string + (decode-coding-string + (buffer-substring-no-properties (point) (point-max)) + 'utf-8))) + (kill-buffer) + (json-read-from-string json-string))) + +(defun mastodon-http--get-search-json (url query &optional param) + "Make GET request to URL, searching for QUERY and return JSON response. +PARAM is any extra parameters to send with the request." + (let ((buffer (mastodon-http--get-search url query param))) + (with-current-buffer buffer + (mastodon-http--process-json-search)))) + +(defun mastodon-http--get-search (base-url query &optional param) + "Make GET request to BASE-URL, searching for QUERY. +Pass response buffer to CALLBACK function. +PARAM is a formatted request parameter, eg 'following=true'." + (let ((url-request-method "GET") + (url (if param + (concat base-url "?" param "&q=" (url-hexify-string query)) + (concat base-url "?q=" (url-hexify-string query)))) + (url-request-extra-headers + `(("Authorization" . ,(concat "Bearer " + (mastodon-auth--access-token)))))) + (mastodon-http--url-retrieve-synchronously url))) + +;; profile update functions + +(defun mastodon-http--patch-json (url) + "Make synchronous PATCH request to URL. Return JSON response." + (with-current-buffer (mastodon-http--patch url) + (mastodon-http--process-json))) + +;; hard coded just for bio note for now: +(defun mastodon-http--patch (base-url &optional note) + "Make synchronous PATCH request to BASE-URL. +Optionally specify the NOTE to edit. +Pass response buffer to CALLBACK function." + (let ((url-request-method "PATCH") + (url (if note + (concat base-url "?note=" (url-hexify-string note)) + base-url)) + (url-request-extra-headers + `(("Authorization" . ,(concat "Bearer " + (mastodon-auth--access-token)))))) + (mastodon-http--url-retrieve-synchronously url))) + + ;; Asynchronous functions + +(defun mastodon-http--get-async (url &optional callback &rest cbargs) + "Make GET request to URL. +Pass response buffer to CALLBACK function with args CBARGS." + (let ((url-request-method "GET") + (url-request-extra-headers + `(("Authorization" . ,(concat "Bearer " + (mastodon-auth--access-token)))))) + (url-retrieve url callback cbargs))) + +(defun mastodon-http--get-json-async (url &optional callback &rest args) + "Make GET request to URL. Call CALLBACK with json-vector and ARGS." + (mastodon-http--get-async + url + (lambda (status) + (when status ;; only when we actually get sth? + (apply callback (mastodon-http--process-json) args))))) + +(defun mastodon-http--post-async (url args headers &optional callback &rest cbargs) + "POST asynchronously to URL with ARGS and HEADERS. +Then run function CALLBACK with arguements CBARGS. +Authorization header is included by default unless UNAUTHENTICED-P is non-nil." + (let ((url-request-method "POST") + (request-timeout 5) + (url-request-data + (when args + (mapconcat (lambda (arg) + (concat (url-hexify-string (car arg)) + "=" + (url-hexify-string (cdr arg)))) + args + "&"))) + (url-request-extra-headers + (append `(("Authorization" . ,(concat "Bearer " (mastodon-auth--access-token)))) + headers))) + (with-temp-buffer + (url-retrieve url callback cbargs)))) + +;; TODO: test for curl first? +(defun mastodon-http--post-media-attachment (url filename caption) + "Make POST request to upload FILENAME with CAPTION to the server's media URL. +The upload is asynchronous. On succeeding, +`mastodon-toot--media-attachment-ids' is set to the id(s) of the +item uploaded, and `mastodon-toot--update-status-fields' is run." + (let* ((file (file-name-nondirectory filename)) + (request-backend 'curl)) + (request + url + :type "POST" + :params `(("description" . ,caption)) + :files `(("file" . (,file :file ,filename + :mime-type "multipart/form-data"))) + :parser 'json-read + :headers `(("Authorization" . ,(concat "Bearer " + (mastodon-auth--access-token)))) + :sync nil + :success (cl-function + (lambda (&key data &allow-other-keys) + (when data + (push (alist-get 'id data) + mastodon-toot--media-attachment-ids) ; add ID to list + (message "%s file %s with id %S and caption '%s' uploaded!" + (capitalize (alist-get 'type data)) + file + (alist-get 'id data) + (alist-get 'description data)) + (mastodon-toot--update-status-fields)))) + :error (cl-function + (lambda (&key error-thrown &allow-other-keys) + (cond + ;; handle curl errors first (eg 26, can't read file/path) + ;; because the '=' test below fails for them + ;; they have the form (error . error message 24) + ((not (proper-list-p error-thrown)) ; not dotted list + (message "Got error: %s. Shit went south." (cdr error-thrown))) + ;; handle mastodon api errors + ;; they have the form (error http 401) + ((= (car (last error-thrown)) 401) + (message "Got error: %s Unauthorized: The access token is invalid" error-thrown)) + ((= (car (last error-thrown)) 422) + (message "Got error: %s Unprocessable entity: file or file type is unsupported or invalid" error-thrown)) + (t + (message "Got error: %s Shit went south" + error-thrown)))))))) (provide 'mastodon-http) ;;; mastodon-http.el ends here |