aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormarty hiatt <martianhiatus [a t] riseup [d o t] net>2023-04-24 18:33:31 +0200
committermarty hiatt <martianhiatus [a t] riseup [d o t] net>2023-04-24 18:33:31 +0200
commitf86a4434d43fe99eaf358f9c7f6ff842963ec611 (patch)
treea1708c6424df6dc143500a367add5f6a3e8c8f8c
parenteacce3bf19b70b2a656e6a04b8b985f9bf56f297 (diff)
parent1715bb3f5ba468fc9d06c5835cdc9bba03de06d6 (diff)
Merge branch 'report' into develop
-rw-r--r--lisp/mastodon-tl.el88
-rw-r--r--lisp/mastodon.el2
-rw-r--r--test/mastodon-tl-tests.el191
3 files changed, 234 insertions, 47 deletions
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index e90be9a..b4d90a2 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -1667,6 +1667,10 @@ webapp"
(reblog (alist-get 'reblog json)))
(if reblog (alist-get 'id reblog) id)))
+(defun mastodon-tl--toot-or-base (json)
+ "Return the base toot or just the toot from toot JSON."
+ (or (alist-get 'reblog json) json))
+
;;; THREADS
@@ -2078,7 +2082,7 @@ If TAG is provided, unfollow it."
(defun mastodon-tl--list-followed-tags (&optional prefix)
"List followed tags. View timeline of tag user choses.
-Prefix is sent to `mastodon-tl--get-tag-timeline', which see."
+PREFIX is sent to `mastodon-tl--get-tag-timeline', which see."
(interactive "p")
(let* ((followed-tags-json (mastodon-tl--followed-tags))
(tags (mastodon-tl--map-alist 'name followed-tags-json))
@@ -2089,7 +2093,7 @@ Prefix is sent to `mastodon-tl--get-tag-timeline', which see."
(defun mastodon-tl--followed-tags-timeline (&optional prefix)
"Open a timeline of all your followed tags.
-Prefix is sent to `mastodon-tl--show-tag-timeline', which see."
+PREFIX is sent to `mastodon-tl--show-tag-timeline', which see."
(interactive "p")
(let* ((followed-tags-json (mastodon-tl--followed-tags))
(tags (mastodon-tl--map-alist 'name followed-tags-json)))
@@ -2106,6 +2110,86 @@ The suggestions are from followed tags, but any other tags are also allowed."
tags)))
(mastodon-tl--show-tag-timeline prefix selection)))
+(defun mastodon-tl--instance-rules ()
+ "Return the rules of the user's instance."
+ (let ((url (mastodon-http--api "instance/rules")))
+ (mastodon-http--get-json url nil :silent)))
+
+(defun mastodon-tl--report-params (account toot)
+ "Query user and return report params alist.
+ACCOUNT and TOOT are the data to use."
+ (let* ((account-id (mastodon-profile--account-field account 'id))
+ (comment (read-string "Add comment [optional]: "))
+ (toot-id (when (y-or-n-p "Also report status at point? ")
+ (mastodon-tl--toot-id toot))) ; base toot if poss
+ (forward-p (when (y-or-n-p "Forward to remote admin? ") "true"))
+ (rules (when (y-or-n-p "Cite a rule broken? ")
+ (mastodon-tl--read-rules-ids)))
+ (cat (unless rules (if (y-or-n-p "Spam? ") "spam" "other"))))
+ (mastodon-tl--report-build-params account-id comment toot-id
+ forward-p cat rules)))
+
+(defun mastodon-tl--report-build-params
+ (account-id comment toot-id forward-p cat &optional rules)
+ "Build the parameters alist based on user responses.
+ACCOUNT-ID, COMMENT, TOOT-ID, FORWARD-P, CAT, and RULES are all from
+`mastodon-tl--report-params', which see."
+ (let ((params `(("account_id" . ,account-id)
+ ,(when comment
+ `("comment" . ,comment))
+ ,(when toot-id
+ `("status_ids[]" . ,toot-id))
+ ,(when forward-p
+ `("forward" . ,forward-p))
+ ,(when cat
+ `("category" . ,cat)))))
+ (when rules
+ (let ((alist
+ (mastodon-http--build-array-params-alist "rule_ids[]" rules)))
+ (mapc (lambda (x)
+ (push x params))
+ alist)))
+ ;; FIXME: the above approach adds nils to your params.
+ (setq params (delete nil params))
+ params))
+
+(defun mastodon-tl--report-to-mods ()
+ "Report the author of the toot at point to your instance moderators.
+Optionally report the toot at point, add a comment, cite rules
+that have been broken, forward the report to the remove admin,
+report the account for spam."
+ (interactive)
+ (mastodon-tl--do-if-toot
+ (when (y-or-n-p "Report author of toot at point?")
+ (let* ((url (mastodon-http--api "reports"))
+ (toot (mastodon-tl--toot-or-base
+ (mastodon-tl--property 'toot-json :no-move)))
+ (account (alist-get 'account toot))
+ (handle (alist-get 'acct account))
+ (params (mastodon-tl--report-params account toot))
+ (response (mastodon-http--post url params)))
+ ;; (setq masto-report-response response)
+ (mastodon-http--triage response
+ (lambda ()
+ (message "User %s reported!" handle)))))))
+
+(defvar crm-separator)
+
+(defun mastodon-tl--read-rules-ids ()
+ "Prompt for a list of instance rules and return a list of selected ids."
+ (let* ((rules (mastodon-tl--instance-rules))
+ (alist (mapcar (lambda (x)
+ (cons (alist-get 'text x)
+ (alist-get 'id x)))
+ rules))
+ (crm-separator (replace-regexp-in-string "," "|" crm-separator))
+ (choices (completing-read-multiple
+ "rules [TAB for options, | to separate]: "
+ alist nil :match)))
+ (mapcar (lambda (x)
+ (alist-get x alist nil nil 'equal))
+ choices)))
+
;;; UPDATING, etc.
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index 81a0092..9ec1d76 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -83,6 +83,7 @@
(autoload 'mastodon-tl--unblock-user "mastodon-tl")
(autoload 'mastodon-tl--unfollow-user "mastodon-tl")
(autoload 'mastodon-tl--unmute-user "mastodon-tl")
+(autoload 'mastodon-tl--report-to-mods "mastodon-tl")
(autoload 'mastodon-tl--update "mastodon-tl")
(autoload 'mastodon-toot--edit-toot-at-point "mastodon-toot")
(when (require 'lingva nil :no-error)
@@ -200,6 +201,7 @@ Use. e.g. \"%c\" for your locale's date and time format."
(define-key map (kbd "C-S-B") #'mastodon-tl--unblock-user)
(define-key map (kbd "M") #'mastodon-tl--mute-user)
(define-key map (kbd "C-S-M") #'mastodon-tl--unmute-user)
+ (define-key map (kbd "Z") #'mastodon-tl--report-to-mods)
;; own profile
(define-key map (kbd "O") #'mastodon-profile--my-profile)
(define-key map (kbd "U") #'mastodon-profile--update-user-profile-note)
diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el
index a3ac330..e029ba7 100644
--- a/test/mastodon-tl-tests.el
+++ b/test/mastodon-tl-tests.el
@@ -4,6 +4,25 @@
(require 'cl-macs)
(require 'el-mock)
+(defconst mastodon-tl--test-instance-rules
+ ;; brief ones calqued off todon.nl
+ '(((id . "1")
+ (text . "We do not accept racism."))
+ ((id . "2")
+ (text . "We do not accept homophobia."))
+ ((id . "3")
+ (text . "We do not accept sexism."))
+ ((id . "4")
+ (text . "We do not accept ableism."))
+ ((id . "5")
+ (text . "We do not accept harassment."))
+ ((id . "6")
+ (text . "We also do not accept hate speech."))
+ ((id . "7")
+ (text . "We do not accept abuse of minors."))
+ ((id . "8")
+ (text . "We do not accept glorification of violence."))))
+
(defconst mastodon-tl-test-base-toot
'((id . 61208)
(created_at . "2017-04-24T19:01:02.000Z")
@@ -1073,53 +1092,135 @@ 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)
- => 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)
- => 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)
- => 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 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)
+ => 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)
+ => 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) => 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 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) => 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 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)!")))))))
+
+(ert-deftest mastodon-tl--report-to-mods-params-alist ()
+ ""
+ (with-temp-buffer
+ (let* ((toot mastodon-tl-test-base-toot)
+ (account (alist-get 'account toot)))
+ (with-mock
+ ;; no longer needed after our refactor
+ ;; (mock (mastodon-http--api "reports") => "https://instance.url/api/v1/reports")
+ ;; (mock (mastodon-tl--toot-or-base
+ ;; (mastodon-tl--property 'toot-json :no-move))
+ ;; => mastodon-tl-test-base-toot)
+ (mock (read-string "Add comment [optional]: ") => "Dummy complaint")
+ (stub y-or-n-p => nil) ; no to all
+ (should (equal (mastodon-tl--report-params account toot)
+ '(("account_id" . 42)
+ ("comment" . "Dummy complaint")
+ ("category" . "other"))))
+ (with-mock
+ (stub y-or-n-p => t) ; yes to all
+ (mock (mastodon-tl--read-rules-ids) => '(1 2 3))
+ (should (equal (mastodon-tl--report-params account toot)
+ '(("rule_ids[]" . 3)
+ ("rule_ids[]" . 2)
+ ("rule_ids[]" . 1)
+ ("account_id" . 42)
+ ("comment" . "Dummy complaint")
+ ("status_ids[]" . 61208)
+ ("forward" . "true")))))))))
+
+(ert-deftest mastodon-tl--report-build-params ()
+ ""
+ (should (equal
+ (mastodon-tl--report-build-params 42 "Dummy complaint"
+ 61208 "true" nil '(1 2 3))
+ '(("rule_ids[]" . 3)
+ ("rule_ids[]" . 2)
+ ("rule_ids[]" . 1)
+ ("account_id" . 42)
+ ("comment" . "Dummy complaint")
+ ("status_ids[]" . 61208)
+ ("forward" . "true"))))
+ (should (equal
+ (mastodon-tl--report-build-params 42 "Dummy complaint"
+ nil "true" nil nil)
+ '(("account_id" . 42)
+ ("comment" . "Dummy complaint")
+ ("forward" . "true"))))
+ (should (equal
+ (mastodon-tl--report-build-params 42 "Dummy complaint"
+ 61208 "true" "spam" nil)
+ '(("account_id" . 42)
+ ("comment" . "Dummy complaint")
+ ("status_ids[]" . 61208)
+ ("forward" . "true")
+ ("category" . "spam"))))
+ (should (equal
+ (mastodon-tl--report-build-params 42 "Dummy complaint"
+ 61208 "true" "other" nil)
+ '(("account_id" . 42)
+ ("comment" . "Dummy complaint")
+ ("status_ids[]" . 61208)
+ ("forward" . "true")
+ ("category" . "other"))))
+ (should (equal
+ (mastodon-tl--report-build-params 42 "Dummy complaint"
+ 61208 nil "spam" nil)
+ '(("account_id" . 42)
+ ("comment" . "Dummy complaint")
+ ("status_ids[]" . 61208)
+ ("category" . "spam")))))
+
+(ert-deftest mastodon-tl--read-rules ()
+ "Should return a list of string numbers based on `mastodon-tl--test-instance-rules'"
+ (let ((crm-separator "[ ]*,[ ]*"))
+ (with-mock
+ (stub mastodon-tl--instance-rules => mastodon-tl--test-instance-rules)
+ (stub completing-read-multiple => '("We do not accept homophobia."
+ "We do not accept harassment."
+ "We also do not accept hate speech."))
+ (should (equal '("2" "5" "6")
+ (mastodon-tl--read-rules-ids))))))