From 370f0a8367e381345950e145554481d988a1709c Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Mon, 14 Nov 2022 19:09:27 +0100 Subject: make a start on lists --- lisp/mastodon-http.el | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 66707b7..e69a5c9 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -203,12 +203,15 @@ Callback to `mastodon-http--get-response-async', usually (cons (car list) (cadr list)))) head-list))) -(defun mastodon-http--delete (url) +(defun mastodon-http--delete (url &optional args) "Make DELETE request to URL." - (mastodon-http--authorized-request - "DELETE" - (with-temp-buffer - (mastodon-http--url-retrieve-synchronously url)))) + (let ((url-request-data + (when args + (mastodon-http--build-query-string args)))) + (mastodon-http--authorized-request + "DELETE" + (with-temp-buffer + (mastodon-http--url-retrieve-synchronously url))))) (defun mastodon-http--append-query-string (url params) "Append PARAMS to URL as query strings and return it. -- cgit v1.2.3 From 2197fa013ec02cd82750a319c1c314fdb4a7c2a4 Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 15 Nov 2022 11:27:48 +0100 Subject: http--triage: add 404, don't process json in that case --- lisp/mastodon-http.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index e69a5c9..106c76b 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -89,8 +89,11 @@ Message status and JSON error from RESPONSE if unsuccessful." (if (string-prefix-p "2" status) (funcall success) (switch-to-buffer response) - (let ((json-response (mastodon-http--process-json))) - (message "Error %s: %s" status (alist-get 'error json-response)))))) + ;; 404 returns http response not JSON: + (if (string-prefix-p "404" status) + (message "Error %s: page not found" status) + (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." -- cgit v1.2.3 From c3e1c3403f8a308894f5c335b4a060def85b4d4d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Tue, 15 Nov 2022 11:28:30 +0100 Subject: add delete and edit lists --- lisp/mastodon-http.el | 16 ++++++++++++++++ lisp/mastodon-tl.el | 37 +++++++++++++++++++++++++++++++++++++ 2 files changed, 53 insertions(+) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 106c76b..843afc1 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -216,6 +216,22 @@ Callback to `mastodon-http--get-response-async', usually (with-temp-buffer (mastodon-http--url-retrieve-synchronously url))))) +(defun mastodon-http--put (url &optional args headers) + "Make PUT request to URL." + (mastodon-http--authorized-request + "PUT" + (let ((url-request-data + (when args + (mastodon-http--build-query-string args))) + (url-request-extra-headers + (append url-request-extra-headers ; auth set in macro + ;; pleroma compat: + (unless (assoc "Content-Type" headers) + '(("Content-Type" . "application/x-www-form-urlencoded"))) + headers))) + (with-temp-buffer + (mastodon-http--url-retrieve-synchronously url))))) + (defun mastodon-http--append-query-string (url params) "Append PARAMS to URL as query strings and return it. diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index e28da63..f1941a5 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -71,6 +71,8 @@ (autoload 'mastodon-http--get-response-async "mastodon-http") (autoload 'mastodon-url-lookup "mastodon") (autoload 'mastodon-auth--get-account-id "mastodon-auth") +(autoload 'mastodon-http--put "mastodon-http") +(autoload 'mastodon-http--process-json "mastodon-http") (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) (defvar mastodon-instance-url) @@ -1380,6 +1382,28 @@ ID is that of the toot to view." (response (mastodon-http--get-json url))) (alist-get 'title response))) +(defun mastodon-tl--edit-list () + "Prompt for a list and edit the name and replies policy." + (interactive) + (let* ((list-names (mastodon-tl--get-lists-names)) + (name-old (completing-read "Edit list: " + list-names)) + (id (mastodon-tl--get-list-id name-old)) + (name-choice (read-string "List name: " name-old)) + (replies-policy (completing-read "Replies policy: " ; give this a proper name + '("followed" "list" "none") + nil t nil nil "list")) + (url (mastodon-http--api (format "lists/%s" id))) + (response (mastodon-http--put url + `(("title" . ,name-choice) + ("replies_policy" . ,replies-policy))))) + (mastodon-http--triage response + (lambda () + (with-current-buffer response + (let* ((json (mastodon-http--process-json)) + (name-new (alist-get 'title json))) + (message "list %s edited to %s!" name-old name-new))))))) + (defun mastodon-tl--view-list-timeline () "Prompt for a list and view its timeline." (interactive) @@ -1408,6 +1432,19 @@ Prompt for name and replies policy." (lambda () (message "list %s created!" title))))) +(defun mastodon-tl--delete-list () + "Prompt for a list and delete it." + (interactive) + (let* ((list-names (mastodon-tl--get-lists-names)) + (name (completing-read "Delete list: " + list-names)) + (id (mastodon-tl--get-list-id name)) + (url (mastodon-http--api (format "lists/%s" id))) + (response (mastodon-http--delete url))) + (mastodon-http--triage response + (lambda () + (message "list %s deleted!" name))))) + (defun mastodon-tl--get-users-followings () "Return the list of followers of the logged in account." (let* ((id (mastodon-auth--get-account-id)) -- cgit v1.2.3 From 0996c7eabfd89e6bb5fa3c9f2558c9d6ac23a44b Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Thu, 17 Nov 2022 11:49:49 +0100 Subject: refactor array params into -http--build-array-args-alist --- lisp/mastodon-http.el | 5 +++++ lisp/mastodon-tl.el | 8 ++++---- lisp/mastodon-toot.el | 16 ++++++---------- 3 files changed, 15 insertions(+), 14 deletions(-) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 66707b7..a127427 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -121,6 +121,11 @@ Unless UNAUTHENTICATED-P is non-nil." args "&")) +(defun mastodon-http--build-array-args-alist (param-str array) + "Return parameters alist using PARAM-STR and ARRAY param values." + (cl-loop for x in array + collect (cons param-str x))) + (defun mastodon-http--post (url args headers &optional unauthenticated-p) "POST synchronously to URL with ARGS and HEADERS. diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 8c02adf..0db517c 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -70,6 +70,8 @@ (autoload 'mastodon-profile--get-preferences-pref "mastodon-profile") (autoload 'mastodon-http--get-response-async "mastodon-http") (autoload 'mastodon-url-lookup "mastodon") +(autoload 'mastodon-http--build-array-args-alist "mastodon-http") + (when (require 'mpv nil :no-error) (declare-function mpv-start "mpv")) (defvar mastodon-instance-url) @@ -2110,10 +2112,8 @@ UPDATE-FUNCTION is used to receive more toots. Runs synchronously." (let* ((exclude-types (when note-type (mastodon-notifications--filter-types-list note-type))) - (args (when note-type - (mapcar (lambda (x) - `("exclude_types[]" . ,x)) - exclude-types))) + (args (when note-type (mastodon-http--build-array-args-alist + "exclude_types[]" exclude-types))) (query-string (when note-type (mastodon-http--build-query-string args))) ;; add note-type exclusions to endpoint so it works in `mastodon-tl--buffer-spec' diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 438e887..17a3938 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -79,6 +79,7 @@ (autoload 'mastodon-profile-fetch-server-account-settings "mastodon-profile") (autoload 'mastodon-tl--render-text "mastodon-tl") (autoload 'mastodon-profile-fetch-server-account-settings-maybe "mastodon-profile") +(autoload 'mastodon-http--build-array-args-alist "mastodon-http") ;; for mastodon-toot--translate-toot-text (autoload 'mastodon-tl--content "mastodon-tl") @@ -615,7 +616,8 @@ to `emojify-user-emojis', and the emoji data is updated." (defun mastodon-toot--build-poll-params () "Return an alist of parameters for POSTing a poll status." (append - (mastodon-toot--make-poll-options-params + (mastodon-http--build-array-args-alist + "poll[options][]" (plist-get mastodon-toot-poll :options)) `(("poll[expires_in]" . ,(plist-get mastodon-toot-poll :expiry))) `(("poll[multiple]" . ,(symbol-name (plist-get mastodon-toot-poll :multi)))) @@ -638,9 +640,9 @@ If media items have been attached and uploaded with (symbol-name t))) ("spoiler_text" . ,spoiler))) (args-media (when mastodon-toot--media-attachments - (mapcar (lambda (id) - (cons "media_ids[]" id)) - mastodon-toot--media-attachment-ids))) + (mastodon-http--build-array-args-alist + "media_ids[]" + mastodon-toot--media-attachment-ids))) (args-poll (when mastodon-toot-poll (mastodon-toot--build-poll-params))) ;; media || polls: @@ -960,12 +962,6 @@ which is used to attach it to a toot when posting." mastodon-toot--media-attachments)) (list "None"))) -(defun mastodon-toot--make-poll-options-params (options) - "Return an parameter query alist from poll OPTIONS." - (let ((key "poll[options][]")) - (cl-loop for o in options - collect `(,key . ,o)))) - (defun mastodon-toot--fetch-max-poll-options () "Return the maximum number of poll options." (mastodon-toot--fetch-poll-field 'max_options)) -- cgit v1.2.3 From fbf796a7bdf98babfdbfc879c49db3defdc2577d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 11:27:34 +0100 Subject: http build array args docstring --- lisp/mastodon-http.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index d9e1d80..e67cf2d 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -125,7 +125,8 @@ Unless UNAUTHENTICATED-P is non-nil." "&")) (defun mastodon-http--build-array-args-alist (param-str array) - "Return parameters alist using PARAM-STR and ARRAY param values." + "Return parameters alist using PARAM-STR and ARRAY param values. +Used for API form data parameters that take an array." (cl-loop for x in array collect (cons param-str x))) -- cgit v1.2.3 From 25f7e47beddb8fcf789a7e06a03fce5339f8500d Mon Sep 17 00:00:00 2001 From: marty hiatt Date: Sat, 19 Nov 2022 17:58:01 +0100 Subject: http--post - make args + headers optional args also update all calls to it, no need for nil nil everywhere. --- lisp/mastodon-http.el | 4 +- lisp/mastodon-notifications.el | 9 ++--- lisp/mastodon-tl.el | 14 +++---- lisp/mastodon-toot.el | 4 +- test/mastodon-tl-tests.el | 90 +++++++++++++++++++++--------------------- test/mastodon-toot-tests.el | 16 ++++---- 6 files changed, 66 insertions(+), 71 deletions(-) (limited to 'lisp/mastodon-http.el') diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index e67cf2d..6e7bfb3 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -130,8 +130,8 @@ Used for API form data parameters that take an array." (cl-loop for x in array collect (cons param-str x))) -(defun mastodon-http--post (url args headers &optional unauthenticated-p) - "POST synchronously to URL with ARGS and HEADERS. +(defun mastodon-http--post (url &optional args headers unauthenticated-p) + "POST synchronously to URL, optionally with ARGS and HEADERS. Authorization header is included by default unless UNAUTHENTICATED-P is non-nil." (mastodon-http--authorized-request diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el index b23e3c5..127a9e2 100644 --- a/lisp/mastodon-notifications.el +++ b/lisp/mastodon-notifications.el @@ -117,8 +117,7 @@ follow-requests view." (mastodon-http--api "follow_requests") (format "/%s/%s" id (if reject "reject" - "authorize"))) - nil nil))) + "authorize")))))) (mastodon-http--triage response (lambda () (if f-reqs-view-p @@ -326,8 +325,7 @@ Status notifications are created when you call (interactive) (when (y-or-n-p "Clear all notifications?") (let ((response - (mastodon-http--post (mastodon-http--api "notifications/clear") - nil nil))) + (mastodon-http--post (mastodon-http--api "notifications/clear")))) (mastodon-http--triage response (lambda () (when mastodon-tl--buffer-spec @@ -342,8 +340,7 @@ Status notifications are created when you call (mastodon-tl--property 'toot-json)))) (response (mastodon-http--post (mastodon-http--api - (format "notifications/%s/dismiss" id)) - nil nil))) + (format "notifications/%s/dismiss" id))))) (mastodon-http--triage response (lambda () (when mastodon-tl--buffer-spec diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index b8486cc..6618c48 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -1145,7 +1145,7 @@ this just means displaying toot client." ;; need to zero-index our option: (option-as-arg (number-to-string (1- (string-to-number (car option))))) (arg `(("choices[]" . ,option-as-arg))) - (response (mastodon-http--post url arg nil))) + (response (mastodon-http--post url arg))) (mastodon-http--triage response (lambda () (message "You voted for option %s: %s!" @@ -1604,8 +1604,7 @@ If ID is provided, use that list." (account-id (alist-get account handles nil nil 'equal)) (url (mastodon-http--api (format "lists/%s/accounts" list-id))) (response (mastodon-http--post url - `(("account_ids[]" . ,account-id)) - nil))) + `(("account_ids[]" . ,account-id))))) (mastodon-tl--list-action-triage response (message "%s added to list %s!" account list-name)))) @@ -1685,8 +1684,7 @@ Prompt for a context, must be a list containting at least one of \"home\", contexts))) (response (mastodon-http--post url (push `("phrase" . ,word) - contexts-processed) - nil))) + contexts-processed)))) (mastodon-http--triage response (lambda () (message "Filter created for %s!" word) @@ -2117,7 +2115,7 @@ NOTIFY is only non-nil when called by `mastodon-tl--follow-user'." "Post ACTION on user NAME/USER-HANDLE to URL. NOTIFY is either \"true\" or \"false\", and used when we have been called by `mastodon-tl--follow-user' to enable or disable notifications." - (let ((response (mastodon-http--post url nil nil))) + (let ((response (mastodon-http--post url))) (mastodon-http--triage response (lambda () (cond ((string-equal notify "true") @@ -2145,7 +2143,7 @@ If TAG provided, follow it." (interactive) (let* ((tag (or tag (read-string "Tag to follow: "))) (url (mastodon-http--api (format "tags/%s/follow" tag))) - (response (mastodon-http--post url nil nil))) + (response (mastodon-http--post url))) (mastodon-http--triage response (lambda () (message "tag #%s followed!" tag))))) @@ -2166,7 +2164,7 @@ If TAG if provided, unfollow it." (tag (or tag (completing-read "Unfollow tag: " tags))) (url (mastodon-http--api (format "tags/%s/unfollow" tag))) - (response (mastodon-http--post url nil nil))) + (response (mastodon-http--post url))) (mastodon-http--triage response (lambda () (message "tag #%s unfollowed!" tag))))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 53e60bd..d0eb143 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -268,7 +268,7 @@ boosting, or bookmarking toots." (mastodon-tl--as-string id) "/" action)))) - (let ((response (mastodon-http--post url nil nil))) + (let ((response (mastodon-http--post url))) (mastodon-http--triage response callback)))) (defun mastodon-toot--toggle-boost-or-favourite (type) @@ -666,7 +666,7 @@ If media items have been attached and uploaded with ((mastodon-toot--empty-p) (message "Empty toot. Cowardly refusing to post this.")) (t - (let ((response (mastodon-http--post endpoint args nil))) + (let ((response (mastodon-http--post endpoint args))) (mastodon-http--triage response (lambda () (mastodon-toot--kill) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index bb5d00f..19934dd 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -1047,53 +1047,53 @@ correct value for following, as well as notifications enabled or disabled." (let ((response-buffer-true (current-buffer))) (insert mastodon-tl--follow-notify-true-response) (with-mock - (mock (mastodon-http--post url-follow-only nil nil) - => response-buffer-true) - (should - (equal - (mastodon-tl--do-user-action-function url-follow-only - user-name - user-handle - "follow") - "User some-user (@some-user@instance.url) followed!")) - (mock (mastodon-http--post url-mute nil nil) - => response-buffer-true) - (should - (equal - (mastodon-tl--do-user-action-function url-mute - user-name - user-handle - "mute") - "User some-user (@some-user@instance.url) muted!")) - (mock (mastodon-http--post url-block nil nil) - => response-buffer-true) - (should - (equal - (mastodon-tl--do-user-action-function url-block - user-name - user-handle - "block") - "User some-user (@some-user@instance.url) blocked!"))) + (mock (mastodon-http--post url-follow-only) + => response-buffer-true) + (should + (equal + (mastodon-tl--do-user-action-function url-follow-only + user-name + user-handle + "follow") + "User some-user (@some-user@instance.url) followed!")) + (mock (mastodon-http--post url-mute) + => response-buffer-true) + (should + (equal + (mastodon-tl--do-user-action-function url-mute + user-name + user-handle + "mute") + "User some-user (@some-user@instance.url) muted!")) + (mock (mastodon-http--post url-block) + => response-buffer-true) + (should + (equal + (mastodon-tl--do-user-action-function url-block + user-name + user-handle + "block") + "User some-user (@some-user@instance.url) blocked!"))) (with-mock - (mock (mastodon-http--post url-true nil nil) => response-buffer-true) - (should - (equal - (mastodon-tl--do-user-action-function url-true - user-name - user-handle - "follow" - "true") - "Receiving notifications for user some-user (@some-user@instance.url)!"))))) + (mock (mastodon-http--post url-true) => response-buffer-true) + (should + (equal + (mastodon-tl--do-user-action-function url-true + user-name + user-handle + "follow" + "true") + "Receiving notifications for user some-user (@some-user@instance.url)!"))))) (with-temp-buffer (let ((response-buffer-false (current-buffer))) (insert mastodon-tl--follow-notify-false-response) (with-mock - (mock (mastodon-http--post url-false nil nil) => response-buffer-false) - (should - (equal - (mastodon-tl--do-user-action-function url-false - user-name - user-handle - "follow" - "false") - "Not receiving notifications for user some-user (@some-user@instance.url)!"))))))) + (mock (mastodon-http--post url-false) => response-buffer-false) + (should + (equal + (mastodon-tl--do-user-action-function url-false + user-name + user-handle + "follow" + "false") + "Not receiving notifications for user some-user (@some-user@instance.url)!"))))))) diff --git a/test/mastodon-toot-tests.el b/test/mastodon-toot-tests.el index 39e0984..9741964 100644 --- a/test/mastodon-toot-tests.el +++ b/test/mastodon-toot-tests.el @@ -152,14 +152,14 @@ mention string." (toot mastodon-toot-test-base-toot) (id 61208)) (with-mock - (mock (mastodon-tl--property 'base-toot-id) => id) - (mock (mastodon-http--api "statuses/61208/pin") - => "https://example.space/statuses/61208/pin") - (mock (mastodon-http--post "https://example.space/statuses/61208/pin" nil nil) - => pin-response) - (should (equal (mastodon-toot--action "pin" (lambda () - (message "Toot pinned!"))) - "Toot pinned!")))))) + (mock (mastodon-tl--property 'base-toot-id) => id) + (mock (mastodon-http--api "statuses/61208/pin") + => "https://example.space/statuses/61208/pin") + (mock (mastodon-http--post "https://example.space/statuses/61208/pin") + => pin-response) + (should (equal (mastodon-toot--action "pin" (lambda () + (message "Toot pinned!"))) + "Toot pinned!")))))) (ert-deftest mastodon-toot--pin-toot-fail () (with-temp-buffer -- cgit v1.2.3