diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/ert-helper.el | 12 | ||||
| l--------- | test/fixture | 1 | ||||
| -rw-r--r-- | test/mastodon-auth-tests.el | 129 | ||||
| -rw-r--r-- | test/mastodon-client-tests.el | 70 | ||||
| -rw-r--r-- | test/mastodon-http-tests.el | 88 | ||||
| -rw-r--r-- | test/mastodon-media-tests.el | 157 | ||||
| -rw-r--r-- | test/mastodon-notifications-test.el | 24 | ||||
| -rw-r--r-- | test/mastodon-search-tests.el | 147 | ||||
| -rw-r--r-- | test/mastodon-tl-tests.el | 393 | ||||
| -rw-r--r-- | test/mastodon-toot-tests.el | 140 |
10 files changed, 868 insertions, 293 deletions
diff --git a/test/ert-helper.el b/test/ert-helper.el index 6979837..a6d6692 100644 --- a/test/ert-helper.el +++ b/test/ert-helper.el @@ -1,8 +1,14 @@ +(load-file "lisp/mastodon-search.el") +(load-file "lisp/mastodon-async.el") (load-file "lisp/mastodon-http.el") -(load-file "lisp/mastodon-client.el") (load-file "lisp/mastodon-auth.el") -(load-file "lisp/mastodon-toot.el") +(load-file "lisp/mastodon-client.el") +(load-file "lisp/mastodon-discover.el") +(load-file "lisp/mastodon-inspect.el") (load-file "lisp/mastodon-media.el") -(load-file "lisp/mastodon-tl.el") (load-file "lisp/mastodon-notifications.el") +(load-file "lisp/mastodon-profile.el") +(load-file "lisp/mastodon-search.el") +(load-file "lisp/mastodon-tl.el") +(load-file "lisp/mastodon-toot.el") (load-file "lisp/mastodon.el") diff --git a/test/fixture b/test/fixture new file mode 120000 index 0000000..f418013 --- /dev/null +++ b/test/fixture @@ -0,0 +1 @@ +../fixture
\ No newline at end of file diff --git a/test/mastodon-auth-tests.el b/test/mastodon-auth-tests.el index 7daa4db..6a090b7 100644 --- a/test/mastodon-auth-tests.el +++ b/test/mastodon-auth-tests.el @@ -1,66 +1,105 @@ +;;; mastodon-auth-test.el --- Tests for mastodon-auth.el -*- lexical-binding: nil -*- + (require 'el-mock) -(ert-deftest generate-token--no-storing-credentials () +(ert-deftest mastodon-auth--handle-token-response--good () + "Should extract the access token from a good response." + (should + (string= + "foo" + (mastodon-auth--handle-token-response + '(:access_token "foo" :token_type "Bearer" :scope "read write follow" :created_at 0))))) + +(ert-deftest mastodon-auth--handle-token-response--unknown () + "Should throw an error when the response is unparsable." + (should + (equal + '(error "Unknown response from mastodon-auth--get-token!") + (condition-case error + (progn + (mastodon-auth--handle-token-response '(:herp "derp")) + nil) + (t error))))) + +(ert-deftest mastodon-auth--handle-token-response--failure () + "Should throw an error when the response indicates an error." + (let ((error-message "The provided authorization grant is invalid, expired, revoked, does not match the redirection URI used in the authorization request, or was issued to another client.")) + (should + (equal + `(error ,(format "Mastodon-auth--access-token: invalid_grant: %s" error-message)) + (condition-case error + (mastodon-auth--handle-token-response + `(:error "invalid_grant" :error_description ,error-message)) + (t error)))))) + +(ert-deftest mastodon-auth--generate-token--no-storing-credentials () "Should make `mastdon-http--post' request to generate auth token." (with-mock - (let ((mastodon-auth-source-file "") - (mastodon-instance-url "https://instance.url")) - (mock (mastodon-client) => '(:client_id "id" :client_secret "secret")) - (mock (read-string "Email: " user-mail-address) => "foo@bar.com") - (mock (read-passwd "Password: ") => "password") - (mock (mastodon-http--post "https://instance.url/oauth/token" - '(("client_id" . "id") - ("client_secret" . "secret") - ("grant_type" . "password") - ("username" . "foo@bar.com") - ("password" . "password") - ("scope" . "read write follow")) - nil - :unauthenticated)) - (mastodon-auth--generate-token)))) + (let ((mastodon-auth-source-file "") + (mastodon-instance-url "https://instance.url")) + (mock (mastodon-client) => '(:client_id "id" :client_secret "secret")) + (mock (read-string "Email: " user-mail-address) => "foo@bar.com") + (mock (read-passwd "Password: ") => "password") + (mock (mastodon-http--post "https://instance.url/oauth/token" + '(("client_id" . "id") + ("client_secret" . "secret") + ("grant_type" . "password") + ("username" . "foo@bar.com") + ("password" . "password") + ("scope" . "read write follow")) + nil + :unauthenticated)) + (mastodon-auth--generate-token)))) -(ert-deftest generate-token--storing-credentials () +(ert-deftest mastodon-auth--generate-token--storing-credentials () "Should make `mastdon-http--post' request to generate auth token." (with-mock - (let ((mastodon-auth-source-file "~/.authinfo") - (mastodon-instance-url "https://instance.url")) - (mock (mastodon-client) => '(:client_id "id" :client_secret "secret")) - (mock (auth-source-search :create t - :host "https://instance.url" - :port 443 - :require '(:user :secret)) - => '((:user "foo@bar.com" :secret (lambda () "password")))) - (mock (mastodon-http--post "https://instance.url/oauth/token" - '(("client_id" . "id") - ("client_secret" . "secret") - ("grant_type" . "password") - ("username" . "foo@bar.com") - ("password" . "password") - ("scope" . "read write follow")) - nil - :unauthenticated)) - (mastodon-auth--generate-token)))) + (let ((mastodon-auth-source-file "~/.authinfo") + (mastodon-instance-url "https://instance.url")) + (mock (mastodon-client) => '(:client_id "id" :client_secret "secret")) + (mock (auth-source-search :create t + :host "https://instance.url" + :port 443 + :require '(:user :secret)) + => '((:user "foo@bar.com" :secret (lambda () "password")))) + (mock (mastodon-http--post "https://instance.url/oauth/token" + '(("client_id" . "id") + ("client_secret" . "secret") + ("grant_type" . "password") + ("username" . "foo@bar.com") + ("password" . "password") + ("scope" . "read write follow")) + nil + :unauthenticated)) + (mastodon-auth--generate-token)))) -(ert-deftest get-token () +(ert-deftest mastodon-auth--get-token () "Should generate token and return JSON response." (with-temp-buffer (with-mock (mock (mastodon-auth--generate-token) => (progn - (insert "\n\n{\"access_token\":\"abcdefg\"}") - (current-buffer))) - (should (equal (mastodon-auth--get-token) '(:access_token "abcdefg")))))) + (insert "\n\n{\"access_token\":\"abcdefg\"}") + (current-buffer))) + (should + (equal (mastodon-auth--get-token) + '(:access_token "abcdefg")))))) -(ert-deftest access-token-found () +(ert-deftest mastodon-auth--access-token-found () "Should return value in `mastodon-auth--token-alist' if found." (let ((mastodon-instance-url "https://instance.url") (mastodon-auth--token-alist '(("https://instance.url" . "foobar")) )) - (should (string= (mastodon-auth--access-token) "foobar")))) + (should + (string= (mastodon-auth--access-token) "foobar")))) -(ert-deftest access-token-2 () +(ert-deftest mastodon-auth--access-token-not-found () "Should set and return `mastodon-auth--token' if nil." (let ((mastodon-instance-url "https://instance.url") - (mastodon-auth--token nil)) + (mastodon-auth--token-alist nil)) (with-mock (mock (mastodon-auth--get-token) => '(:access_token "foobaz")) - (should (string= (mastodon-auth--access-token) "foobaz")) - (should (equal mastodon-auth--token-alist '(("https://instance.url" . "foobaz"))))))) + (should + (string= (mastodon-auth--access-token) + "foobaz")) + (should + (equal mastodon-auth--token-alist + '(("https://instance.url" . "foobaz"))))))) diff --git a/test/mastodon-client-tests.el b/test/mastodon-client-tests.el index dfe175b..9123286 100644 --- a/test/mastodon-client-tests.el +++ b/test/mastodon-client-tests.el @@ -1,28 +1,30 @@ +;;; mastodon-client-test.el --- Tests for mastodon-client.el -*- lexical-binding: nil -*- + (require 'el-mock) -(ert-deftest register () +(ert-deftest mastodon-client--register () "Should POST to /apps." (with-mock - (mock (mastodon-http--api "apps") => "https://instance.url/api/v1/apps") - (mock (mastodon-http--post "https://instance.url/api/v1/apps" - '(("client_name" . "mastodon.el") - ("redirect_uris" . "urn:ietf:wg:oauth:2.0:oob") - ("scopes" . "read write follow") - ("website" . "https://github.com/jdenen/mastodon.el")) - nil - :unauthenticated)) - (mastodon-client--register))) + (mock (mastodon-http--api "apps") => "https://instance.url/api/v1/apps") + (mock (mastodon-http--post "https://instance.url/api/v1/apps" + '(("client_name" . "mastodon.el") + ("redirect_uris" . "urn:ietf:wg:oauth:2.0:oob") + ("scopes" . "read write follow") + ("website" . "https://github.com/jdenen/mastodon.el")) + nil + :unauthenticated)) + (mastodon-client--register))) -(ert-deftest fetch () +(ert-deftest mastodon-client--fetch () "Should return client registration JSON." (with-temp-buffer (with-mock (mock (mastodon-client--register) => (progn - (insert "\n\n{\"foo\":\"bar\"}") - (current-buffer))) + (insert "\n\n{\"foo\":\"bar\"}") + (current-buffer))) (should (equal (mastodon-client--fetch) '(:foo "bar")))))) -(ert-deftest store-1 () +(ert-deftest mastodon-client--store-1 () "Should return the client plist." (let ((mastodon-instance-url "http://mastodon.example") (plist '(:client_id "id" :client_secret "secret"))) @@ -33,44 +35,44 @@ (client (cdr (plstore-get plstore "mastodon-http://mastodon.example")))) (should (equal (mastodon-client--store) plist)))))) -(ert-deftest store-2 () - "Should store client in `mastodon-client--token-file'." - (let* ((mastodon-instance-url "http://mastodon.example") - (plstore (plstore-open "stubfile.plstore")) - (client (cdr (plstore-get plstore "mastodon-http://mastodon.example")))) - (plstore-close plstore) - (should (string= (plist-get client :client_id) "id")) - (should (string= (plist-get client :client_secret) "secret")))) +(ert-deftest mastodon-client--store-2 () + "Should store client in `mastodon-client--token-file'." + (let* ((mastodon-instance-url "http://mastodon.example") + (plstore (plstore-open "stubfile.plstore")) + (client (cdr (plstore-get plstore "mastodon-http://mastodon.example")))) + (plstore-close plstore) + (should (string= (plist-get client :client_id) "id")) + (should (string= (plist-get client :client_secret) "secret")))) -(ert-deftest read-finds-match () +(ert-deftest mastodon-client--read-finds-match () "Should return mastodon client from `mastodon-token-file' if it exists." (let ((mastodon-instance-url "http://mastodon.example")) (with-mock - (mock (mastodon-client--token-file) => "fixture/client.plstore") - (should (equal (mastodon-client--read) - '(:client_id "id2" :client_secret "secret2")))))) + (mock (mastodon-client--token-file) => "fixture/client.plstore") + (should (equal (mastodon-client--read) + '(:client_id "id2" :client_secret "secret2")))))) -(ert-deftest read-finds-no-match () +(ert-deftest mastodon-client--read-finds-no-match () "Should return mastodon client from `mastodon-token-file' if it exists." (let ((mastodon-instance-url "http://mastodon.social")) (with-mock - (mock (mastodon-client--token-file) => "fixture/client.plstore") - (should (equal (mastodon-client--read) nil))))) + (mock (mastodon-client--token-file) => "fixture/client.plstore") + (should (equal (mastodon-client--read) nil))))) -(ert-deftest read-empty-store () +(ert-deftest mastodon-client--read-empty-store () "Should return nil if mastodon client is not present in the plstore." (with-mock (mock (mastodon-client--token-file) => "fixture/empty.plstore") (should (equal (mastodon-client--read) nil)))) -(ert-deftest client-set-and-matching () +(ert-deftest mastodon-client--client-set-and-matching () "Should return `mastondon-client' if `mastodon-client--client-details-alist' is non-nil and instance url is included." (let ((mastodon-instance-url "http://mastodon.example") (mastodon-client--client-details-alist '(("https://other.example" . :no-match) ("http://mastodon.example" . :matches)))) (should (eq (mastodon-client) :matches)))) -(ert-deftest client-set-but-not-matching () +(ert-deftest mastodon-client--client-set-but-not-matching () "Should read from `mastodon-token-file' if wrong data is cached." (let ((mastodon-instance-url "http://mastodon.example") (mastodon-client--client-details-alist '(("http://other.example" :wrong)))) @@ -81,7 +83,7 @@ '(("http://mastodon.example" :client_id "foo" :client_secret "bar") ("http://other.example" :wrong))))))) -(ert-deftest client-unset () +(ert-deftest mastodon-client--client-unset () "Should read from `mastodon-token-file' if available." (let ((mastodon-instance-url "http://mastodon.example") (mastodon-client--client-details-alist nil)) @@ -91,7 +93,7 @@ (should (equal mastodon-client--client-details-alist '(("http://mastodon.example" :client_id "foo" :client_secret "bar"))))))) -(ert-deftest client-unset-and-not-in-storage () +(ert-deftest mastodon-client--client-unset-and-not-in-storage () "Should store client data in plstore if it can't be read." (let ((mastodon-instance-url "http://mastodon.example") (mastodon-client--client-details-alist nil)) diff --git a/test/mastodon-http-tests.el b/test/mastodon-http-tests.el index 972cedb..dc4aa76 100644 --- a/test/mastodon-http-tests.el +++ b/test/mastodon-http-tests.el @@ -1,9 +1,85 @@ +;;; mastodon-http-test.el --- Tests for mastodon-http.el -*- lexical-binding: nil -*- + (require 'el-mock) -(ert-deftest mastodon-http:get:retrieves-endpoint () +(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." - (let ((callback-double (lambda () "double"))) - (with-mock - (mock (url-retrieve-synchronously "https://foo.bar/baz")) - (mock (mastodon-auth--access-token) => "test-token") - (mastodon-http--get "https://foo.bar/baz")))) + (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-media-tests.el b/test/mastodon-media-tests.el index a586be9..0e1152a 100644 --- a/test/mastodon-media-tests.el +++ b/test/mastodon-media-tests.el @@ -1,10 +1,12 @@ +;;; mastodon-media-test.el --- Tests for mastodon-media.el -*- lexical-binding: nil -*- + (require 'el-mock) -(ert-deftest mastodon-media:get-avatar-rendering () +(ert-deftest mastodon-media--get-avatar-rendering () "Should return text with all expected properties." (with-mock (mock (image-type-available-p 'imagemagick) => t) - (mock (create-image * 'imagemagick t :height 123) => :mock-image) + (mock (create-image * (when (version< emacs-version "27.1") 'imagemagick) t :height 123) => :mock-image) (let* ((mastodon-media--avatar-height 123) (result (mastodon-media--get-avatar-rendering "http://example.org/img.png")) @@ -16,33 +18,69 @@ (should (eq 'avatar (plist-get properties 'media-type))) (should (eq :mock-image (plist-get properties 'display)))))) -(ert-deftest mastodon-media:get-media-link-rendering () +(ert-deftest mastodon-media--get-media-link-rendering () "Should return text with all expected properties." (with-mock - (mock (create-image * nil t) => :mock-image) - - (let* ((mastodon-media--preview-max-height 123) - (result (mastodon-media--get-media-link-rendering "http://example.org/img.png")) - (result-no-properties (substring-no-properties result)) - (properties (text-properties-at 0 result))) - (should (string= "[img] " result-no-properties)) - (should (string= "http://example.org/img.png" (plist-get properties 'media-url))) - (should (eq 'needs-loading (plist-get properties 'media-state))) - (should (eq 'media-link (plist-get properties 'media-type))) - (should (eq :mock-image (plist-get properties 'display)))))) - -(ert-deftest mastodon-media:load-image-from-url:avatar-with-imagemagic () + (mock (create-image * nil t) => :mock-image) + (let* ((mastodon-media--preview-max-height 123) + (result + (mastodon-media--get-media-link-rendering "http://example.org/img.png" + "http://example.org/remote/img.png" + "image")) + (result-no-properties (substring-no-properties result)) + (properties (text-properties-at 0 result))) + (should (string= "[img] " result-no-properties)) + (should (string= "http://example.org/img.png" (plist-get properties 'media-url))) + (should (eq 'needs-loading (plist-get properties 'media-state))) + (should (eq 'media-link (plist-get properties 'media-type))) + (should (eq :mock-image (plist-get properties 'display))) + (should (eq 'highlight (plist-get properties 'mouse-face))) + (should (eq 'image (plist-get properties 'mastodon-tab-stop))) + (should (string= "http://example.org/remote/img.png" (plist-get properties 'image-url))) + (should (eq mastodon-tl--shr-image-map-replacement (plist-get properties 'keymap))) + (should (string= "image" (plist-get properties 'mastodon-media-type))) + (should (string= "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview" + (plist-get properties 'help-echo)))))) + +(ert-deftest mastodon-media:get-media-link-rendering-gif () + "Should return text with all expected properties." + (with-mock + (mock (create-image * nil t) => :mock-image) + (let* ((mastodon-media--preview-max-height 123) + (result + (mastodon-media--get-media-link-rendering "http://example.org/img.png" + "http://example.org/remote/img.png" + "gifv")) + (result-no-properties (substring-no-properties result)) + (properties (text-properties-at 0 result))) + (should (string= "[img] " result-no-properties)) + (should (string= "http://example.org/img.png" (plist-get properties 'media-url))) + (should (eq 'needs-loading (plist-get properties 'media-state))) + (should (eq 'media-link (plist-get properties 'media-type))) + (should (eq :mock-image (plist-get properties 'display))) + (should (eq 'highlight (plist-get properties 'mouse-face))) + (should (eq 'image (plist-get properties 'mastodon-tab-stop))) + (should (string= "http://example.org/remote/img.png" (plist-get properties 'image-url))) + (should (eq mastodon-tl--shr-image-map-replacement (plist-get properties 'keymap))) + (should (string= "gifv" (plist-get properties 'mastodon-media-type))) + (should (string= "RET/i: load full image (prefix: copy URL), +/-: zoom, r: rotate, o: save preview\ntype: gifv" + (plist-get properties 'help-echo)))))) + +(ert-deftest mastodon-media--load-image-from-url-avatar-with-imagemagic () "Should make the right call to url-retrieve." (let ((url "http://example.org/image.png") (mastodon-media--avatar-height 123)) (with-mock (mock (image-type-available-p 'imagemagick) => t) - (mock (create-image * 'imagemagick t :height 123) => '(image foo)) + (mock (create-image + * + (when (version< emacs-version "27.1") 'imagemagick) + t :height 123) => '(image foo)) (mock (copy-marker 7) => :my-marker ) (mock (url-retrieve url #'mastodon-media--process-image-response - '(:my-marker (:height 123) 1)) + `(:my-marker (:height 123) 1 ,url)) => :called-as-expected) (with-temp-buffer @@ -52,17 +90,18 @@ (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1))))))) -(ert-deftest mastodon-media:load-image-from-url:avatar-without-imagemagic () +(ert-deftest mastodon-media--load-image-from-url-avatar-without-imagemagic () "Should make the right call to url-retrieve." (let ((url "http://example.org/image.png")) (with-mock (mock (image-type-available-p 'imagemagick) => nil) + (mock (image-transforms-p) => nil) (mock (create-image * nil t) => '(image foo)) (mock (copy-marker 7) => :my-marker ) (mock (url-retrieve url #'mastodon-media--process-image-response - '(:my-marker () 1)) + `(:my-marker () 1 ,url)) => :called-as-expected) (with-temp-buffer @@ -72,7 +111,7 @@ (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1))))))) -(ert-deftest mastodon-media:load-image-from-url:media-link-with-imagemagic () +(ert-deftest mastodon-media--load-image-from-url-media-link-with-imagemagic () "Should make the right call to url-retrieve." (let ((url "http://example.org/image.png")) (with-mock @@ -82,7 +121,7 @@ (mock (url-retrieve "http://example.org/image.png" #'mastodon-media--process-image-response - '(:my-marker (:max-height 321) 5)) + '(:my-marker (:max-height 321) 5 "http://example.org/image.png")) => :called-as-expected) (with-temp-buffer (insert (concat "Start:" @@ -91,17 +130,18 @@ (let ((mastodon-media--preview-max-height 321)) (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5)))))))) -(ert-deftest mastodon-media:load-image-from-url:media-link-without-imagemagic () +(ert-deftest mastodon-media--load-image-from-url-media-link-without-imagemagic () "Should make the right call to url-retrieve." (let ((url "http://example.org/image.png")) (with-mock (mock (image-type-available-p 'imagemagick) => nil) + (mock (image-transforms-p) => nil) (mock (create-image * nil t) => '(image foo)) (mock (copy-marker 7) => :my-marker ) (mock (url-retrieve "http://example.org/image.png" #'mastodon-media--process-image-response - '(:my-marker () 5)) + '(:my-marker () 5 "http://example.org/image.png")) => :called-as-expected) (with-temp-buffer @@ -111,13 +151,16 @@ (let ((mastodon-media--preview-max-height 321)) (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5)))))))) -(ert-deftest mastodon-media:load-image-from-url:url-fetching-fails () +(ert-deftest mastodon-media--load-image-from-url-url-fetching-fails () "Should cope with failures in url-retrieve." (let ((url "http://example.org/image.png") (mastodon-media--avatar-height 123)) (with-mock (mock (image-type-available-p 'imagemagick) => t) - (mock (create-image * 'imagemagick t :height 123) => '(image foo)) + (mock (create-image + * + (when (version< emacs-version "27.1") 'imagemagick) + t :height 123) => '(image foo)) (stub url-retrieve => (error "url-retrieve failed")) (with-temp-buffer @@ -129,38 +172,44 @@ ;; the media state was updated so we won't load this again: (should (eq 'loading-failed (get-text-property 7 'media-state))))))) -(ert-deftest mastodon-media:process-image-response () +(ert-deftest mastodon-media--process-image-response () "Should process the HTTP response and adjust the source buffer." (with-temp-buffer (with-mock (let ((source-buffer (current-buffer)) - used-marker - saved-marker) - (insert "start:") - (setq used-marker (copy-marker (point)) - saved-marker (copy-marker (point))) - ;; Mock needed for the preliminary image created in mastodon-media--get-avatar-rendering - (stub create-image => :fake-image) - (insert (mastodon-media--get-avatar-rendering "http://example.org/image.png") - ":end") - (with-temp-buffer - (insert "some irrelevant\n" - "http headers\n" - "which will be ignored\n\n" - "fake\nimage\ndata") - (goto-char (point-min)) - - (mock (create-image "fake\nimage\ndata" 'imagemagick t ':image :option) => :fake-image) - - (mastodon-media--process-image-response () used-marker '(:image :option) 1) - - ;; the used marker has been unset: - (should (null (marker-position used-marker))) - ;; the media-state has been set to loaded and the image is being displayed - (should (eq 'loaded (get-text-property saved-marker 'media-state source-buffer))) - (should (eq ':fake-image (get-text-property saved-marker 'display source-buffer)))))))) - -(ert-deftest mastodon-media:inline-images () + used-marker + saved-marker) + (insert "start:") + (setq used-marker (copy-marker (point)) + saved-marker (copy-marker (point))) + ;; Mock needed for the preliminary image created in + ;; mastodon-media--get-avatar-rendering + (stub create-image => :fake-image) + (insert (mastodon-media--get-avatar-rendering + "http://example.org/image.png.") + ":end") + (with-temp-buffer + (insert "some irrelevant\n" + "http headers\n" + "which will be ignored\n\n" + "fake\nimage\ndata") + (goto-char (point-min)) + + (mock (create-image + "fake\nimage\ndata" + (when (version< emacs-version "27.1") 'imagemagick) + t ':image :option) => :fake-image) + + (mastodon-media--process-image-response + () used-marker '(:image :option) 1 "http://example.org/image.png") + + ;; the used marker has been unset: + (should (null (marker-position used-marker))) + ;; the media-state has been set to loaded and the image is being displayed + (should (eq 'loaded (get-text-property saved-marker 'media-state source-buffer))) + (should (eq ':fake-image (get-text-property saved-marker 'display source-buffer)))))))) + +(ert-deftest mastodon-media--inline-images () "Should process all media in buffer." (with-mock ;; Stub needed for the test setup: diff --git a/test/mastodon-notifications-test.el b/test/mastodon-notifications-test.el index ba08bd4..4804e10 100644 --- a/test/mastodon-notifications-test.el +++ b/test/mastodon-notifications-test.el @@ -1,8 +1,10 @@ +;;; mastodon-notifications-test.el --- Tests for mastodon-notifications.el -*- lexical-binding: nil -*- + (require 'cl-lib) (require 'cl-macs) (require 'el-mock) -(defconst mastodon-notifications-test-base-mentioned +(defconst mastodon-notifications--test-base-mentioned '((id . "1234") (type . "mention") (created_at . "2018-03-06T04:27:21.288Z" ) @@ -43,7 +45,7 @@ (favourites_count . 0) (reblog)))) -(defconst mastodon-notifications-test-base-favourite +(defconst mastodon-notifications--test-base-favourite '((id . "1234") (type . "favourite") (created_at . "2018-03-06T04:27:21.288Z" ) @@ -84,7 +86,7 @@ (favourites_count . 0) (reblog)))) -(defconst mastodon-notifications-test-base-boosted +(defconst mastodon-notifications--test-base-boosted '((id . "1234") (type . "reblog") (created_at . "2018-03-06T04:27:21.288Z" ) @@ -125,7 +127,7 @@ (favourites_count . 0) (reblog)))) -(defconst mastodon-notifications-test-base-followed +(defconst mastodon-notifications--test-base-followed '((id . "1234") (type . "follow") (created_at . "2018-03-06T04:27:21.288Z" ) @@ -166,7 +168,7 @@ (favourites_count . 0) (reblog)))) -(defconst mastodon-notifications-test-base-favourite +(defconst mastodon-notifications--test-base-favourite '((id . "1234") (type . "mention") (created_at . "2018-03-06T04:27:21.288Z" ) @@ -181,11 +183,11 @@ (statuses_count . 101) (note . "E")))) -(ert-deftest notification-get () +(ert-deftest mastodon-notifications--notification-get () "Ensure get request format for notifictions is accurate." (let ((mastodon-instance-url "https://instance.url")) (with-mock - (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications")) + (mock (mastodon-http--get-json "https://instance.url/api/v1/notifications" )) (mastodon-notifications--get)))) (defun mastodon-notifications--test-type (fun sample) @@ -205,9 +207,11 @@ notification to be tested." (mastodon-notifications--byline-concat "Mentioned")) (string= " Followed you" (mastodon-notifications--byline-concat "Followed")) - (string= " Favourited your status" + (string= " Favourited your status from" (mastodon-notifications--byline-concat "Favourited")) - (string= " Boosted your status" - (mastodon-notifications--byline-concat "Boosted"))))) + (string= " Boosted your status from" + (mastodon-notifications--byline-concat "Boosted")) + (string= " Posted a post" + (mastodon-notifications--byline-concat "Posted"))))) diff --git a/test/mastodon-search-tests.el b/test/mastodon-search-tests.el new file mode 100644 index 0000000..996f786 --- /dev/null +++ b/test/mastodon-search-tests.el @@ -0,0 +1,147 @@ +;;; mastodon-search-test.el --- Tests for mastodon-search.el -*- lexical-binding: nil -*- + +(defconst mastodon-search--single-account-query + '((id . "242971") + (username . "mousebot") + (acct . "mousebot") + (display_name . ": ( ) { : | : & } ; :") + (locked . t) + (bot . :json-false) + (discoverable . t) + (group . :json-false) + (created_at . "2020-04-14T00:00:00.000Z") + (note . "<p>poetry, writing, dmt, desertion, trash, black metal, translation, hegel, language, autonomia....</p><p><a href=\"https://anarchive.mooo.com\" rel=\"nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">anarchive.mooo.com</span><span class=\"invisible\"></span></a><br /><a href=\"https://pleasantlybabykid.tumblr.com/\" rel=\"nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">pleasantlybabykid.tumblr.com/</span><span class=\"invisible\"></span></a><br />IG: <a href=\"https://bibliogram.snopyta.org/u/martianhiatus\" rel=\"nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"ellipsis\">bibliogram.snopyta.org/u/marti</span><span class=\"invisible\">anhiatus</span></a><br />photos alt: <span class=\"h-card\"><a href=\"https://todon.eu/@goosebot\" class=\"u-url mention\">@<span>goosebot</span></a></span><br />git: <a href=\"https://git.blast.noho.st/mouse\" rel=\"nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">git.blast.noho.st/mouse</span><span class=\"invisible\"></span></a></p><p>want to trade chapbooks or zines? hmu!</p><p>he/him or they/them</p>") + (url . "https://todon.nl/@mousebot") + (avatar . "https://todon.nl/system/accounts/avatars/000/242/971/original/0a5e801576af597b.jpg") + (avatar_static . "https://todon.nl/system/accounts/avatars/000/242/971/original/0a5e801576af597b.jpg") + (header . "https://todon.nl/system/accounts/headers/000/242/971/original/f85f7f1048237fd4.jpg") + (header_static . "https://todon.nl/system/accounts/headers/000/242/971/original/f85f7f1048237fd4.jpg") + (followers_count . 226) + (following_count . 634) + (statuses_count . 3807) + (last_status_at . "2021-11-05") + (emojis . + []) + (fields . + [((name . "dark to") + (value . "themselves") + (verified_at)) + ((name . "its raining") + (value . "plastic") + (verified_at)) + ((name . "dis") + (value . "integration") + (verified_at)) + ((name . "ungleichzeitigkeit und") + (value . "gleichzeitigkeit, philosophisch") + (verified_at))])) + "A sample mastodon account search result (parsed json)") + +(defconst mastodon-search--test-single-tag + '((name . "TeamBringBackVisibleScrollbars") + (url . "https://todon.nl/tags/TeamBringBackVisibleScrollbars") + (history . [((day . "1636156800") (uses . "0") (accounts . "0")) + ((day . "1636070400") (uses . "0") (accounts . "0")) + ((day . "1635984000") (uses . "0") (accounts . "0")) + ((day . "1635897600") (uses . "0") (accounts . "0")) + ((day . "1635811200") (uses . "0") (accounts . "0")) + ((day . "1635724800") (uses . "0") (accounts . "0")) + ((day . "1635638400") (uses . "0") (accounts . "0"))]))) + +(defconst mastodon-search--test-single-status + '((id . "107230316503209282") + (created_at . "2021-11-06T13:19:40.628Z") + (in_reply_to_id) + (in_reply_to_account_id) + (sensitive . :json-false) + (spoiler_text . "") + (visibility . "direct") + (language . "en") + (uri . "https://todon.nl/users/mousebot/statuses/107230316503209282") + (url . "https://todon.nl/@mousebot/107230316503209282") + (replies_count . 0) + (reblogs_count . 0) + (favourites_count . 0) + (favourited . :json-false) + (reblogged . :json-false) + (muted . :json-false) + (bookmarked . :json-false) + (content . "<p>This is a nice test toot, for testing purposes. Thank you.</p>") + (reblog) + (application + (name . "mastodon.el") + (website . "https://github.com/jdenen/mastodon.el")) + (account + (id . "242971") + (username . "mousebot") + (acct . "mousebot") + (display_name . ": ( ) { : | : & } ; :") + (locked . t) + (bot . :json-false) + (discoverable . t) + (group . :json-false) + (created_at . "2020-04-14T00:00:00.000Z") + (note . "<p>poetry, writing, dmt, desertion, trash, black metal, translation, hegel, language, autonomia....</p><p><a href=\"https://anarchive.mooo.com\" rel=\"nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">anarchive.mooo.com</span><span class=\"invisible\"></span></a><br /><a href=\"https://pleasantlybabykid.tumblr.com/\" rel=\"nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">pleasantlybabykid.tumblr.com/</span><span class=\"invisible\"></span></a><br />IG: <a href=\"https://bibliogram.snopyta.org/u/martianhiatus\" rel=\"nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"ellipsis\">bibliogram.snopyta.org/u/marti</span><span class=\"invisible\">anhiatus</span></a><br />photos alt: <span class=\"h-card\"><a href=\"https://todon.eu/@goosebot\" class=\"u-url mention\">@<span>goosebot</span></a></span><br />git: <a href=\"https://git.blast.noho.st/mouse\" rel=\"nofollow noopener noreferrer\" target=\"_blank\"><span class=\"invisible\">https://</span><span class=\"\">git.blast.noho.st/mouse</span><span class=\"invisible\"></span></a></p><p>want to trade chapbooks or zines? hmu!</p><p>he/him or they/them</p>") + (url . "https://todon.nl/@mousebot") + (avatar . "https://todon.nl/system/accounts/avatars/000/242/971/original/0a5e801576af597b.jpg") + (avatar_static . "https://todon.nl/system/accounts/avatars/000/242/971/original/0a5e801576af597b.jpg") + (header . "https://todon.nl/system/accounts/headers/000/242/971/original/f85f7f1048237fd4.jpg") + (header_static . "https://todon.nl/system/accounts/headers/000/242/971/original/f85f7f1048237fd4.jpg") + (followers_count . 226) + (following_count . 634) + (statuses_count . 3807) + (last_status_at . "2021-11-05") + (emojis . []) + (fields . [((name . "dark to") + (value . "themselves") + (verified_at)) + ((name . "its raining") + (value . "plastic") + (verified_at)) + ((name . "dis") + (value . "integration") + (verified_at)) + ((name . "ungleichzeitigkeit und") + (value . "gleichzeitigkeit, philosophisch") + (verified_at))])) + (media_attachments . []) + (mentions . [((id . "242971") + (username . "mousebot") + (url . "https://todon.nl/@mousebot") + (acct . "mousebot"))]) + (tags . []) + (emojis . []) + (card) + (poll))) + +(ert-deftest mastodon-search--get-user-info-@ () + "Should build a list from a single account for company completion." + (should + (equal + (mastodon-search--get-user-info-@ mastodon-search--single-account-query) + '(": ( ) { : | : & } ; :" "@mousebot" "https://todon.nl/@mousebot")))) + +(ert-deftest mastodon-search--get-user-info () + "Should build a list from a single account for company completion." + (should + (equal + (mastodon-search--get-user-info mastodon-search--single-account-query) + '(": ( ) { : | : & } ; :" "mousebot" "https://todon.nl/@mousebot")))) + +(ert-deftest mastodon-search--get-hashtag-info () + "Should build a list of hashtag name and URL." + (should + (equal + (mastodon-search--get-hashtag-info mastodon-search--test-single-tag) + '("TeamBringBackVisibleScrollbars" + "https://todon.nl/tags/TeamBringBackVisibleScrollbars")))) + +(ert-deftest mastodon-search--get-status-info () + "Should return a list of ID, timestamp, content, and spoiler." + (should + (equal + (mastodon-search--get-status-info mastodon-search--test-single-status) + '("107230316503209282" + "2021-11-06T13:19:40.628Z" + "" + "<p>This is a nice test toot, for testing purposes. Thank you.</p>")))) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 851dc39..dd07416 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -1,3 +1,5 @@ +;;; mastodon-tl-test.el --- Tests for mastodon-tl.el -*- lexical-binding: nil -*- + (require 'cl-lib) (require 'cl-macs) (require 'el-mock) @@ -81,7 +83,7 @@ (username . "acct42"))]) (tags . []) (uri . "tag:example.space,2017-04-24:objectId=654321:objectType=Status") - (content . "<p><span class=\"h-card\"><a href=\"https://example.spacs/@acct42\">@<span>acct42</span></a></span> boost</p>") + (content . "<p><span class=\"h-card\"><a href=\"https://example.space/@acct42\">@<span>acct42</span></a></span> boost</p>") (url . "https://example.space/users/acct42/updates/123456789") (reblogs_count . 1) (favourites_count . 1) @@ -89,46 +91,94 @@ (reblogged))) "A sample reblogged/boosted toot (parsed json)") -(ert-deftest remove-html-1 () +(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>")) (should (string= (mastodon-tl--remove-html input) "foobar foobaz")))) -(ert-deftest remove-html-2 () +(ert-deftest mastodon-tl--remove-html-2 () "Should replace <\p> tags with two new lines." (let ((input "foobar</p>")) (should (string= (mastodon-tl--remove-html input) "foobar\n\n")))) -(ert-deftest toot-id-boosted () +(ert-deftest mastodon-tl--toot-id-boosted () "If a toot is boostedm, return the reblog id." (should (string= (mastodon-tl--as-string (mastodon-tl--toot-id mastodon-tl-test-base-boosted-toot)) "4543919"))) -(ert-deftest toot-id () +(ert-deftest mastodon-tl--toot-id () "If a toot is boostedm, return the reblog id." (should (string= (mastodon-tl--as-string (mastodon-tl--toot-id mastodon-tl-test-base-toot)) "61208"))) -(ert-deftest as-string-1 () +(ert-deftest mastodon-tl--as-string-1 () "Should accept a string or number and return a string." (let ((id "1000")) - (should (string= (mastodon-tl--as-string id) id)))) + (should (string= (mastodon-tl--as-string id) id)))) -(ert-deftest as-string-2 () +(ert-deftest mastodon-tl--as-string-2 () "Should accept a string or number and return a string." (let ((id 1000)) - (should (string= (mastodon-tl--as-string id) (number-to-string id))))) + (should (string= (mastodon-tl--as-string id) (number-to-string id))))) -(ert-deftest more-json () +(ert-deftest mastodon-tl--more-json () "Should request toots older than max_id." (let ((mastodon-instance-url "https://instance.url")) (with-mock (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) (mastodon-tl--more-json "timelines/foo" 12345)))) -(ert-deftest more-json-id-string () +(ert-deftest mastodon-tl--more-json-id-string () "Should request toots older than max_id. `mastodon-tl--more-json' should accept and id that is either @@ -138,7 +188,7 @@ a string or a numeric." (mock (mastodon-http--get-json "https://instance.url/api/v1/timelines/foo?max_id=12345")) (mastodon-tl--more-json "timelines/foo" "12345")))) -(ert-deftest update-json-id-string () +(ert-deftest mastodon-tl--update-json-id-string () "Should request toots more recent than since_id. `mastodon-tl--updated-json' should accept and id that is either @@ -156,10 +206,10 @@ a string or a numeric." (weeks (n) (* n (days 7))) (years (n) (* n (days 365))) (format-seconds-since (seconds) - (let ((timestamp (time-subtract (current-time) (seconds-to-time seconds)))) - (mastodon-tl--relative-time-description timestamp))) + (let ((timestamp (time-subtract (current-time) (seconds-to-time seconds)))) + (mastodon-tl--relative-time-description timestamp))) (check (seconds expected) - (should (string= (format-seconds-since seconds) expected)))) + (should (string= (format-seconds-since seconds) expected)))) (check 1 "less than a minute ago") (check 59 "less than a minute ago") (check 60 "one minute ago") @@ -195,33 +245,33 @@ a string or a numeric." (weeks (n) (* n (days 7))) (years (n) (* n (days 365.25))) (next-update (seconds-ago) - (let* ((timestamp (time-subtract current-time - (seconds-to-time seconds-ago)))) - (cdr (mastodon-tl--relative-time-details timestamp current-time)))) + (let* ((timestamp (time-subtract current-time + (seconds-to-time seconds-ago)))) + (cdr (mastodon-tl--relative-time-details timestamp current-time)))) (check (seconds-ago) - (let* ((timestamp (time-subtract current-time (seconds-to-time seconds-ago))) - (at-now (mastodon-tl--relative-time-description timestamp current-time)) - (at-one-second-before (mastodon-tl--relative-time-description - timestamp - (time-subtract (next-update seconds-ago) - (seconds-to-time 1)))) - (at-result (mastodon-tl--relative-time-description - timestamp - (next-update seconds-ago)))) - (when nil ;; change to t to debug test failures - (prin1 (format "\nFor %s: %s / %s" - seconds-ago - (time-to-seconds - (time-subtract (next-update seconds-ago) - timestamp)) - (round - (time-to-seconds - (time-subtract (next-update seconds-ago) - current-time)))))) - ;; a second earlier the description is the same as at current time - (should (string= at-now at-one-second-before)) - ;; but at the result time it is different - (should-not (string= at-one-second-before at-result))))) + (let* ((timestamp (time-subtract current-time (seconds-to-time seconds-ago))) + (at-now (mastodon-tl--relative-time-description timestamp current-time)) + (at-one-second-before (mastodon-tl--relative-time-description + timestamp + (time-subtract (next-update seconds-ago) + (seconds-to-time 1)))) + (at-result (mastodon-tl--relative-time-description + timestamp + (next-update seconds-ago)))) + (when nil ;; change to t to debug test failures + (prin1 (format "\nFor %s: %s / %s" + seconds-ago + (time-to-seconds + (time-subtract (next-update seconds-ago) + timestamp)) + (round + (time-to-seconds + (time-subtract (next-update seconds-ago) + current-time)))))) + ;; a second earlier the description is the same as at current time + (should (string= at-now at-one-second-before)) + ;; but at the result time it is different + (should-not (string= at-one-second-before at-result))))) (check 0) (check 1) (check 59) @@ -257,20 +307,20 @@ a string or a numeric." (mock (format-time-string mastodon-toot-timestamp-format '(22782 21551)) => "2999-99-99 00:11:22") (let ((byline (mastodon-tl--byline mastodon-tl-test-base-toot - 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted)) + 'mastodon-tl--byline-author + 'mastodon-tl--byline-boosted)) (handle-location 20)) - (should (string= (substring-no-properties + (should (string= (substring-no-properties byline) - " - | Account 42 (@acct42@example.space) 2999-99-99 00:11:22 - ------------")) - (should (eq (get-text-property handle-location 'mastodon-tab-stop byline) + "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + ------------ +")) + (should (eq (get-text-property handle-location 'mastodon-tab-stop byline) 'user-handle)) (should (string= (get-text-property handle-location 'mastodon-handle byline) "@acct42@example.space")) - (should (equal (get-text-property handle-location 'help-echo byline) - "Browse user profile of @acct42@example.space")))))) + (should (equal (get-text-property handle-location 'help-echo byline) + "Browse user profile of @acct42@example.space")))))) (ert-deftest mastodon-tl--byline-regular-with-avatar () "Should format the regular toot correctly." @@ -285,9 +335,9 @@ a string or a numeric." (mastodon-tl--byline mastodon-tl-test-base-toot 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted)) - " - | Account 42 (@acct42@example.space) 2999-99-99 00:11:22 - ------------"))))) + "Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + ------------ +"))))) (ert-deftest mastodon-tl--byline-boosted () "Should format the boosted toot correctly." @@ -302,9 +352,9 @@ a string or a numeric." (mastodon-tl--byline toot 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted)) - " - | (B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 - ------------"))))) + "(B) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + ------------ +"))))) (ert-deftest mastodon-tl--byline-favorited () "Should format the favourited toot correctly." @@ -319,9 +369,9 @@ a string or a numeric." (mastodon-tl--byline toot 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted)) - " - | (F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 - ------------"))))) + "(F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + ------------ +"))))) (ert-deftest mastodon-tl--byline-boosted/favorited () @@ -337,9 +387,9 @@ a string or a numeric." (mastodon-tl--byline toot 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted)) - " - | (B) (F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 - ------------"))))) + "(B) (F) Account 42 (@acct42@example.space) 2999-99-99 00:11:22 + ------------ +"))))) (ert-deftest mastodon-tl--byline-reblogged () "Should format the reblogged toot correctly." @@ -361,18 +411,19 @@ a string or a numeric." 'mastodon-tl--byline-boosted)) (handle1-location 20) (handle2-location 65)) - (should (string= (substring-no-properties byline) - " - | Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time - ------------")) - (should (eq (get-text-property handle1-location 'mastodon-tab-stop byline) - 'user-handle)) - (should (equal (get-text-property handle1-location 'help-echo byline) + (should (string= (substring-no-properties byline) + "Account 42 (@acct42@example.space) + Boosted Account 43 (@acct43@example.space) original time + ------------ +")) + (should (eq (get-text-property handle1-location 'mastodon-tab-stop byline) + 'user-handle)) + (should (equal (get-text-property handle1-location 'help-echo byline) "Browse user profile of @acct42@example.space")) - (should (eq (get-text-property handle2-location 'mastodon-tab-stop byline) - 'user-handle)) - (should (equal (get-text-property handle2-location 'help-echo byline) - "Browse user profile of @acct43@example.space")))))) + (should (eq (get-text-property handle2-location 'mastodon-tab-stop byline) + 'user-handle)) + (should (equal (get-text-property handle2-location 'help-echo byline) + "Browse user profile of @acct43@example.space")))))) (ert-deftest mastodon-tl--byline-reblogged-with-avatars () "Should format the reblogged toot correctly." @@ -393,9 +444,11 @@ a string or a numeric." (should (string= (substring-no-properties (mastodon-tl--byline toot 'mastodon-tl--byline-author - 'mastodon-tl--byline-boosted))" - | Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time - ------------"))))) + 'mastodon-tl--byline-boosted)) + "Account 42 (@acct42@example.space) + Boosted Account 43 (@acct43@example.space) original time + ------------ +"))))) (ert-deftest mastodon-tl--byline-reblogged-boosted/favorited () "Should format the reblogged toot that was also boosted & favoritedcorrectly." @@ -416,9 +469,10 @@ a string or a numeric." (mastodon-tl--byline toot 'mastodon-tl--byline-author 'mastodon-tl--byline-boosted)) - " - | (B) (F) Account 42 (@acct42@example.space) Boosted Account 43 (@acct43@example.space) original time - ------------"))))) + "(B) (F) Account 42 (@acct42@example.space) + Boosted Account 43 (@acct43@example.space) original time + ------------ +"))))) (ert-deftest mastodon-tl--byline-timestamp-has-relative-display () "Should display the timestamp with a relative time." @@ -687,20 +741,20 @@ a string or a numeric." (list 'r3 r3 r2 r3) (list 'end end r3 end)))) (with-mock - (stub message => nil) ;; don't mess up our test output with the function's messages - (cl-dolist (test test-cases) - (let ((test-name (cl-first test)) - (test-start (cl-second test)) - (expected-prev (cl-third test)) - (expected-next (cl-fourth test))) - (goto-char test-start) - (mastodon-tl--previous-tab-item) - (should (equal (list 'prev test-name expected-prev) - (list 'prev test-name (point)))) - (goto-char test-start) - (mastodon-tl--next-tab-item) - (should (equal (list 'next test-name expected-next) - (list 'next test-name (point))))))))))) + (stub message => nil) ;; don't mess up our test output with the function's messages + (cl-dolist (test test-cases) + (let ((test-name (cl-first test)) + (test-start (cl-second test)) + (expected-prev (cl-third test)) + (expected-next (cl-fourth test))) + (goto-char test-start) + (mastodon-tl--previous-tab-item) + (should (equal (list 'prev test-name expected-prev) + (list 'prev test-name (point)))) + (goto-char test-start) + (mastodon-tl--next-tab-item) + (should (equal (list 'next test-name expected-next) + (list 'next test-name (point))))))))))) (ert-deftest mastodon-tl--next-tab-item--no-spaces-at-ends () "Should do the correct tab actions even with regions right at buffer ends." @@ -735,20 +789,20 @@ a string or a numeric." (list 'gap2 gap2 r3 r4) (list 'r4 r4 r3 r4)))) (with-mock - (stub message => nil) ;; don't mess up our test output with the function's messages - (cl-dolist (test test-cases) - (let ((test-name (cl-first test)) - (test-start (cl-second test)) - (expected-prev (cl-third test)) - (expected-next (cl-fourth test))) - (goto-char test-start) - (mastodon-tl--previous-tab-item) - (should (equal (list 'prev test-name expected-prev) - (list 'prev test-name (point)))) - (goto-char test-start) - (mastodon-tl--next-tab-item) - (should (equal (list 'next test-name expected-next) - (list 'next test-name (point))))))))))) + (stub message => nil) ;; don't mess up our test output with the function's messages + (cl-dolist (test test-cases) + (let ((test-name (cl-first test)) + (test-start (cl-second test)) + (expected-prev (cl-third test)) + (expected-next (cl-fourth test))) + (goto-char test-start) + (mastodon-tl--previous-tab-item) + (should (equal (list 'prev test-name expected-prev) + (list 'prev test-name (point)))) + (goto-char test-start) + (mastodon-tl--next-tab-item) + (should (equal (list 'next test-name expected-next) + (list 'next test-name (point))))))))))) (defun tl-tests--property-values-at (property ranges) @@ -765,13 +819,13 @@ constant." (let ((now (current-time)) markers) (cl-labels ((insert-timestamp (n) - (insert (format "\nSome text before timestamp %s:" n)) - (insert (propertize - (format "timestamp #%s" n) - 'timestamp (time-subtract now (seconds-to-time (* 60 n))) - 'display (format "unset %s" n))) - (push (copy-marker (point)) markers) - (insert " some more text."))) + (insert (format "\nSome text before timestamp %s:" n)) + (insert (propertize + (format "timestamp #%s" n) + 'timestamp (time-subtract now (seconds-to-time (* 60 n))) + 'display (format "unset %s" n))) + (push (copy-marker (point)) markers) + (insert " some more text."))) (with-temp-buffer (cl-dotimes (n 12) (insert-timestamp (+ n 2))) (setq markers (nreverse markers)) @@ -829,10 +883,10 @@ constant." (insert "some text before\n") (setq toot-start (point)) (with-mock - (stub create-image => '(image "fake data")) - (stub shr-render-region => nil) ;; Travis's Emacs doesn't have libxml - (insert - (mastodon-tl--spoiler normal-toot-with-spoiler))) + (stub create-image => '(image "fake data")) + (stub shr-render-region => nil) ;; Travis's Emacs doesn't have libxml + (insert + (mastodon-tl--spoiler normal-toot-with-spoiler))) (setq toot-end (point)) (insert "\nsome more text.") (add-text-properties @@ -841,14 +895,14 @@ constant." 'toot-id (cdr (assoc 'id normal-toot-with-spoiler)))) (goto-char toot-start) - (should (eq t (looking-at "This is the spoiler warning text"))) + ;; (should (eq t (looking-at "This is the spoiler warning text"))) (setq link-region (mastodon-tl--find-next-or-previous-property-range 'mastodon-tab-stop toot-start nil)) ;; There should be a link following the text: (should-not (null link-region)) (goto-char (car link-region)) - (should (eq t (looking-at "Content Warning"))) + (should (eq t (looking-at "CW: This is the spoiler warning text"))) ;Content Warning"))) (setq body-position (+ 25 (cdr link-region))) ;; 25 is enough to skip the "\n--------------...." @@ -895,10 +949,10 @@ constant." 'help-echo "https://example.space/tags/sampletag") " some text after")) (rendered (with-mock - (stub shr-render-region => nil) - (mastodon-tl--render-text - fake-input-text - mastodon-tl-test-base-toot))) + (stub shr-render-region => nil) + (mastodon-tl--render-text + fake-input-text + mastodon-tl-test-base-toot))) (tag-location 7)) (should (eq (get-text-property tag-location 'mastodon-tab-stop rendered) 'hashtag)) @@ -908,29 +962,33 @@ constant." "Browse tag #sampletag")))) (ert-deftest mastodon-tl--extract-hashtag-from-url-mastodon-link () + "Should extract the hashtag from a tags url." (should (equal (mastodon-tl--extract-hashtag-from-url "https://example.org/tags/foo" "https://example.org") "foo"))) (ert-deftest mastodon-tl--extract-hashtag-from-url-other-link () + "Should extract the hashtag from a tag url." (should (equal (mastodon-tl--extract-hashtag-from-url "https://example.org/tag/foo" "https://example.org") "foo"))) (ert-deftest mastodon-tl--extract-hashtag-from-url-wrong-instance () + "Should not find a tag when the instance doesn't match." (should (null (mastodon-tl--extract-hashtag-from-url - "https://example.org/tags/foo" - "https://other.example.org")))) + "https://example.org/tags/foo" + "https://other.example.org")))) (ert-deftest mastodon-tl--extract-hashtag-from-url-not-tag () + "Should not find a hashtag when not a tag url" (should (null (mastodon-tl--extract-hashtag-from-url - "https://example.org/@userid" - "https://example.org")))) + "https://example.org/@userid" + "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 @@ -942,10 +1000,10 @@ constant." 'help-echo "https://bar.example/@foo") " some text after")) (rendered (with-mock - (stub shr-render-region => nil) - (mastodon-tl--render-text - fake-input-text - mastodon-tl-test-base-toot))) + (stub shr-render-region => nil) + (mastodon-tl--render-text + fake-input-text + mastodon-tl-test-base-toot))) (mention-location 11)) (should (eq (get-text-property mention-location 'mastodon-tab-stop rendered) 'user-handle)) @@ -953,17 +1011,86 @@ constant." "Browse user profile of @foo@bar.example")))) (ert-deftest mastodon-tl--extract-userhandle-from-url-correct-case () + "Should extract the user handle from url." (should (equal (mastodon-tl--extract-userhandle-from-url "https://example.org/@someuser" "@SomeUser") "@SomeUser@example.org"))) (ert-deftest mastodon-tl--extract-userhandle-from-url-missing-at-in-text () + "Should not extract a user handle from url if the text is wrong." (should (null (mastodon-tl--extract-userhandle-from-url "https://example.org/@someuser" "SomeUser")))) (ert-deftest mastodon-tl--extract-userhandle-from-url-query-in-url () + "Should not extract a user handle from url if there is a query param." (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 06da870..0c31029 100644 --- a/test/mastodon-toot-tests.el +++ b/test/mastodon-toot-tests.el @@ -1,6 +1,48 @@ +;;; 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-multi-mention +(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 . [((id . "1") (username . "federated") @@ -18,29 +60,111 @@ (defconst mastodon-toot-no-mention '((mentions . []))) -(ert-deftest toot-multi-mentions () +(ert-deftest mastodon-toot--multi-mentions () + "Should build a correct mention string from the test toot data. + +Even the local name \"local\" gets a domain name added." (let ((mastodon-auth--acct-alist '(("https://local.social". "null"))) (mastodon-instance-url "https://local.social")) (should (string= - (mastodon-toot--mentions mastodon-toot-multi-mention) + (mastodon-toot--mentions mastodon-toot--multi-mention) "@local@local.social @federated@federated.social @federated@federated.cafe ")))) -(ert-deftest toot-multi-mentions-with-name () +(ert-deftest mastodon-toot--multi-mentions-with-name () + "Should build a correct mention string omitting self. + +Here \"local\" is the user themselves and gets omitted from the +mention string." (let ((mastodon-auth--acct-alist '(("https://local.social". "local"))) (mastodon-instance-url "https://local.social")) (should (string= - (mastodon-toot--mentions mastodon-toot-multi-mention) + (mastodon-toot--mentions mastodon-toot--multi-mention) "@federated@federated.social @federated@federated.cafe ")))) -(ert-deftest toot-no-mention () +(ert-deftest mastodon-toot--no-mention () + "Should construct an empty mention string without mentions." (let ((mastodon-auth--acct-alist '(("https://local.social". "null"))) (mastodon-instance-url "https://local.social")) (should (string= (mastodon-toot--mentions mastodon-toot-no-mention) "")))) -(ert-deftest 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.")))))) |