diff options
| -rw-r--r-- | lisp/mastodon-auth.el | 2 | ||||
| -rw-r--r-- | lisp/mastodon-profile.el | 14 | ||||
| -rw-r--r-- | lisp/mastodon-tl.el | 13 | ||||
| -rw-r--r-- | lisp/mastodon-toot.el | 109 | ||||
| -rw-r--r-- | test/mastodon-http-tests.el | 75 | ||||
| -rw-r--r-- | test/mastodon-tl-tests.el | 116 | ||||
| -rw-r--r-- | test/mastodon-toot-tests.el | 117 |
7 files changed, 376 insertions, 70 deletions
diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index e4f5934..74d4404 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -166,7 +166,7 @@ Handle any errors from the server." (defun mastodon-auth--user-acct () "Return a mastodon user acct name." - (or (cdr (assoc mastodon-instance-url mastodon-auth--acct-alist)) + (or (cdr (assoc mastodon-instance-url mastodon-auth--acct-alist)) (let ((acct (mastodon-auth--get-account-name))) (push (cons mastodon-instance-url acct) mastodon-auth--acct-alist) acct))) diff --git a/lisp/mastodon-profile.el b/lisp/mastodon-profile.el index 98e5090..c7ef718 100644 --- a/lisp/mastodon-profile.el +++ b/lisp/mastodon-profile.el @@ -66,7 +66,6 @@ (defvar-local mastodon-profile--account nil "The data for the account being described in the current profile buffer.") -;; this way you can update it with C-M-x: (defvar mastodon-profile-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "s") #'mastodon-profile--open-followers) @@ -82,13 +81,9 @@ This minor mode is used for mastodon profile pages and adds a couple of extra keybindings." :init-value nil - ;; The mode line indicator. + ;; modeline indicator: :lighter " Profile" :keymap mastodon-profile-mode-map - ;; :keymap '(((kbd "O") . mastodon-profile--open-followers) - ;; ((kbd "o") . mastodon-profile--open-following) - ;; ((kbd "a") . mastodon-profile--follow-request-accept) - ;; ((kbd "r") . mastodon-profile--follow-request-reject) :group 'mastodon :global nil) @@ -406,7 +401,7 @@ If toot is a boost, opens the profile of the booster." (mastodon-media--get-media-link-rendering url)))) (defun mastodon-profile--show-user (user-handle) - "Query user for USER-HANDLE from current status and show that user's profile." + "Query for USER-HANDLE from current status and show that user's profile." (interactive (list (let ((user-handles (mastodon-profile--extract-users-handles @@ -454,7 +449,7 @@ FIELD is used to identify regions under 'account" tootv))) (defun mastodon-profile--search-account-by-handle (handle) - "Return an account based on a users HANDLE. + "Return an account based on a user's HANDLE. If the handle does not match a search return then retun NIL." (let* ((handle (if (string= "@" (substring handle 0 1)) @@ -462,7 +457,8 @@ If the handle does not match a search return then retun NIL." handle)) (matching-account (seq-remove - (lambda(x) (not (string= (alist-get 'acct x) handle))) + (lambda (x) + (not (string= (alist-get 'acct x) handle))) (mastodon-http--get-json (mastodon-http--api (format "accounts/search?q=%s" handle)))))) (when (equal 1 (length matching-account)) diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 7e9eb60..b2b8026 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -987,7 +987,7 @@ webapp" "Query for USER-HANDLE from current status and follow that user. If NOTIFY is \"true\", enable notifications when that user posts. If NOTIFY is \"false\", disable notifications when that user posts. -This can be called to toggle NOTIFY on users already being followed." +Can be called to toggle NOTIFY on users already being followed." (interactive (list (mastodon-tl--interactive-user-handles-get "follow"))) @@ -1077,15 +1077,16 @@ Action must be either \"unblock\" or \"mute\"." t)))) (defun mastodon-tl--do-user-action-and-response (user-handle action &optional negp notify) - "Do ACTION on user NAME/USER-HANDLE. + "Do ACTION on user USER-HANDLE. NEGP is whether the action involves un-doing something. If NOTIFY is \"true\", enable notifications when that user posts. If NOTIFY is \"false\", disable notifications when that user posts. NOTIFY is only non-nil when called by `mastodon-tl--follow-user'." (let* ((account (if negp - ;; TODO check if both are actually needed + ;; if unmuting/unblocking, we got handle from mute/block list (mastodon-profile--search-account-by-handle user-handle) + ;; if muting/blocking, we select from handles in current status (mastodon-profile--lookup-account-in-status user-handle (mastodon-profile--toot-json)))) (user-id (mastodon-profile--account-field account 'id)) @@ -1102,7 +1103,9 @@ NOTIFY is only non-nil when called by `mastodon-tl--follow-user'." (message "Cannot find a user with handle %S" user-handle)))) (defun mastodon-tl--do-user-action-function (url name user-handle action &optional notify) - "Post ACTION on user NAME/USER-HANDLE to URL." + "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))) (mastodon-http--triage response (lambda () @@ -1112,6 +1115,8 @@ NOTIFY is only non-nil when called by `mastodon-tl--follow-user'." ((string-equal notify "false") (message "Not receiving notifications for user %s (@%s)!" name user-handle)) + ((string-equal action "mute") + (message "User %s (@%s) %sd!" name user-handle action)) ((eq notify nil) (message "User %s (@%s) %sed!" name user-handle action))))))) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 31613d0..ec1ba49 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -46,6 +46,7 @@ (defvar company-backends)) (defvar mastodon-instance-url) +(defvar mastodon-tl--buffer-spec) (autoload 'mastodon-auth--user-acct "mastodon-auth") (autoload 'mastodon-http--api "mastodon-http") (autoload 'mastodon-http--delete "mastodon-http") @@ -187,7 +188,8 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (propertize marker 'face 'success))))))) (defun mastodon-toot--action (action callback) - "Take ACTION on toot at point, then execute CALLBACK." + "Take ACTION on toot at point, then execute CALLBACK. +Makes a POST request to the server." (let* ((id (mastodon-tl--property 'base-toot-id)) (url (mastodon-http--api (concat "statuses/" (mastodon-tl--as-string id) @@ -247,15 +249,27 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (message (format "%s #%s" action id)))) (message "Nothing to favorite here?!?")))) +(defun mastodon-toot--copy-toot-url () + "Copy URL of toot at point." + (interactive) + (let* ((toot (mastodon-tl--property 'toot-json)) + (url (if (mastodon-tl--field 'reblog toot) + (alist-get 'url (alist-get 'reblog toot)) + (alist-get 'url toot)))) + (kill-new url) + (message "Toot URL copied to the clipboard."))) + +(defun mastodon-toot--own-toot-p (toot) + "Check if TOOT is user's own, e.g. for deleting it." + (and (not (alist-get 'reblog toot)) + (equal (alist-get 'acct (alist-get 'account toot)) + (mastodon-auth--user-acct)))) + (defun mastodon-toot--pin-toot-toggle () "Pin or unpin user's toot at point." (interactive) (let* ((toot (mastodon-tl--property 'toot-json)) - (pinnable-p (and - (not (alist-get 'reblog toot)) - (equal (alist-get 'acct - (alist-get 'account toot)) - (mastodon-auth--user-acct)))) + (pinnable-p (mastodon-toot--own-toot-p toot)) (pinned-p (equal (alist-get 'pinned toot) t)) (action (if pinned-p "unpin" "pin")) (msg (if pinned-p "unpinned" "pinned")) @@ -267,37 +281,15 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (lambda () (message "Toot %s!" msg))))))) -(defun mastodon-toot--copy-toot-url () - "Copy URL of toot at point." - (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) - (url (if (mastodon-tl--field 'reblog toot) - (alist-get 'url (alist-get 'reblog toot)) - (alist-get 'url toot)))) - (kill-new url) - (message "Toot URL copied to the clipboard."))) - (defun mastodon-toot--delete-toot () "Delete user's toot at point synchronously." (interactive) - (let* ((toot (mastodon-tl--property 'toot-json)) - (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) - (url (mastodon-http--api (format "statuses/%s" id)))) - (if (or (alist-get 'reblog toot) - (not (equal (alist-get 'acct - (alist-get 'account toot)) - (mastodon-auth--user-acct)))) - (message "You can only delete your own toots.") - (if (y-or-n-p (format "Delete this toot? ")) - (let ((response (mastodon-http--delete url))) - (mastodon-http--triage response - (lambda () - (mastodon-tl--reload-timeline-or-profile) - (message "Toot deleted!")))))))) + (mastodon-toot--delete-and-redraft-toot t)) ;; TODO: handle media/poll for redrafting toots -(defun mastodon-toot--delete-and-redraft-toot () - "Delete and redraft user's toot at point synchronously." +(defun mastodon-toot--delete-and-redraft-toot (&optional no-redraft) + "Delete and redraft user's toot at point synchronously. +NO-REDRAFT means delete toot only." (interactive) (let* ((toot (mastodon-tl--property 'toot-json)) (id (mastodon-tl--as-string (mastodon-tl--toot-id toot))) @@ -305,31 +297,42 @@ Remove MARKER if REMOVE is non-nil, otherwise add it." (toot-cw (alist-get 'spoiler_text toot)) (toot-visibility (alist-get 'visibility toot)) (reply-id (alist-get 'in_reply_to_id toot))) - (if (or (alist-get 'reblog toot) - (not (equal (alist-get 'acct - (alist-get 'account toot)) - (mastodon-auth--user-acct)))) - (message "You can only delete and redraft your own toots.") - (if (y-or-n-p (format "Delete and redraft this toot? ")) + (if (not (mastodon-toot--own-toot-p toot)) + (message "You can only delete (and redraft) your own toots.") + (if (y-or-n-p (if no-redraft + (format "Delete this toot? ") + (format "Delete and redraft this toot? "))) (let* ((response (mastodon-http--delete url))) (mastodon-http--triage response (lambda () - (with-current-buffer response - (let* ((json-response (mastodon-http--process-json)) - (content (alist-get 'text json-response))) - ;; (media (alist-get 'media_attachments json-response))) - (mastodon-toot--compose-buffer nil nil) - (goto-char (point-max)) - (insert content) - ;; adopt reply-to-id, visibility and CW from deleted toot: - (when reply-id - (setq mastodon-toot--reply-to-id reply-id)) - (setq mastodon-toot--visibility toot-visibility) - (when (not (equal toot-cw "")) - (setq mastodon-toot--content-warning t) - (setq mastodon-toot--content-warning-from-reply-or-redraft toot-cw)) - (mastodon-toot--update-status-fields)))))))))) + (if no-redraft + (progn + (when mastodon-tl--buffer-spec + (mastodon-tl--reload-timeline-or-profile)) + (message "Toot deleted!")) + (mastodon-toot--redraft response + reply-id + toot-visibility + toot-cw))))))))) + +(defun mastodon-toot--redraft (response &optional reply-id toot-visibility toot-cw) + "Opens a new toot compose buffer using values from RESPONSE buffer. +REPLY-ID, TOOT-VISIBILITY, and TOOT-CW of deleted toot are preseved." + (with-current-buffer response + (let* ((json-response (mastodon-http--process-json)) + (content (alist-get 'text json-response))) + (mastodon-toot--compose-buffer nil nil) + (goto-char (point-max)) + (insert content) + ;; adopt reply-to-id, visibility and CW from deleted toot: + (when reply-id + (setq mastodon-toot--reply-to-id reply-id)) + (setq mastodon-toot--visibility toot-visibility) + (when (not (equal toot-cw "")) + (setq mastodon-toot--content-warning t) + (setq mastodon-toot--content-warning-from-reply-or-redraft toot-cw)) + (mastodon-toot--update-status-fields)))) (defun mastodon-toot--bookmark-toot-toggle () "Bookmark or unbookmark toot at point synchronously." diff --git a/test/mastodon-http-tests.el b/test/mastodon-http-tests.el index 00e1f41..dc4aa76 100644 --- a/test/mastodon-http-tests.el +++ b/test/mastodon-http-tests.el @@ -2,9 +2,84 @@ (require 'el-mock) +(defconst mastodon-http--example-200 + "HTTP/1.1 200 OK +Date: Mon, 20 Dec 2021 13:42:29 GMT +Content-Type: application/json; charset=utf-8 +Transfer-Encoding: chunked +Connection: keep-alive +Server: Mastodon +X-Frame-Options: DENY +X-Content-Type-Options: nosniff +X-XSS-Protection: 1; mode=block +Permissions-Policy: interest-cohort=() +X-RateLimit-Limit: 300 +X-RateLimit-Remaining: 298 +X-RateLimit-Reset: 2021-12-20T13:45:00.630990Z +Cache-Control: no-store +Vary: Accept, Accept-Encoding, Origin +ETag: W/\"bee52f489c87e9a305e5d0b7bdca7ac1\" +X-Request-Id: 5be9a64e-7d97-41b4-97f3-17b5e972a675 +X-Runtime: 0.371914 +Strict-Transport-Security: max-age=63072000; includeSubDomains +Strict-Transport-Security: max-age=31536000 + +{\"id\":\"18173\",\"following\":true,\"showing_reblogs\":true,\"notifying\":true,\"followed_by\":true,\"blocking\":false,\"blocked_by\":false,\"muting\":false,\"muting_notifications\":false,\"requested\":false,\"domain_blocking\":false,\"endorsed\":false,\"note\":\"\"}") + +(defconst mastodon-http--example-400 + "HTTP/1.1 444 OK +Date: Mon, 20 Dec 2021 13:42:29 GMT +Content-Type: application/json; charset=utf-8 +Transfer-Encoding: chunked +Connection: keep-alive +Server: Mastodon +X-Frame-Options: DENY +X-Content-Type-Options: nosniff +X-XSS-Protection: 1; mode=block +Permissions-Policy: interest-cohort=() +X-RateLimit-Limit: 300 +X-RateLimit-Remaining: 298 +X-RateLimit-Reset: 2021-12-20T13:45:00.630990Z +Cache-Control: no-store +Vary: Accept, Accept-Encoding, Origin +ETag: W/\"bee52f489c87e9a305e5d0b7bdca7ac1\" +X-Request-Id: 5be9a64e-7d97-41b4-97f3-17b5e972a675 +X-Runtime: 0.371914 +Strict-Transport-Security: max-age=63072000; includeSubDomains +Strict-Transport-Security: max-age=31536000 + +{\"error\":\"some unhappy complaint\"}") + (ert-deftest mastodon-http--get-retrieves-endpoint () "Should make a `url-retrieve' of the given URL." (with-mock (mock (mastodon-http--url-retrieve-synchronously "https://foo.bar/baz")) (mock (mastodon-auth--access-token) => "test-token") (mastodon-http--get "https://foo.bar/baz"))) + +(ert-deftest mastodon-http--triage-success () + "Should run success function for 200 HTML response." + (let ((response-buffer + (get-buffer-create "mastodon-http--triage-buffer"))) + (with-current-buffer response-buffer + (erase-buffer) + (insert mastodon-http--example-200)) + (should (equal (mastodon-http--triage + response-buffer + (lambda () + (message "success call"))) + "success call")))) + +(ert-deftest mastodon-http--triage-failure () + "Should return formatted JSON error from bad HTML response buffer. + Should not run success function." + (let ((response-buffer + (get-buffer-create "mastodon-http--triage-buffer"))) + (with-current-buffer response-buffer + (erase-buffer) + (insert mastodon-http--example-400)) + (should (equal (mastodon-http--triage + response-buffer + (lambda () + (message "success call"))) + "Error 444: some unhappy complaint")))) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index da3b315..dd07416 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -91,6 +91,54 @@ (reblogged))) "A sample reblogged/boosted toot (parsed json)") +(defconst mastodon-tl--follow-notify-true-response + "HTTP/1.1 200 OK +Date: Mon, 20 Dec 2021 13:42:29 GMT +Content-Type: application/json; charset=utf-8 +Transfer-Encoding: chunked +Connection: keep-alive +Server: Mastodon +X-Frame-Options: DENY +X-Content-Type-Options: nosniff +X-XSS-Protection: 1; mode=block +Permissions-Policy: interest-cohort=() +X-RateLimit-Limit: 300 +X-RateLimit-Remaining: 298 +X-RateLimit-Reset: 2021-12-20T13:45:00.630990Z +Cache-Control: no-store +Vary: Accept, Accept-Encoding, Origin +ETag: W/\"bee52f489c87e9a305e5d0b7bdca7ac1\" +X-Request-Id: 5be9a64e-7d97-41b4-97f3-17b5e972a675 +X-Runtime: 0.371914 +Strict-Transport-Security: max-age=63072000; includeSubDomains +Strict-Transport-Security: max-age=31536000 + +{\"id\":\"123456789\",\"following\":true,\"showing_reblogs\":true,\"notifying\":true,\"followed_by\":true,\"blocking\":false,\"blocked_by\":false,\"muting\":false,\"muting_notifications\":false,\"requested\":false,\"domain_blocking\":false,\"endorsed\":false,\"note\":\"\"}") + +(defconst mastodon-tl--follow-notify-false-response + "HTTP/1.1 200 OK +Date: Mon, 20 Dec 2021 13:42:29 GMT +Content-Type: application/json; charset=utf-8 +Transfer-Encoding: chunked +Connection: keep-alive +Server: Mastodon +X-Frame-Options: DENY +X-Content-Type-Options: nosniff +X-XSS-Protection: 1; mode=block +Permissions-Policy: interest-cohort=() +X-RateLimit-Limit: 300 +X-RateLimit-Remaining: 298 +X-RateLimit-Reset: 2021-12-20T13:45:00.630990Z +Cache-Control: no-store +Vary: Accept, Accept-Encoding, Origin +ETag: W/\"bee52f489c87e9a305e5d0b7bdca7ac1\" +X-Request-Id: 5be9a64e-7d97-41b4-97f3-17b5e972a675 +X-Runtime: 0.371914 +Strict-Transport-Security: max-age=63072000; includeSubDomains +Strict-Transport-Security: max-age=31536000 + +{\"id\":\"123456789\",\"following\":true,\"showing_reblogs\":true,\"notifying\":false,\"followed_by\":true,\"blocking\":false,\"blocked_by\":false,\"muting\":false,\"muting_notifications\":false,\"requested\":false,\"domain_blocking\":false,\"endorsed\":false,\"note\":\"\"}") + (ert-deftest mastodon-tl--remove-html-1 () "Should remove all <span> tags." (let ((input "<span class=\"h-card\">foobar</span> <span>foobaz</span>")) @@ -940,7 +988,7 @@ constant." "https://example.org")))) (ert-deftest mastodon-tl--userhandles () - "Should recognise iserhandles in a toot and add the required properties to it." + "Should recognise userhandles in a toot and add the required properties to it." ;; Travis's Emacs doesn't have libxml so we fake things by inputting ;; propertized text and stubbing shr-render-region (let* ((fake-input-text @@ -980,3 +1028,69 @@ constant." (should (null (mastodon-tl--extract-userhandle-from-url "https://example.org/@someuser?shouldnot=behere" "SomeUser")))) + +(ert-deftest mastodon-tl--do-user-action-function-follow-notify-block-mute () + "Should triage a follow request response buffer and return +correct value for following, as well as notifications enabled or disabled." + (let* ((user-handle "some-user@instance.url") + (user-name "some-user") + (user-id "123456789") + (url-follow-only "https://instance.url/accounts/123456789/follow") + (url-mute "https://instance.url/accounts/123456789/mute") + (url-block "https://instance.url/accounts/123456789/block") + (url-true "https://instance.url/accounts/123456789/follow?notify=true") + (url-false "https://instance.url/accounts/123456789/follow?notify=false")) + (with-temp-buffer + (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!"))) + (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)!"))))) + (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)!"))))))) diff --git a/test/mastodon-toot-tests.el b/test/mastodon-toot-tests.el index 804c55a..0c31029 100644 --- a/test/mastodon-toot-tests.el +++ b/test/mastodon-toot-tests.el @@ -1,6 +1,46 @@ ;;; mastodon-toot-test.el --- Tests for mastodon-toot.el -*- lexical-binding: nil -*- (require 'el-mock) +(require 'mastodon-http) + +(defconst mastodon-toot--200-html + "HTTP/1.1 200 OK +Date: Mon, 20 Dec 2021 13:42:29 GMT +Content-Type: application/json; charset=utf-8 +Transfer-Encoding: chunked") + +(defconst mastodon-toot-test-base-toot + '((id . 61208) + (created_at . "2017-04-24T19:01:02.000Z") + (in_reply_to_id) + (in_reply_to_account_id) + (sensitive . :json-false) + (spoiler_text . "") + (visibility . "public") + (account (id . 42) + (username . "acct42") + (acct . "acct42@example.space") + (display_name . "Account 42") + (locked . :json-false) + (created_at . "2017-04-01T00:00:00.000Z") + (followers_count . 99) + (following_count . 13) + (statuses_count . 101) + (note . "E")) + (media_attachments . []) + (mentions . []) + (tags . []) + (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status") + (url . "https://example.space/users/acct42/updates/123456789") + (content . "<p>Just some text</p>") + (reblogs_count . 0) + (favourites_count . 0) + (reblog)) + "A sample toot (parsed json)") + +(defconst mastodon-toot--mock-toot + (propertize "here is a mock toot text." + 'toot-json mastodon-toot-test-base-toot)) (defconst mastodon-toot--multi-mention '((mentions . @@ -49,9 +89,82 @@ mention string." (mastodon-instance-url "https://local.social")) (should (string= (mastodon-toot--mentions mastodon-toot-no-mention) "")))) -(ert-deftest mastodon-toot--cancel () +;; TODO: test y-or-no-p with matodon-toot--cancel +(ert-deftest mastodon-toot--kill () "Should kill the buffer when cancelling the toot." (with-mock (mock (kill-buffer-and-window)) - (mastodon-toot--cancel) + (mastodon-toot--kill) (mock-verify))) + +(ert-deftest mastodon-toot--own-toot-p-fail () + "Should not return t if not own toot." + (let ((toot mastodon-toot-test-base-toot)) + (with-mock + (mock (mastodon-auth--user-acct) => "joebogus@bogus.space") + (should (not (equal (mastodon-toot--own-toot-p toot) + t)))))) + +(ert-deftest mastodon-toot--own-toot-p () + "Should return 't' if own toot." + (let ((toot mastodon-toot-test-base-toot)) + (with-mock + (mock (mastodon-auth--user-acct) => "acct42@example.space") + (should (equal (mastodon-toot--own-toot-p toot) + t))))) + +(ert-deftest mastodon-toot--delete-toot-fail () + "Should refuse to delete toot." + (let ((toot mastodon-toot-test-base-toot)) + (with-mock + (mock (mastodon-auth--user-acct) => "joebogus") + ;; (mock (mastodon-toot--own-toot-p toot) => nil) + (mock (mastodon-tl--property 'toot-json) => mastodon-toot-test-base-toot) + (should (equal (mastodon-toot--delete-toot) + "You can only delete (and redraft) your own toots."))))) + +(ert-deftest mastodon-toot--delete-toot () + "Should return correct triaged response to a legitimate DELETE request." + (with-temp-buffer + (insert mastodon-toot--200-html) + (let ((delete-response (current-buffer)) + (toot mastodon-toot-test-base-toot)) + (with-mock + (mock (mastodon-tl--property 'toot-json) => toot) + ;; (mock (mastodon-toot--own-toot-p toot) => t) + (mock (mastodon-auth--user-acct) => "acct42@example.space") + (mock (mastodon-http--api (format "statuses/61208")) + => "https://example.space/statuses/61208") + (mock (y-or-n-p "Delete this toot? ") => t) + (mock (mastodon-http--delete "https://example.space/statuses/61208") + => delete-response) + (should (equal (mastodon-toot--delete-toot) + "Toot deleted!")))))) + +(ert-deftest mastodon-toot-action-pin () + "Should return callback provided by `mastodon-toot--pin-toot-toggle'." + (with-temp-buffer + (insert mastodon-toot--200-html) + (let ((pin-response (current-buffer)) + (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!")))))) + +(ert-deftest mastodon-toot--pin-toot-fail () + (with-temp-buffer + (insert mastodon-toot--200-html) + (let ((pin-response (current-buffer)) + (toot mastodon-toot-test-base-toot)) + (with-mock + (mock (mastodon-tl--property 'toot-json) => toot) + (mock (mastodon-auth--user-acct) => "joebogus@example.space") + (should (equal (mastodon-toot--pin-toot-toggle) + "You can only pin your own toots.")))))) |