branch: elpa/mastodon
commit 310e401c8da8358e619c1ec59fd42fc059493309
Merge: fd59828c89 cc252f0c1c
Author: marty hiatt <martianhia...@disroot.org>
Commit: marty hiatt <martianhia...@disroot.org>
Merge branch 'develop'
---
README.org | 37 +++++-
lisp/.dir-locals.el | 3 +-
lisp/mastodon-auth.el | 158 +++++++++++++++++++------
lisp/mastodon-client.el | 176 ++++++++++++++++++----------
lisp/mastodon-http.el | 156 ++++++++++++-------------
lisp/mastodon-media.el | 30 +++--
lisp/mastodon-notifications.el | 34 +++---
lisp/mastodon-tl.el | 255 +++++++++++++++++++++++++++++++++--------
lisp/mastodon-toot.el | 13 ++-
lisp/mastodon.el | 29 ++++-
mastodon-index.org | 107 +++++++++--------
test/mastodon-auth-tests.el | 36 ++++++
test/mastodon-client-tests.el | 147 +++++++++++++-----------
test/mastodon-http-tests.el | 36 +++---
test/mastodon-toot-tests.el | 1 +
15 files changed, 831 insertions(+), 387 deletions(-)
diff --git a/README.org b/README.org
index e2bbe7fdde..1b80e59c3d 100644
--- a/README.org
+++ b/README.org
@@ -121,8 +121,37 @@ can activate one at a time by changing those two variables
and restarting
Emacs.
If you were using mastodon.el before 2FA was implemented and the above
-steps do not work, delete the old file specified by
-=mastodon-client--token-file= and restart Emacs and follow the steps again.
+steps do not work, call =(mastodon-forget-all-logins)=, restart Emacs and
+follow the steps again.
+
+**** encrypted access tokens (from 2.0.0)
+
+By default, user access tokens are now stored in the user's auth source
+file (typically =~/.authinfo.gpg=, check the value of =auth-sources=). When
+you first update to 2.0.0, or if you encounter issues due to old
+credentials, call =(mastodon-forget-all-logins)= to remove the old
+mastodon.el plstore, and then authenticate again. If you don't want to use
+the auth source file, set =mastodon-auth-use-auth-source= to nil. Entries
+will instead be stored encrypted in =mastodon-client--token-file=, a plstore.
+
+If for some reason you reauthenticate, you'll need to either remove the
+entry in your auth sources file, or manually update the token in it after
+doing so, as mastodon.el is unable to reliably update (or even remove)
+entires.
+
+The format for a mastodon.el auth source entry is as follows:
+
+=machine INSTANCE login USERNAME password AUTHTOKEN=
+
+with the token being what you copy from the browser when authenticating.
+If you have =auth-source-save-behavior= set to nil, you'll also need to add
+such an entry manually.
+
+Finally, if you find you're asked for your key passphrase too often while
+authenticating, consider setting =epa-file-encrypt-to= (for auth-source
+encryption) and =plstore-encrypt-to= (for plstore encryption) to your
+preferred key ID.
+
*** Timelines
@@ -432,6 +461,10 @@ available at
https://holgerschurig.github.io/en/emacs-mastodon-hydra/.
A simple code snippet to enable narrowing to current item in timelines:
http://takeonrules.com/2024/10/31/hacking-on-mastodon-emacs-package-to-narrow-viewing/
+**** Sachac's config goodies
+
+The incomparable sachac has a bunch of =mastodon.el= extensions and goodies in
their literate config, available here:
https://sachachua.com/dotemacs/index.html#mastodon.
+
*** Live-updating timelines: =mastodon-async-mode=
(code taken from
[[https://github.com/alexjgriffith/mastodon-future.el][mastodon-future]].)
diff --git a/lisp/.dir-locals.el b/lisp/.dir-locals.el
index da012d6c7f..c1e0375993 100644
--- a/lisp/.dir-locals.el
+++ b/lisp/.dir-locals.el
@@ -2,5 +2,4 @@
;;; For more information see (info "(emacs) Directory Variables")
((nil . ((indent-tabs-mode . nil)))
- (emacs-lisp-mode . ((elisp-flymake-byte-compile-load-path . load-path)
- (package-lint-main-file . "mastodon.el"))))
+ (emacs-lisp-mode . ((package-lint-main-file . "mastodon.el"))))
diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el
index 6e90b5348f..2902c3195c 100644
--- a/lisp/mastodon-auth.el
+++ b/lisp/mastodon-auth.el
@@ -2,6 +2,7 @@
;; Copyright (C) 2017-2019 Johnson Denen
;; Copyright (C) 2021 Abhiseck Paira <abhiseckpa...@disroot.org>
+;; Copyright (C) 2025 Marty Hiatt <mouse...@disroot.org>
;; Author: Johnson Denen <johnson.de...@gmail.com>
;; Maintainer: Marty Hiatt <mouse...@disroot.org>
;; Homepage: https://codeberg.org/martianh/mastodon.el
@@ -32,6 +33,8 @@
(require 'plstore)
(require 'auth-source)
(require 'json)
+(require 'url)
+
(eval-when-compile (require 'subr-x)) ; for if-let*
(autoload 'mastodon-client "mastodon-client")
@@ -44,6 +47,8 @@
(autoload 'mastodon-http--get-json "mastodon-http")
(autoload 'mastodon-http--post "mastodon-http")
(autoload 'mastodon-return-credential-account "mastodon")
+(autoload 'mastodon-client--general-read "mastodon-client")
+(autoload 'mastodon-client--token-file "mastodon-client")
(defvar mastodon-instance-url)
(defvar mastodon-client-scopes)
@@ -55,6 +60,19 @@
:prefix "mastodon-auth-"
:group 'mastodon)
+(defcustom mastodon-auth-use-auth-source t
+ "Whether to use auth sources for user credentials.
+If t, save and read user access token in the user's auth source
+file (see `auth-sources'). If nil, use `mastodon-client--token-file'
+instead.
+If you change the value of this variable, call
+`mastodon-forget-all-logins' and log in again.
+If for some reason you generate a new token, you'll have to update your
+auth souce file manually, or at least remove the entry and authenticate
+again, as auth-source.el only provides unreliable tools for updating
+entries."
+ :type 'boolean)
+
(defvar mastodon-auth-source-file nil
"This variable is obsolete.
This variable currently serves no purpose and will be removed in
@@ -69,26 +87,25 @@ the future.")
(defvar mastodon-auth--user-unaware
" ** MASTODON.EL - NOTICE **
-It appears that you are not aware of the recent developments in
-mastodon.el. In short we now require that you also set the
-variable `mastodon-active-user' in your init file in addition to
-`mastodon-instance-url'.
+User variables not set: mastodon.el requires that you set both
+`mastodon-active-user' and `mastodon-instance-url' in your init file.
Please see its documentation to understand what value it accepts
by running M-x describe-variable on it or visiting our web page:
-https://codeberg.org/martianh/mastodon.el
-
-We apologize for the inconvenience.
+https://codeberg.org/martianh/mastodon.el.
")
(defun mastodon-auth--get-browser-login-url ()
"Return properly formed browser login url."
- (mastodon-http--concat-params-to-url
- (concat mastodon-instance-url "/oauth/authorize/")
- `(("response_type" . "code")
- ("redirect_uri" . ,mastodon-client-redirect-uri)
- ("scope" . ,mastodon-client-scopes)
- ("client_id" . ,(plist-get (mastodon-client) :client_id)))))
+ (let ((client-id (plist-get (mastodon-client) :client_id)))
+ (if (not client-id)
+ (error "Failed to set up client id")
+ (mastodon-http--concat-params-to-url
+ (concat mastodon-instance-url "/oauth/authorize/")
+ `(("response_type" . "code")
+ ("redirect_uri" . ,mastodon-client-redirect-uri)
+ ("scope" . ,mastodon-client-scopes)
+ ("client_id" . ,client-id))))))
(defvar mastodon-auth--explanation
(format
@@ -168,28 +185,72 @@ When ASK is absent return nil."
(json-string (buffer-substring-no-properties (point) (point-max))))
(json-read-from-string json-string))))
+(defun mastodon-auth--plstore-token-check (&optional auth-source)
+ "Signal an error if plstore contains unencrypted access-token.
+If AUTH-SOURCE, and if `mastodon-auth-use-auth-source' is non-nil,
+return non-nil if it contains any access token.
+Used to help users switch to the new encrypted auth token flow."
+ ;; FIXME: is it poss to move this plstore read to have one less read?
+ ;; e.g. inside of `mastodon-client--active-user'? the issue is that
+ ;; ideally we want to test "user-" entry, even if fetching "active-user"
+ ;; entry, so we would have to re-do the plstore read functions.
+ (when
+ (mastodon-auth--plstore-access-token-member auth-source)
+ (if auth-source
+ (user-error "Auth source storage of tokens is enabled,\
+ but there is also an access token in your plstore.\
+ If you're seeing this message after updating,\
+ call `mastodon-forget-all-logins', and try again.
+ If you don't want to use auth sources,\
+ also set `mastodon-auth-use-auth-source' to nil.\
+ If this message is in error, contact us on the mastodon.el repo")
+ (user-error "Unencrypted access token in your plstore.\
+ If you're seeing this message after updating,\
+ call `mastodon-forget-all-logins', and log in again.
+ If this message is in error, contact us on the mastodon.el repo"))))
+
+(defun mastodon-auth--plstore-access-token-member (&optional auth-source)
+ "Return non-nil if the user entry of the plstore contains :access_token.
+If AUTH-SOURCE, also check if it contains :secret-access_token."
+ (let* ((plstore (plstore-open (mastodon-client--token-file)))
+ (name (concat "user-" (mastodon-client--form-user-from-vars)))
+ ;; get alist like plstore.el does, so that keys will display with
+ ;; ":secret-" prefix if encrypted:
+ (alist (assoc name (plstore--get-merged-alist plstore))))
+ (if (and auth-source mastodon-auth-use-auth-source)
+ (or (member :access_token alist)
+ (member :secret-access_token alist))
+ (member :access_token alist))))
+
(defun mastodon-auth--access-token ()
"Return the access token to use with `mastodon-instance-url'.
Generate/save token if none known yet."
- (cond (mastodon-auth--token-alist
- ;; user variables are known and initialised.
- (alist-get mastodon-instance-url mastodon-auth--token-alist nil nil
#'string=))
- ((plist-get (mastodon-client--active-user) :access_token)
- ;; user variables need to be read from plstore.
- (push (cons mastodon-instance-url
- (plist-get (mastodon-client--active-user) :access_token))
- mastodon-auth--token-alist)
- (alist-get mastodon-instance-url mastodon-auth--token-alist nil nil
#'string=))
- ((null mastodon-active-user)
- ;; user not aware of 2FA-related changes and has not set
- ;; `mastodon-active-user'. Make user aware and error out.
- (mastodon-auth--show-notice mastodon-auth--user-unaware
- "*mastodon-notice*")
- (error "Variables not set properly"))
- (t
- ;; user access-token needs to fetched from the server and
- ;; stored and variables initialised.
- (mastodon-auth--handle-token-response (mastodon-auth--get-token)))))
+ (cond
+ (mastodon-auth--token-alist
+ ;; user variables are known and initialised.
+ (alist-get mastodon-instance-url
+ mastodon-auth--token-alist nil nil #'string=))
+ ;; if auth source enabled, but we have an access token in plstore,
+ ;; error out and tell user to remove plstore and start over or disable
+ ;; auth source:
+ ((mastodon-auth--plstore-token-check))
+ ((plist-get (mastodon-client--active-user) :access_token)
+ ;; user variables need to be read from plstore active-user entry.
+ (push (cons mastodon-instance-url
+ (plist-get (mastodon-client--active-user) :access_token))
+ mastodon-auth--token-alist)
+ (alist-get mastodon-instance-url
+ mastodon-auth--token-alist nil nil #'string=))
+ ((null mastodon-active-user)
+ ;; user not aware of 2FA-related changes and has not set
+ ;; `mastodon-active-user'. Make user aware and error out.
+ (mastodon-auth--show-notice mastodon-auth--user-unaware
+ "*mastodon-notice*")
+ (user-error "Variables not set properly"))
+ (t
+ ;; user access-token needs to fetched from the server and
+ ;; stored and variables initialised.
+ (mastodon-auth--handle-token-response (mastodon-auth--get-token)))))
(defun mastodon-auth--handle-token-response (response)
"Add token RESPONSE to `mastodon-auth--token-alist'.
@@ -206,6 +267,39 @@ Handle any errors from the server."
(error "Mastodon-auth--access-token: %s: %s" class error))
(_ (error "Unknown response from mastodon-auth--get-token!"))))
+(defun mastodon-auth-source-get (user host &optional token create)
+ "Fetch an auth source token, searching by USER and HOST.
+If CREATE, use TOKEN or prompt for it, and save it if there is no such entry.
+Return a list of user, password/secret, and the item's save-function."
+ (let* ((auth-source-creation-prompts
+ '((secret . "%u access token: ")))
+ (source
+ (car
+ (auth-source-search :host host :user user
+ :require '(:user :secret)
+ :secret (if token token nil)
+ ;; "create" alone doesn't work here!:
+ :create (if create t nil)))))
+ (when source
+ (let ((creds
+ `(,(plist-get source :user)
+ ,(auth-info-password source)
+ ,(plist-get source :save-function))))
+ (when create ;; call save function:
+ (when (functionp (nth 2 creds))
+ (funcall (nth 2 creds))))
+ creds))))
+
+(defun mastodon-auth-source-token (url handle &optional token create)
+ "Parse URL, search auth sources with it, user HANDLE and TOKEN.
+Calls `mastodon-auth-source-get', returns only the token.
+If CREATE, create an entry is none is found."
+ (let ((host (url-host
+ (url-generic-parse-url url)))
+ (username (car (split-string handle "@"))))
+ (nth 1
+ (mastodon-auth-source-get username host token create))))
+
(defun mastodon-auth--get-account-name ()
"Request user credentials and return an account name."
(alist-get 'acct
diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el
index c0db3d6172..1ad6d2bed7 100644
--- a/lisp/mastodon-client.el
+++ b/lisp/mastodon-client.el
@@ -2,6 +2,7 @@
;; Copyright (C) 2017-2019 Johnson Denen
;; Copyright (C) 2021 Abhiseck Paira <abhiseckpa...@disroot.org>
+;; Copyright (C) 2025 Marty Hiatt <mouse...@disroot.org>
;; Author: Johnson Denen <johnson.de...@gmail.com>
;; Maintainer: Marty Hiatt <mouse...@disroot.org>
;; Homepage: https://codeberg.org/martianh/mastodon.el
@@ -35,11 +36,14 @@
(defvar mastodon-instance-url)
(defvar mastodon-active-user)
+(defvar mastodon-auth-use-auth-source)
(autoload 'mastodon-http--api "mastodon-http")
(autoload 'mastodon-http--post "mastodon-http")
+(autoload 'mastodon-auth-source-token "mastodon-auth")
-(defcustom mastodon-client--token-file (concat user-emacs-directory
"mastodon.plstore")
+(defcustom mastodon-client--token-file
+ (concat user-emacs-directory "mastodon.plstore")
"File path where Mastodon access tokens are stored."
:group 'mastodon
:type 'file)
@@ -71,14 +75,23 @@
(defun mastodon-client--fetch ()
"Return JSON from `mastodon-client--register' call."
- (with-current-buffer (mastodon-client--register)
- (goto-char (point-min))
- (re-search-forward "^$" nil 'move)
- (let ((json-object-type 'plist)
- (json-key-type 'keyword)
- (json-array-type 'vector)
- (json-string (buffer-substring-no-properties (point) (point-max))))
- (json-read-from-string json-string))))
+ (let ((buf (mastodon-client--register)))
+ (if (not buf)
+ (user-error "Client registration failed.\
+ Is `mastodon-instance-url' correct?")
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (re-search-forward "^$" nil 'move)
+ (let* ((json-object-type 'plist)
+ (json-key-type 'keyword)
+ (json-array-type 'vector)
+ (json-string
+ (buffer-substring-no-properties (point) (point-max)))
+ (parsed
+ (json-read-from-string json-string)))
+ (if (eq :error (car parsed))
+ (error "Error: %s" (cadr parsed))
+ parsed))))))
(defun mastodon-client--token-file ()
"Return `mastodon-client--token-file'."
@@ -86,19 +99,28 @@
(defun mastodon-client--store ()
"Store client_id and client_secret in `mastodon-client--token-file'.
-
-Make `mastodon-client--fetch' call to determine client values."
- (let ((plstore (plstore-open (mastodon-client--token-file)))
- (client (mastodon-client--fetch))
- ;; alexgriffith reported seeing ellipses in the saved output
- ;; which indicate some output truncating. Nothing in `plstore-save'
- ;; seems to ensure this cannot happen so let's do that ourselves:
- (print-length nil)
- (print-level nil))
- (plstore-put plstore (concat "mastodon-" mastodon-instance-url) client nil)
+Make `mastodon-client--fetch' call to determine client values.
+Return a plist of secret and non-secret key/val pairs."
+ (let* ((plstore (plstore-open (mastodon-client--token-file)))
+ (client (mastodon-client--fetch))
+ (secrets `( :client_id ,(plist-get client :client_id)
+ :client_secret ,(plist-get client :client_secret)))
+ (sans-secrets
+ (dolist (x '(:client_id :client_secret) client)
+ (cl-remf client x)))
+ ;; alexgriffith reported seeing ellipses in the saved output
+ ;; which indicate some output truncating. Nothing in
+ ;; `plstore-save' seems to ensure this cannot happen so let's do
+ ;; that ourselves:
+ (print-length nil)
+ (print-level nil))
+ (plstore-put plstore
+ (concat "mastodon-" mastodon-instance-url)
+ sans-secrets secrets)
+ ;; FIXME: breaks tests: prompts for gpg passphrase
(plstore-save plstore)
(plstore-close plstore)
- client))
+ (append secrets sans-secrets)))
(defun mastodon-client--remove-key-from-plstore (plstore)
"Remove KEY from PLSTORE."
@@ -109,7 +131,10 @@ Make `mastodon-client--fetch' call to determine client
values."
(defun mastodon-client--read ()
"Retrieve client_id and client_secret from `mastodon-client--token-file'."
(let* ((plstore (plstore-open (mastodon-client--token-file)))
- (mastodon (plstore-get plstore (concat "mastodon-"
mastodon-instance-url))))
+ (mastodon
+ (plstore-get plstore
+ (concat "mastodon-" mastodon-instance-url))))
+ (plstore-close plstore)
(mastodon-client--remove-key-from-plstore mastodon)))
(defun mastodon-client--general-read (key)
@@ -117,38 +142,69 @@ Make `mastodon-client--fetch' call to determine client
values."
Return plist without the KEY."
(let* ((plstore (plstore-open (mastodon-client--token-file)))
(plstore-item (plstore-get plstore key)))
+ (plstore-close plstore)
(mastodon-client--remove-key-from-plstore plstore-item)))
(defun mastodon-client--make-user-details-plist ()
"Make a plist with current user details. Return it."
- `(:username ,(mastodon-client--form-user-from-vars)
- :instance ,mastodon-instance-url
- :client_id ,(plist-get (mastodon-client) :client_id)
- :client_secret ,(plist-get (mastodon-client) :client_secret)))
+ `( :username ,(mastodon-client--form-user-from-vars)
+ :instance ,mastodon-instance-url
+ :client_id ,(plist-get (mastodon-client) :client_id)
+ :client_secret ,(plist-get (mastodon-client) :client_secret)))
(defun mastodon-client--store-access-token (token)
- "Save TOKEN as :access_token in plstore of the current user.
-Return the plist after the operation."
+ "Save TOKEN as :access_token encrypted in the plstore.
+Return the plist after the operation.
+If `mastodon-auth-use-auth-source', encrypt it in auth source file."
(let* ((user-details (mastodon-client--make-user-details-plist))
(plstore (plstore-open (mastodon-client--token-file)))
- (username (plist-get user-details :username))
- (plstore-value (setq user-details
- (plist-put user-details :access_token token)))
+ (username (mastodon-client--form-user-from-vars))
+ (key (concat "user-" username))
+ (secrets `( :client_id ,(plist-get user-details :client_id)
+ :client_secret ,(plist-get user-details :client_secret)))
+ (sans-secrets
+ (dolist (x '(:client_id :client_secret) user-details)
+ (cl-remf user-details x)))
(print-length nil)
(print-level nil))
- (plstore-put plstore (concat "user-" username) plstore-value nil)
+ (if mastodon-auth-use-auth-source
+ ;; auth-source:
+ (progn
+ (mastodon-auth-source-token
+ mastodon-instance-url username token :create)
+ (plstore-put plstore key sans-secrets secrets))
+ ;; plstore encrypted:
+ (plstore-put plstore key sans-secrets
+ (append secrets `(:access_token ,token))))
(plstore-save plstore)
(plstore-close plstore)
- plstore-value))
+ (cdr (plstore-get plstore key))))
(defun mastodon-client--make-user-active (user-details)
- "USER-DETAILS is a plist consisting of user details."
- (let ((plstore (plstore-open (mastodon-client--token-file)))
- (print-length nil)
- (print-level nil))
- (plstore-put plstore "active-user" user-details nil)
+ "USER-DETAILS is a plist consisting of user details.
+Save it to plstore under key \"active-user\".
+If `mastodon-auth-use-auth-source' is non-nil, fetch the access token
+from the user's auth source file and add it to the active user entry.
+Return a plist of secret and non-secret key/val pairs."
+ (let* ((plstore (plstore-open (mastodon-client--token-file)))
+ (handle (plist-get user-details :username))
+ (token
+ (if mastodon-auth-use-auth-source
+ (mastodon-auth-source-token mastodon-instance-url handle)
+ (plist-get user-details :access_token)))
+ (secrets `( :access_token ,token
+ :client_id ,(plist-get user-details :client_id)
+ :client_secret ,(plist-get user-details :client_secret)))
+ (deets (copy-sequence user-details))
+ (sans-secrets
+ (dolist (x '(:client_id :client_secret :access_token) deets)
+ (cl-remf deets x)))
+ (print-length nil)
+ (print-level nil))
+ (plstore-put plstore "active-user" sans-secrets secrets)
(plstore-save plstore)
- (plstore-close plstore)))
+ (plstore-close plstore)
+ (append secrets sans-secrets)))
(defun mastodon-client--form-user-from-vars ()
"Create a username from user variable. Return that username.
@@ -161,12 +217,12 @@ variables `mastodon-instance-url' and
`mastodon-active-user'."
(defun mastodon-client--make-current-user-active ()
"Make the user specified by user variables active user.
Return the details (plist)."
- (let ((username (mastodon-client--form-user-from-vars))
- user-plist)
- (when (setq user-plist
- (mastodon-client--general-read (concat "user-" username)))
- (mastodon-client--make-user-active user-plist))
- user-plist))
+ (let* ((username (mastodon-client--form-user-from-vars))
+ (user-plist (mastodon-client--general-read
+ (concat "user-" username))))
+ (when user-plist
+ (mastodon-client--make-user-active user-plist)
+ user-plist)))
(defun mastodon-client--current-user-active-p ()
"Return user-details if the current user is active.
@@ -180,28 +236,26 @@ Otherwise return nil."
(defun mastodon-client--active-user ()
"Return the details of the currently active user.
Details is a plist."
- (let ((active-user-details mastodon-client--active-user-details-plist))
- (unless active-user-details
- (setq active-user-details
- (or (mastodon-client--current-user-active-p)
- (mastodon-client--make-current-user-active)))
+ (or mastodon-client--active-user-details-plist
(setq mastodon-client--active-user-details-plist
- active-user-details))
- active-user-details))
+ (or (mastodon-client--current-user-active-p)
+ (mastodon-client--make-current-user-active)))))
(defun mastodon-client ()
"Return variable client secrets to use for `mastodon-instance-url'.
-Read plist from `mastodon-client--token-file' if variable is nil.
-Fetch and store plist if `mastodon-client--read' returns nil."
+If `mastodon-client--client-details-alist' is nil, read plist from
+`mastodon-client--token-file'.
+Fetch and store plist if `mastodon-client--read' returns nil.
+Return a plist."
(let ((client-details
- (cdr (assoc mastodon-instance-url
mastodon-client--client-details-alist))))
- (unless client-details
- (setq client-details
- (or (mastodon-client--read)
- (mastodon-client--store)))
- (push (cons mastodon-instance-url client-details)
- mastodon-client--client-details-alist))
- client-details))
+ (cdr (assoc mastodon-instance-url
+ mastodon-client--client-details-alist))))
+ (or client-details
+ (let ((client-details (or (mastodon-client--read)
+ (mastodon-client--store))))
+ (push (cons mastodon-instance-url client-details)
+ mastodon-client--client-details-alist)
+ client-details))))
(provide 'mastodon-client)
;;; mastodon-client.el ends here
diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el
index 98c2607950..a55097dff2 100644
--- a/lisp/mastodon-http.el
+++ b/lisp/mastodon-http.el
@@ -31,8 +31,8 @@
;;; Code:
(require 'json)
-(require 'request) ; for attachments upload
(require 'url)
+(require 'url-http)
(require 'shr)
(defvar mastodon-instance-url)
@@ -41,6 +41,7 @@
(autoload 'mastodon-auth--access-token "mastodon-auth")
(autoload 'mastodon-toot--update-status-fields "mastodon-toot")
+(autoload 'url-insert "url-handlers")
(defvar mastodon-http--api-version "v1")
@@ -57,23 +58,6 @@ Optionally specify VERSION in format vX."
"Return Mastodon API v2 URL for ENDPOINT."
(mastodon-http--api endpoint "v2"))
-(defun mastodon-http--response ()
- "Capture response buffer content as string."
- (with-current-buffer (current-buffer)
- (buffer-substring-no-properties (point-min) (point-max))))
-
-(defun mastodon-http--response-body (pattern)
- "Return substring matching PATTERN from `mastodon-http--response'."
- (let ((resp (mastodon-http--response)))
- (string-match pattern resp)
- (match-string 0 resp)))
-
-(defun mastodon-http--status ()
- "Return HTTP Response Status Code from `mastodon-http--response'."
- (let* ((status-line (mastodon-http--response-body "^HTTP/1.*$")))
- (string-match "[0-9][0-9][0-9]" status-line)
- (match-string 0 status-line)))
-
(defun mastodon-http--url-retrieve-synchronously (url &optional silent)
"Retrieve URL asynchronously.
This is a thin abstraction over the system
@@ -86,13 +70,16 @@ SILENT means don't message."
(defun mastodon-http--triage (response success)
"Determine if RESPONSE was successful.
-Call SUCCESS if successful. Message status and JSON error from
-RESPONSE if unsuccessful."
+Call SUCCESS on RESPONSE if successful. Message status and JSON error
+from RESPONSE if unsuccessful."
(let ((status (with-current-buffer response
- (mastodon-http--status))))
- (if (string-prefix-p "2" status)
+ ;; FIXME: breaks tests, as url-http-end-of-headers not set
+ (url-http-parse-response))))
+ (if (and (>= 200 status)
+ (<= status 299))
+ ;; (string-prefix-p "2" (number-to-string status))
(funcall success response)
- (if (string-prefix-p "404" status)
+ (if (= 404 status)
(message "Error %s: page not found" status)
(let ((json-response (with-current-buffer response
(mastodon-http--process-json))))
@@ -360,73 +347,80 @@ PARAMS is an alist of any extra parameters to send with
the request."
Then run function CALLBACK with arguements CBARGS.
Authorization header is included by default unless UNAUTHENTICED-P is non-nil."
(mastodon-http--authorized-request "POST"
- (let (;(request-timeout 5) ; this is from request.el no url.el!
- (url-request-data (when params
+ (let ((url-request-data (when params
(mastodon-http--build-params-string params))))
(with-temp-buffer
(url-retrieve url callback cbargs)))))
-;; TODO: test for curl first?
+(defun mastodon-http--get-cb-data (status)
+ "Return data using `json-read' after a successful async request.
+If STATUS includes an error, emit a message describing it and return nil."
+ (let* ((buf (current-buffer))
+ (data (with-temp-buffer
+ (url-insert buf)
+ (goto-char (point-min))
+ (json-read))))
+ (if-let* ((error-thrown (plist-get status :error)))
+ ;; not necessarily a user error, but we want its functionality:
+ (user-error "%S %s" error-thrown (alist-get 'error data))
+ data)))
+
+(defun mastodon-http--post-media-callback (status file caption buffer)
+ "Callback function called after posting FILE as an attachment with CAPTION.
+The toot is being composed in BUFFER. See `url-retrieve' for STATUS."
+ (unwind-protect
+ (when-let* ((data (mastodon-http--get-cb-data status)))
+ (with-current-buffer buffer
+ (let ((id (alist-get 'id data)))
+ ;; update ids:
+ (if (not mastodon-toot--media-attachment-ids)
+ ;; add first id:
+ (push id mastodon-toot--media-attachment-ids)
+ ;; add new id to end of list to preserve order:
+ (push id (cdr
+ (last mastodon-toot--media-attachment-ids))))
+ ;; pleroma, PUT the description:
+ ;; this is how the mangane akkoma web client does it
+ ;; and it seems easier than the other options!
+ (when (and caption
+ (not (string= caption (alist-get 'description data))))
+ (let ((url (mastodon-http--api (format "media/%s" id))))
+ ;; (message "PUTting image description")
+ (mastodon-http--put url `(("description" . ,caption)))))
+ (message "Uploading %s... (done)" file)
+ (mastodon-toot--update-status-fields))))
+ (kill-buffer (current-buffer))))
+
+(defun mastodon-http--post-media-prep-file (filename)
+ "Return the request data to upload FILENAME."
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-literally filename)
+ (let ((boundary (buffer-hash)))
+ (goto-char (point-min))
+ (insert "--" boundary "\r\n"
+ (format "Content-Disposition: form-data; name=\"file\";
filename=\"%s\"\r\n\r\n"
+ (file-name-nondirectory filename)))
+ (goto-char (point-max))
+ (insert "\r\n" "--" boundary "--" "\r\n")
+ `(,boundary . ,(buffer-substring-no-properties (point-min)
(point-max))))))
+
(defun mastodon-http--post-media-attachment (url filename caption)
"Make POST request to upload FILENAME with CAPTION to the server's media URL.
The upload is asynchronous. On succeeding,
`mastodon-toot--media-attachment-ids' is set to the id(s) of the
item uploaded, and `mastodon-toot--update-status-fields' is run."
- (let* ((file (file-name-nondirectory filename))
- (request-backend 'curl)
- (desc `(("description" . ,caption)))
- (cb (cl-function
- (lambda (&key data &allow-other-keys)
- (when data
- (let* ((id (alist-get 'id data)))
- ;; update ids:
- (if (not mastodon-toot--media-attachment-ids)
- ;; add first id:
- (push id mastodon-toot--media-attachment-ids)
- ;; add new id to end of list to preserve order:
- (push id (cdr
- (last mastodon-toot--media-attachment-ids))))
- ;; pleroma, PUT the description:
- ;; this is how the mangane akkoma web client does it
- ;; and it seems easier than the other options!
- (when (and caption
- (not (string= caption (alist-get 'description
data))))
- (let ((url (mastodon-http--api (format "media/%s" id))))
- ;; (message "PUTting image description")
- (mastodon-http--put url desc)))
- (message "Uploading %s... (done)" file)
- (mastodon-toot--update-status-fields)))))))
- (request
- url
- :type "POST"
- :params desc
- :files `(("file" . (,file :file ,filename
- :mime-type "multipart/form-data")))
- :parser 'json-read
- :headers `(("Authorization" . ,(concat "Bearer "
- (mastodon-auth--access-token))))
- :sync nil
- :success (apply-partially cb)
- :error (cl-function
- (lambda (&key error-thrown &allow-other-keys)
- (cond
- ;; handle curl errors first (eg 26, can't read file/path)
- ;; because the '=' test below fails for them
- ;; they have the form (error . error message 24)
- ((not (proper-list-p error-thrown)) ; not dotted list
- (message "Got error: %s. Shit went south." (cdr
error-thrown)))
- ;; handle mastodon api errors
- ;; they have the form (error http 401)
- ((= (car (last error-thrown)) 401)
- (message "Got error: %s Unauthorized: The access token is
invalid"
- error-thrown))
- ((= (car (last error-thrown)) 422)
- (message "Got error: %s Unprocessable entity: file or file\
- type is unsupported or invalid"
- error-thrown))
- (t
- (message "Got error: %s Shit went south"
- error-thrown))))))))
+ (mastodon-http--authorized-request "POST"
+ (let* ((data (mastodon-http--post-media-prep-file filename))
+ (url-request-extra-headers
+ (append url-request-extra-headers ; auth set in macro
+ `(("Content-Type" . ,(format "multipart/form-data;
boundary=%s"
+ (car data))))))
+ (url-request-data (cdr data))
+ (params `(("description" . ,caption)))
+ (url (mastodon-http--concat-params-to-url url params)))
+ (url-retrieve url #'mastodon-http--post-media-callback
+ `(,filename ,caption ,(current-buffer))))))
(provide 'mastodon-http)
;;; mastodon-http.el ends here
diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el
index 09692c311b..87b58b8b38 100644
--- a/lisp/mastodon-media.el
+++ b/lisp/mastodon-media.el
@@ -332,7 +332,12 @@ image-data prop so it can be toggled."
mastodon-media--sensitive-image-data nil t)
sensitive-state hidden image-data ,image))))
-(defun mastodon-media--process-full-sized-image-response (status-plist url)
+(defvar mastodon-media--attachments nil
+ "A list attachment details for full sized image view buffer.
+The first element is the URL of the image displayed, followed by plists of
details of all of a toot's attachments.")
+
+(defun mastodon-media--process-full-sized-image-response
+ (status-plist url attachments &optional prev-buf)
;; FIXME: refactor this with but not into
;; `mastodon-media--process-image-response'.
"Callback function processing the `url-retrieve' response for URL.
@@ -347,16 +352,25 @@ STATUS-PLIST is a plist of status events as per
`url-retrieve'."
;; https://codeberg.org/martianh/mastodon.el/issues/540
(let* ((handle (mm-dissect-buffer t))
(image (mm-get-image handle))
- (str (image-property image :data)))
- (with-current-buffer (get-buffer-create "*masto-image*")
+ (str (image-property image :data))
+ (buf "*masto-image*"))
+ (with-current-buffer (get-buffer-create buf)
(let ((inhibit-read-only t))
(erase-buffer)
(insert-image image str)
(special-mode) ; prevent image-mode loop bug
- (image-mode)
+ (mastodon-image-mode) ;; for our keymap
(goto-char (point-min))
- (switch-to-buffer-other-window (current-buffer))
- (image-transform-fit-both))))))
+ (image-transform-fit-both)
+ ;; set image metadata for view cycling:
+ (setq-local mastodon-media--attachments (cons url attachments))))
+ ;; switch to buf if not already viewing it:
+ (unless (equal buf prev-buf)
+ (switch-to-buffer-other-window buf))
+ ;; display bindings if multiple images:
+ (when (< 1 (length (cdr mastodon-media--attachments)))
+ (message (substitute-command-keys
+ "\\`.'/\\`>'/\\`<right>' to cycle images"))))))
(defun mastodon-media--image-or-cached (url process-fun args)
"Fetch URL from cache or fro host.
@@ -499,8 +513,8 @@ CAPTION is the image caption if provided.
SENSITIVE is a flag from the item's JSON data."
(let* ((help-echo-base
(substitute-command-keys
- (concat "\\`RET'/\\`i': load full image (prefix: copy URL),
\\`+'/\\`-': zoom,\
- \\`r': rotate, \\`o': save preview"
+ (concat "\\`RET': load full image or play video,\
+ \\`i' for image options"
(when (not (eq sensitive :json-false))
", \\`S': toggle sensitive media"))))
(help-echo (if caption
diff --git a/lisp/mastodon-notifications.el b/lisp/mastodon-notifications.el
index b795db4041..e21aad3033 100644
--- a/lisp/mastodon-notifications.el
+++ b/lisp/mastodon-notifications.el
@@ -89,7 +89,7 @@
(defvar mastodon-group-notifications)
(defvar mastodon-notifications-grouped-names-count)
(defvar mastodon-tl--link-keymap)
-
+(defvar mastodon-tl--update-point)
;;; VARIABLES
(defvar mastodon-notifications--map
@@ -132,11 +132,6 @@ Notification types are named according to their name on
the server.")
("Edited" . "their post"))
"Alist of subjects for notification types.")
-(defvar mastodon-notifications-grouped-types
- '("reblog" "favourite") ;; TODO: implement follow!
- "List of notification types for which grouping is implemented.
-Used in `mastodon-notifications-get'")
-
(defvar mastodon-notifications--action-alist
'((reblog . "Boosted")
(favourite . "Favourited")
@@ -587,23 +582,22 @@ When AVATAR, include the account's avatar image."
"Display grouped notifications in JSON.
NO-GROUP means don't render grouped notifications."
;; (setq masto-grouped-notifs json)
- (if no-group
- (cl-loop for x in json
- do (mastodon-notifications--format-note x))
- (let ((groups (alist-get 'notification_groups json)))
+ (let ((start-pos (point)))
+ (if no-group
+ (cl-loop for x in json
+ do (mastodon-notifications--format-note x))
(cl-loop
- for g in groups
- for start-pos = (point)
+ for g in (alist-get 'notification_groups json)
for accounts = (mastodon-notifications--group-accounts
(alist-get 'sample_account_ids g)
(alist-get 'accounts json))
for type = (alist-get 'type g)
for status = (mastodon-notifications--status-or-event g type json)
- do (mastodon-notifications--format-group-note g status accounts)
- (when mastodon-tl--display-media-p
- ;; images-in-notifs custom is handeld in
- ;; `mastodon-tl--media-attachment', not here
- (mastodon-media--inline-images start-pos (point)))))))
+ do (mastodon-notifications--format-group-note g status accounts)))
+ (when mastodon-tl--display-media-p
+ ;; images-in-notifs custom is handeld in
+ ;; `mastodon-tl--media-attachment', not here
+ (mastodon-media--inline-images start-pos (point)))))
(defun mastodon-notifications--status-or-event (group type json)
"Return a notification's status or event data.
@@ -618,6 +612,10 @@ Using GROUP data, notification TYPE, and overall notifs
JSON."
'id
(alist-get 'statuses json))))
+(defun mastodon-notifications--empty-group-json-p (json)
+ "Non-nil if JSON is empty grouped notifs data."
+ (equal json '((accounts) (statuses) (notification_groups))))
+
(defun mastodon-notifications--timeline (json &optional type update)
"Format JSON in Emacs buffer.
Optionally specify TYPE.
@@ -639,6 +637,8 @@ UPDATE means we are updating, so skip some things."
(substitute-command-keys
"You have filtered notifications. \
\\[mastodon-notifications-requests] to view requests.\n\n")))
+ ;; set update point:
+ (setq mastodon-tl--update-point (point))
;; render:
(mastodon-notifications--render json
(not mastodon-group-notifications))
diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el
index 5b87da235c..508332b098 100644
--- a/lisp/mastodon-tl.el
+++ b/lisp/mastodon-tl.el
@@ -94,7 +94,7 @@
(autoload 'mastodon-search-load-link-posts "mastodon-search")
(autoload 'mastodon-notifications--current-type "mastodon-notifications")
(autoload 'mastodon-notifications--timeline "mastodon-notifications")
-
+(autoload 'mastodon-notifications--empty-group-json-p "mastodon-notifications")
(defvar mastodon-toot--visibility)
(defvar mastodon-toot-mode)
(defvar mastodon-active-user)
@@ -110,6 +110,7 @@
(defvar mastodon-media--enable-image-caching)
(defvar mastodon-media--generic-broken-image-data)
(defvar mastodon-media--sensitive-image-data)
+(defvar mastodon-media--attachments)
;;; CUSTOMIZES
@@ -171,7 +172,7 @@ nil."
(status . ("✍" . "[posted]"))
(replied . ("⬇" . "↓"))
(reply-bar . ("┃" . "|"))
- (poll . ("📊" . ""))
+ (poll . ("📊" . "[poll]"))
(follow . ("👤" . "+"))
(follow_request . ("👤" . "+"))
(severed_relationships . ("🔗" . "//"))
@@ -333,6 +334,22 @@ types of mastodon links and not just shr.el-generated
ones.")
"The keymap to be set for the author byline.
It is active where point is placed by `mastodon-tl-goto-next-item.'")
+(require 'image-mode)
+
+(defvar mastodon-image-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map image-mode-map)
+ (define-key map (kbd ">") #'mastodon-tl-next-full-image)
+ (define-key map (kbd "<") #'mastodon-tl-prev-full-image)
+ (define-key map (kbd ".") #'mastodon-tl-next-full-image)
+ (define-key map (kbd ",") #'mastodon-tl-prev-full-image)
+ ;; matches view full image binding in main keymap:
+ (define-key map (kbd "=") #'mastodon-tl-next-full-image)
+ (define-key map (kbd "-") #'mastodon-tl-prev-full-image)
+ (define-key map (kbd "<right>") #'mastodon-tl-next-full-image)
+ (define-key map (kbd "<left>") #'mastodon-tl-prev-full-image)
+ map))
+
;;; MACROS
@@ -750,8 +767,10 @@ The result is added as an attachments property to
author-byline."
(let ((media (mastodon-tl--field 'media_attachments toot)))
(mapcar (lambda (attachment)
(let-alist attachment
- (list :url (or .remote_url .url) ; fallback for notifications
- :type .type)))
+ (list :id .id
+ :type .type
+ ;; fallback for notifications:
+ :url (or .remote_url .url))))
media)))
(defun mastodon-tl--byline-booster (toot)
@@ -1104,24 +1123,30 @@ Return nil if no matching element."
(setq mention (pop mentions)))
return))))
-(defun mastodon-tl--userhandle-from-url (url buffer-text)
+(defun mastodon-tl--userhandle-from-url (url &optional buffer-text)
"Return the user hande the URL points to or nil if it is not a profile link.
BUFFER-TEXT is the text covered by the link with URL, for a user profile
-this should be of the form <at-sign><user id>, e.g. \"@Gargon\"."
+this should be of the form <at-sign><user id>, e.g. \"@Gargon\".
+This is called on all post URLs, so needs to handle non profile URLs
+gracefully."
(let* ((parsed-url (url-generic-parse-url url))
(host (url-host parsed-url))
(local-p (string=
(url-host (url-generic-parse-url mastodon-instance-url))
host))
- (path (url-filename parsed-url)))
- (when (and (string= "@" (substring buffer-text 0 1))
- ;; don't error on domain only url (rare):
- (not (string= "" path))
- (string= (downcase buffer-text)
- (downcase (substring path 1))))
- (if local-p
- buffer-text ; no instance suffix for local mention
- (concat buffer-text "@" host)))))
+ (path-raw (url-filename parsed-url)))
+ (unless (string-empty-p path-raw)
+ (let ((path (substring path-raw 1))) ;; remove "/" prefix
+ (if (not buffer-text)
+ (when (string-prefix-p "@" path)
+ (if local-p path (concat "@" host)))
+ (when (and (string= "@" (substring buffer-text 0 1))
+ ;; don't error on domain only url (rare):
+ (string= (downcase buffer-text)
+ (downcase path)))
+ (if local-p
+ buffer-text ; no instance suffix for local mention
+ (concat buffer-text "@" host))))))))
(defun mastodon-tl--hashtag-from-url (url instance-url)
"Return the hashtag that URL points to or nil if URL is not a tag link.
@@ -1399,18 +1424,103 @@ SENSITIVE is a flag from the item's JSON data."
help-echo
(concat help-echo "\nC-RET: play " type " with
mpv"))))
-(defun mastodon-tl-view-full-image ()
+;;; FULL IMAGE VIEW
+
+(define-derived-mode mastodon-image-mode image-mode
+ "mastodon-image"
+ :group 'mastodon)
+
+;; patch `shr-browse-image' to accept url arg:
+(defun mastodon-tl-shr-browse-image (&optional image-url copy-url)
+ "Browse the image under point.
+If COPY-URL (the prefix if called interactively) is non-nil, copy
+the URL of the image to the kill buffer instead.
+Optionally use IMAGE-URL rather than the image-url property at point."
+ (interactive "sP")
+ (let ((url (or image-url (get-text-property (point) 'image-url))))
+ (cond
+ ((not url)
+ (message "No image under point"))
+ (copy-url
+ (with-temp-buffer
+ (insert url)
+ (copy-region-as-kill (point-min) (point-max))
+ (message "Copied %s" url)))
+ (t
+ (message "Browsing %s..." url)
+ (browse-url url)))))
+
+(defun mastodon-tl--view-image-url (url attachments)
+ "View image URL. Set ATTACHMENTS metadata in image buffer."
+ (if (not url)
+ (user-error "No url found")
+ (if (not mastodon-tl--load-full-sized-images-in-emacs)
+ (mastodon-tl-shr-browse-image url)
+ (mastodon-media--image-or-cached
+ url #'mastodon-media--process-full-sized-image-response
+ `(nil ,url ,attachments ,(buffer-name))))))
+
+(defun mastodon-tl-view-full-image-at-point ()
"Browse full-sized version of image at point in a new window."
(interactive)
(if (not (eq (mastodon-tl--property 'mastodon-tab-stop) 'image))
(user-error "No image at point?")
- (let* ((url (mastodon-tl--property 'image-url)))
- (if (not mastodon-tl--load-full-sized-images-in-emacs)
- (shr-browse-image)
- (mastodon-media--image-or-cached
- url
- #'mastodon-media--process-full-sized-image-response
- `(nil ,url))))))
+ (let* ((url (mastodon-tl--property 'image-url))
+ (attachments (mastodon-tl--property 'attachments)))
+ (mastodon-tl--view-image-url url attachments))))
+
+(defun mastodon-tl-view-first-full-image ()
+ "From item byline, fetch load its first full image."
+ (interactive)
+ (let* ((attachments (mastodon-tl--property 'attachments))
+ (url (plist-get (car attachments) :url)))
+ (if (not attachments)
+ (user-error "Toot has no attachments")
+ (mastodon-tl--view-image-url url attachments))))
+
+(defun mastodon-tl--get-next-image-url ()
+ "Return the url for the next image to load.
+Cycles through values in `mastodon-media--attachments'."
+ (let* ((url (car mastodon-media--attachments))
+ ;; match url against our plists:
+ (current (mastodon-tl--current-image-url url)))
+ ;; fetch from next item in current or use first item if current has
+ ;; only 1 item:
+ (plist-get (if (= 1 (length current))
+ (cadr mastodon-media--attachments)
+ (cadr current))
+ :url)))
+
+(defun mastodon-tl--current-image-url (url)
+ "Try to fetch URL from `mastodon-media--attachments'.
+The return value is that of `cl-member-if', ie if a match is found, it
+returns the match and the list of which it is the car."
+ (cl-member-if
+ (lambda (attachment)
+ (equal url (plist-get attachment :url)))
+ (cdr mastodon-media--attachments)))
+
+(defun mastodon-tl--get-prev-image-url ()
+ "Return the URL of the previous item in `mastodon-media--attachments'."
+ (let* ((url (car mastodon-media--attachments))
+ (current (mastodon-tl--current-image-url url)))
+ (plist-get (nth (1- (length current))
+ (cdr mastodon-media--attachments))
+ :url)))
+
+(defun mastodon-tl-next-full-image ()
+ "From full image view buffer, load the toot's next image."
+ (interactive)
+ (let* ((next-url (mastodon-tl--get-next-image-url)))
+ (mastodon-tl--view-image-url next-url
+ (cdr mastodon-media--attachments))))
+
+(defun mastodon-tl-prev-full-image ()
+ "From full image view buffer, load the toot's prev image."
+ (interactive)
+ (let* ((prev-url (mastodon-tl--get-prev-image-url)))
+ (mastodon-tl--view-image-url prev-url
+ (cdr mastodon-media--attachments))))
(defun mastodon-tl-toggle-sensitive-image ()
"Toggle dislay of sensitive image at point."
@@ -1455,7 +1565,9 @@ LENGTH is of the longest option, for formatting."
(let* ((options (mastodon-tl--map-alist 'title .options))
(longest (car (sort (mapcar #'length options ) #'>)))
(counter 0))
- (concat "\nPoll: \n\n"
+ (concat "\n"
+ (mastodon-tl--symbol 'poll)
+ "\n\n"
(mapconcat (lambda (option)
(setq counter (1+ counter))
(mastodon-tl--format-poll-option
@@ -1612,7 +1724,7 @@ OPTIONS is an alist."
(interactive "d")
(if (mastodon-tl--media-video-p)
(mastodon-tl-mpv-play-video-at-point)
- (mastodon-tl-view-full-image)))
+ (mastodon-tl-view-full-image-at-point)))
(defun mastodon-tl-click-image-or-video (event)
"Click to play video with `mpv.el'.
@@ -2180,6 +2292,18 @@ call this function after it is set or use something
else."
This includes the update profile note buffer, but not the preferences one."
(string-prefix-p "accounts" (mastodon-tl--endpoint nil :no-error)))
+(defun mastodon-tl--own-profile-buffer-p ()
+ "Return t if we are viewing our own profile buffer.
+We check that our account credientials id matches the endpoint id in the
+buffer spec, which if in a profile buffer is of the form
+\"accounts/$id/statuses\"."
+ (and (mastodon-tl--profile-buffer-p)
+ (let ((endpoint-id
+ (nth 1
+ (split-string (mastodon-tl--endpoint) "/"))))
+ (string= (mastodon-auth--get-account-id)
+ endpoint-id))))
+
(defun mastodon-tl--search-buffer-p ()
"T if current buffer is a search buffer."
(string-suffix-p "search" (mastodon-tl--endpoint nil :no-error)))
@@ -2491,7 +2615,7 @@ ID is that of the post the context is currently displayed
for."
;;; FOLLOW/BLOCK/MUTE, ETC
(defun mastodon-tl-follow-user (user-handle
- &optional notify langs reblogs json)
+ &optional notify langs reblogs json)
"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.
@@ -2505,6 +2629,32 @@ JSON is a flag arg for `mastodon-http--post'."
(mastodon-tl--do-user-action-and-response
user-handle "follow" nil notify langs reblogs json)))
+(defun mastodon-tl-follow-user-by-handle (user-handle)
+ "Prompt for a USER-HANDLE and follow that user.
+USER-HANDLE can also be a URL to a user profile page."
+ ;; code adapted from sachac:
+ ;; https://sachachua.com/dotemacs/index.html#mastodon. thanks sachac!
+ (interactive "MHandle: ")
+ (when (string-match "https?://\\(.+?\\)/\\(@.+\\)" user-handle)
+ (setq user-handle
+ ;; sachac's model doesn't work with local user handles in URL,
+ ;; meaning the search below will fail, so we use our own
+ ;; URL-to-handle function, modified for the purpose:
+ ;; (concat (match-string 2 user-handle) "@" (match-string 1
user-handle))))
+ (mastodon-tl--userhandle-from-url user-handle)))
+ (let* ((account (mastodon-profile--search-account-by-handle
+ user-handle))
+ (user-id (alist-get 'id account))
+ (name (if (not (string-empty-p
+ (alist-get 'display_name account)))
+ (alist-get 'display_name account)
+ (alist-get 'username account)))
+ (url (mastodon-http--api (format "accounts/%s/%s" user-id "follow"))))
+ (if account
+ (mastodon-tl--do-user-action-function url name
+ (substring user-handle 1)
"follow")
+ (user-error "Cannot find a user with handle %S" user-handle))))
+
;; TODO: make this action "enable/disable notifications"
(defun mastodon-tl-enable-notify-user-posts (user-handle)
"Query for USER-HANDLE and enable notifications when they post."
@@ -2974,6 +3124,13 @@ report the account for spam."
;;; UPDATING, etc.
+(defun mastodon-tl--no-json (json)
+ "Nil if JSON is nil or empty group notif data."
+ (if (and (mastodon-tl--buffer-type-eq 'notifications)
+ mastodon-group-notifications)
+ (mastodon-notifications--empty-group-json-p json)
+ (not json)))
+
(defun mastodon-tl--more-json (endpoint id)
"Return JSON for timeline ENDPOINT before ID."
(let* ((args `(("max_id" . ,(mastodon-tl--as-string id))))
@@ -3021,13 +3178,14 @@ Then run CALLBACK with arguments CBARGS."
(setf (alist-get "offset" params nil nil #'string=) offset)
(apply #'mastodon-http--get-json-async url params callback cbargs)))
-(defun mastodon-tl--updated-json (endpoint id &optional params)
+(defun mastodon-tl--updated-json (endpoint id &optional params version)
"Return JSON for timeline ENDPOINT since ID.
PARAMS is used to send any parameters needed to correctly update
-the current view."
+the current view.
+VERSION is the API version to use, as grouped notifs use v2."
(let* ((args `(("since_id" . ,(mastodon-tl--as-string id))))
(args (append args params))
- (url (mastodon-http--api endpoint)))
+ (url (mastodon-http--api endpoint version)))
(mastodon-http--get-json url args)))
;; TODO: add this to new posts in some cases, e.g. in thread view.
@@ -3169,7 +3327,7 @@ MAX-ID is the pagination parameter, a string."
(mastodon-tl--thread-do)
(goto-char point-before)
(message "Loaded full thread."))
- (if (not json)
+ (if (mastodon-tl--no-json json)
(user-error "No more results")
(if notifs-p
(mastodon-notifications--timeline json notif-type :update)
@@ -3361,27 +3519,34 @@ This location is defined by a non-nil value of
(user-error "Update not available in this view")
;; FIXME: handle update for search and trending buffers
(let* ((endpoint (mastodon-tl--endpoint))
- (update-function (mastodon-tl--update-function))
+ (update-fun (mastodon-tl--update-function))
(id (mastodon-tl--newest-id)))
;; update a thread, without calling `mastodon-tl--updated-json':
(if (mastodon-tl--buffer-type-eq 'thread)
;; load whole thread:
(progn (mastodon-tl--thread-do id)
(message "Loaded full thread."))
- ;; update other timelines:
- (let* ((params (mastodon-tl--update-params))
- (json (mastodon-tl--updated-json endpoint id params)))
- (if (not json)
- (user-error "Nothing to update")
- (let ((inhibit-read-only t))
- (mastodon-tl--set-after-update-marker)
- (goto-char (or mastodon-tl--update-point (point-min)))
- (if (eq update-function 'mastodon-notifications--timeline)
- (funcall update-function json nil :update)
- (funcall update-function json))
- (if mastodon-tl--after-update-marker
- (goto-char mastodon-tl--after-update-marker)
- (mastodon-tl-goto-next-item)))))))))
+ (if (not id) ;; if e.g. notifs all cleared:
+ (user-error "No last id")
+ ;; update other timelines:
+ (let* ((params (mastodon-tl--update-params))
+ (notifs-p
+ (eq update-fun 'mastodon-notifications--timeline))
+ (json (mastodon-tl--updated-json
+ endpoint id params
+ (when (and notifs-p mastodon-group-notifications)
+ "v2"))))
+ (if (mastodon-tl--no-json json)
+ (user-error "Nothing to update")
+ (let ((inhibit-read-only t))
+ (mastodon-tl--set-after-update-marker)
+ (goto-char (or mastodon-tl--update-point (point-min)))
+ (if notifs-p
+ (funcall update-fun json nil :update)
+ (funcall update-fun json))
+ (if mastodon-tl--after-update-marker
+ (goto-char mastodon-tl--after-update-marker)
+ (mastodon-tl-goto-next-item))))))))))
;;; LOADING TIMELINES
diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index 83c4d9be36..9ebb1ef0c7 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -106,6 +106,7 @@
(autoload 'mastodon-tl--image-trans-check "mastodon-tl")
(autoload 'mastodon-instance-data "mastodon")
(autoload 'mastodon-create-poll "mastodon-transient")
+(autoload 'mastodon-tl--own-profile-buffer-p "mastodon-tl")
;; for mastodon-toot-translate-toot-text
(autoload 'mastodon-tl--content "mastodon-tl")
@@ -647,11 +648,13 @@ Uses `lingva.el'."
(if (not pinnable-p)
(user-error "You can only pin your own toots")
(when (y-or-n-p (format "%s this toot? " (capitalize action)))
- (mastodon-toot--action action
- (lambda (_)
- (when mastodon-tl--buffer-spec
- (mastodon-tl--reload-timeline-or-profile))
- (message "Toot %s!" msg)))))))
+ (mastodon-toot--action
+ action
+ (lambda (_)
+ ;; let's only reload when in own profile view:
+ (when (mastodon-tl--own-profile-buffer-p)
+ (mastodon-tl--reload-timeline-or-profile))
+ (message "Toot %s!" msg)))))))
;;; DELETE, DRAFT, REDRAFT
diff --git a/lisp/mastodon.el b/lisp/mastodon.el
index aefdc67786..1e973d78de 100644
--- a/lisp/mastodon.el
+++ b/lisp/mastodon.el
@@ -6,8 +6,8 @@
;; Author: Johnson Denen <johnson.de...@gmail.com>
;; Marty Hiatt <mouse...@disroot.org>
;; Maintainer: Marty Hiatt <mouse...@disroot.org>
-;; Version: 1.1.12
-;; Package-Requires: ((emacs "28.1") (request "0.3.0") (persist "0.4") (tp
"0.7"))
+;; Version: 2.0.0
+;; Package-Requires: ((emacs "28.1") (persist "0.4") (tp "0.7"))
;; Homepage: https://codeberg.org/martianh/mastodon.el
;; This file is not part of GNU Emacs.
@@ -105,7 +105,12 @@
(defvar mastodon-tl--highlight-current-toot)
(defvar mastodon-notifications--map)
-(defvar mastodon-notifications-grouped-types)
+(defvar mastodon-client--token-file)
+
+(defvar mastodon-notifications-grouped-types
+ '("reblog" "favourite") ;; TODO: implement follow!
+ "List of notification types for which grouping is implemented.
+Used in `mastodon-notifications-get'")
(defgroup mastodon nil
"Interface with Mastodon."
@@ -191,6 +196,23 @@ and X others...\"."
(interactive)
(quit-window 'kill))
+(defvar mastodon-client--active-user-details-plist)
+(defvar mastodon-auth--token-alist)
+
+;;;###autoload
+(defun mastodon-forget-all-logins ()
+ "Delete `mastodon-client--token-file'.
+Also nil `mastodon-auth--token-alist'."
+ (interactive)
+ (when (y-or-n-p "Remove all saved login data?")
+ (if (not (file-exists-p mastodon-client--token-file))
+ (message "No plstore file")
+ (delete-file mastodon-client--token-file)
+ (message "File %s deleted." mastodon-client--token-file))
+ ;; nil some vars too:
+ (setq mastodon-client--active-user-details-plist nil)
+ (setq mastodon-auth--token-alist nil)))
+
(defvar mastodon-mode-map
(let ((map (make-sparse-keymap)))
;; navigation inside a timeline
@@ -236,6 +258,7 @@ and X others...\"."
(define-key map (kbd "T") #'mastodon-tl-thread)
(define-key map (kbd "RET") #'mastodon-tl-thread)
(define-key map (kbd "m") #'mastodon-tl-dm-user)
+ (define-key map (kbd "=") #'mastodon-tl-view-first-full-image)
(when (require 'lingva nil :no-error)
(define-key map (kbd "a") #'mastodon-toot-translate-toot-text))
(define-key map (kbd ",") #'mastodon-toot-list-favouriters)
diff --git a/mastodon-index.org b/mastodon-index.org
index 7f0023ae5c..b10b4a45e1 100644
--- a/mastodon-index.org
+++ b/mastodon-index.org
@@ -55,6 +55,7 @@
| C-M-q | mastodon-kill-all-buffers | Kill
any and all open mastodon buffers, hopefully. |
| Q | mastodon-kill-window | Quit
window and delete helper. |
| | mastodon-mode | Major
mode for fediverse services using the Mastodon API. |
+| | mastodon-forget-all-logins | Delete
`mastodon-client--token-file'. |
| | mastodon-notifications-clear-all | Clear
all notifications. |
| C-k | mastodon-notifications-clear-current |
Dismiss the notification at point. |
| | mastodon-notifications-cycle-type | Cycle
the current notifications view. |
@@ -135,6 +136,7 @@
| ! | mastodon-tl-fold-post-toggle | Toggle
the folding status of the toot at point. |
| | mastodon-tl-follow-tag | Prompt
for a tag (from post at point) and follow it. |
| W | mastodon-tl-follow-user | Query
for USER-HANDLE from current status and follow that user. |
+| | mastodon-tl-follow-user-by-handle | Prompt
for a USER-HANDLE and follow that user. |
| | mastodon-tl-follow-user-disable-boosts | Prompt
for a USER-HANDLE, and disable display of boosts in home timeline. |
| | mastodon-tl-follow-user-enable-boosts | Prompt
for a USER-HANDLE, and enable display of boosts in home timeline. |
| ' | mastodon-tl-followed-tags-timeline | Open a
timeline of multiple tags. |
@@ -150,12 +152,15 @@
| | mastodon-tl-mpv-play-video-from-byline | Run
`mastodon-tl-mpv-play-video-at-point' on first moving image in post. |
| | mastodon-tl-mute-thread | Mute
the thread displayed in the current buffer. |
| M | mastodon-tl-mute-user | Query
for USER-HANDLE from current status and mute that user. |
+| | mastodon-tl-next-full-image | From
full image view buffer, load the toot's next image. |
| TAB, M-n | mastodon-tl-next-tab-item | Move
to the next interesting item. |
| v | mastodon-tl-poll-vote | If
there is a poll at point, prompt user for OPTION to vote on it. |
+| | mastodon-tl-prev-full-image | From
full image view buffer, load the toot's prev image. |
| S-TAB, <backtab> | mastodon-tl-previous-tab-item | Move
to the previous interesting item. |
| | mastodon-tl-remote-tag-timeline | Call
`mastodon-tl-get-remote-local-timeline' but for a TAG timeline. |
| Z | mastodon-tl-report-to-mods | Report
the author of the toot at point to your instance moderators. |
| SPC | mastodon-tl-scroll-up-command | Call
`scroll-up-command', loading more toots if necessary. |
+| | mastodon-tl-shr-browse-image | Browse
the image under point. |
| | mastodon-tl-single-toot | View
toot at point in separate buffer. |
| | mastodon-tl-some-followed-tags-timeline | Prompt
for some tags, and open a timeline for them. |
| C-' | mastodon-tl-tag-group-timeline | Load a
timeline of a tag group from `mastodon-tl--tags-groups'. |
@@ -172,7 +177,8 @@
| | mastodon-tl-unmute-thread | Unmute
the thread displayed in the current buffer. |
| S-RET | mastodon-tl-unmute-user | Query
for USER-HANDLE from list of muted users and unmute that user. |
| u, g | mastodon-tl-update | Update
timeline with new toots. |
-| | mastodon-tl-view-full-image | Browse
full-sized version of image at point in a new window. |
+| = | mastodon-tl-view-first-full-image | From
item byline, fetch load its first full image. |
+| | mastodon-tl-view-full-image-at-point | Browse
full-sized version of image at point in a new window. |
| | mastodon-tl-view-full-image-or-play-video | View
full sized version of image at point, or try to play video. |
| | mastodon-tl-view-item-on-own-instance | Load
current toot on your own instance. |
| | mastodon-tl-view-whole-thread | From a
thread view, view entire thread. |
@@ -274,53 +280,54 @@
#+end_src
#+RESULTS:
-| Custom variable | Description
|
-|----------------------------------------------------+-------------------------------------------------------------------------------|
-| mastodon-active-user | Username of the active
user. |
-| mastodon-client--token-file | File path where
Mastodon access tokens are stored. |
-| mastodon-group-notifications | Whether to use grouped
notifications. |
-| mastodon-images-in-notifs | Whether to display
attached images in notifications. |
-| mastodon-instance-url | Base URL for the
fediverse instance you want to be active. |
-| mastodon-media--avatar-height | Height of the user
avatar images (if shown). |
-| mastodon-media--enable-image-caching | Whether images should
be cached. |
-| mastodon-media--hide-sensitive-media | Whether media marked as
sensitive should be hidden. |
-| mastodon-media--preview-max-height | Max height of any media
attachment preview to be shown in timelines. |
-| mastodon-mode-hook | Hook run when entering
Mastodon mode. |
-| mastodon-notifications-grouped-names-count | The number of
notification authors to display. |
-| mastodon-profile-mode-hook | Hook run after entering
or leaving `mastodon-profile-mode'. |
-| mastodon-profile-note-in-foll-reqs | If non-nil, show a
user's profile note in follow request notifications. |
-| mastodon-profile-note-in-foll-reqs-max-length | The max character
length for user profile note in follow requests. |
-| mastodon-profile-update-mode-hook | Hook run after entering
or leaving `mastodon-profile-update-mode'. |
-| mastodon-search-mode-hook | Hook run after entering
or leaving `mastodon-search-mode'. |
-| mastodon-tl--display-caption-not-url-when-no-media | Display an image's
caption rather than URL. |
-| mastodon-tl--display-media-p | A boolean value stating
whether to show media in timelines. |
-| mastodon-tl--enable-proportional-fonts | Nonnil to enable using
proportional fonts when rendering HTML. |
-| mastodon-tl--enable-relative-timestamps | Whether to show
relative (to the current time) timestamps. |
-| mastodon-tl--expand-content-warnings | Whether to expand
content warnings by default. |
-| mastodon-tl--fold-toots-at-length | Length, in characters,
to fold a toot at. |
-| mastodon-tl--hide-replies | Whether to hide replies
from the timelines. |
-| mastodon-tl--highlight-current-toot | Whether to highlight
the toot at point. Uses `cursor-face' special property. |
-| mastodon-tl--load-full-sized-images-in-emacs | Whether to load
full-sized images inside Emacs. |
-| mastodon-tl--no-fill-on-render | Non-nil to disable
filling by shr.el while rendering toot body. |
-| mastodon-tl--remote-local-domains | A list of domains to
view the local timelines of. |
-| mastodon-tl--show-avatars | Whether to enable
display of user avatars in timelines. |
-| mastodon-tl--show-stats | Whether to show toot
stats (faves, boosts, replies counts). |
-| mastodon-tl--symbols | A set of symbols (and
fallback strings) to be used in timeline. |
+| Custom variable | Description
|
+|----------------------------------------------------+------------------------------------------------------------------------------|
+| mastodon-active-user | Username of the active
user. |
+| mastodon-auth-use-auth-source | Whether to use auth
sources for user credentials. |
+| mastodon-client--token-file | File path where
Mastodon access tokens are stored. |
+| mastodon-group-notifications | Whether to use grouped
notifications. |
+| mastodon-images-in-notifs | Whether to display
attached images in notifications. |
+| mastodon-instance-url | Base URL for the
fediverse instance you want to be active. |
+| mastodon-media--avatar-height | Height of the user
avatar images (if shown). |
+| mastodon-media--enable-image-caching | Whether images should
be cached. |
+| mastodon-media--hide-sensitive-media | Whether media marked as
sensitive should be hidden. |
+| mastodon-media--preview-max-height | Max height of any media
attachment preview to be shown in timelines. |
+| mastodon-mode-hook | Hook run when entering
Mastodon mode. |
+| mastodon-notifications-grouped-names-count | The number of
notification authors to display. |
+| mastodon-profile-mode-hook | Hook run after entering
or leaving `mastodon-profile-mode'. |
+| mastodon-profile-note-in-foll-reqs | If non-nil, show a
user's profile note in follow request notifications. |
+| mastodon-profile-note-in-foll-reqs-max-length | The max character
length for user profile note in follow requests. |
+| mastodon-profile-update-mode-hook | Hook run after entering
or leaving `mastodon-profile-update-mode'. |
+| mastodon-search-mode-hook | Hook run after entering
or leaving `mastodon-search-mode'. |
+| mastodon-tl--display-caption-not-url-when-no-media | Display an image's
caption rather than URL. |
+| mastodon-tl--display-media-p | A boolean value stating
whether to show media in timelines. |
+| mastodon-tl--enable-proportional-fonts | Nonnil to enable using
proportional fonts when rendering HTML. |
+| mastodon-tl--enable-relative-timestamps | Whether to show
relative (to the current time) timestamps. |
+| mastodon-tl--expand-content-warnings | Whether to expand
content warnings by default. |
+| mastodon-tl--fold-toots-at-length | Length, in characters,
to fold a toot at. |
+| mastodon-tl--hide-replies | Whether to hide replies
from the timelines. |
+| mastodon-tl--highlight-current-toot | Whether to highlight
the toot at point. Uses `cursor-face' special property. |
+| mastodon-tl--load-full-sized-images-in-emacs | Whether to load
full-sized images inside Emacs. |
+| mastodon-tl--no-fill-on-render | Non-nil to disable
filling by shr.el while rendering toot body. |
+| mastodon-tl--remote-local-domains | A list of domains to
view the local timelines of. |
+| mastodon-tl--show-avatars | Whether to enable
display of user avatars in timelines. |
+| mastodon-tl--show-stats | Whether to show toot
stats (faves, boosts, replies counts). |
+| mastodon-tl--symbols | A set of symbols (and
fallback strings) to be used in timeline. |
| mastodon-tl--tag-timeline-tags | A list of up to four
tags for use with `mastodon-tl-followed-tags-timeline'. |
-| mastodon-tl--tags-groups | A list containing lists
of up to four tags each. |
-| mastodon-tl--timeline-posts-count | Number of posts to
display when loading a timeline. |
-| mastodon-tl-position-after-update | Defines where `point'
should be located after a timeline update. |
-| mastodon-toot--attachment-height | Height of the attached
images preview in the toot draft buffer. |
-| mastodon-toot--completion-style-for-mentions | The company completion
style to use for mentions. |
-| mastodon-toot--default-media-directory | The default directory
when prompting for a media file to upload. |
-| mastodon-toot--default-reply-visibility | Default visibility
settings when replying. |
-| mastodon-toot--enable-completion | Whether to enable
completion of mentions and hashtags. |
-| mastodon-toot--enable-custom-instance-emoji | Whether to enable your
instance's custom emoji by default. |
-| mastodon-toot--proportional-fonts-compose | Nonnil to enable using
proportional fonts in the compose buffer. |
-| mastodon-toot--use-company-for-completion | Whether to enable
company for completion. |
-| mastodon-toot-display-orig-in-reply-buffer | Display a copy of the
toot replied to in the compose buffer. |
-| mastodon-toot-mode-hook | Hook run after entering
or leaving `mastodon-toot-mode'. |
-| mastodon-toot-orig-in-reply-length | Length to crop toot
replied to in the compose buffer to. |
-| mastodon-toot-poll-use-transient | Whether to use the
transient menu to create a poll. |
-| mastodon-toot-timestamp-format | Format to use for
timestamps. |
-| mastodon-use-emojify | Whether to use
emojify.el to display emojis. |
+| mastodon-tl--tags-groups | A list containing lists
of up to four tags each. |
+| mastodon-tl--timeline-posts-count | Number of posts to
display when loading a timeline. |
+| mastodon-tl-position-after-update | Defines where `point'
should be located after a timeline update. |
+| mastodon-toot--attachment-height | Height of the attached
images preview in the toot draft buffer. |
+| mastodon-toot--completion-style-for-mentions | The company completion
style to use for mentions. |
+| mastodon-toot--default-media-directory | The default directory
when prompting for a media file to upload. |
+| mastodon-toot--default-reply-visibility | Default visibility
settings when replying. |
+| mastodon-toot--enable-completion | Whether to enable
completion of mentions and hashtags. |
+| mastodon-toot--enable-custom-instance-emoji | Whether to enable your
instance's custom emoji by default. |
+| mastodon-toot--proportional-fonts-compose | Nonnil to enable using
proportional fonts in the compose buffer. |
+| mastodon-toot--use-company-for-completion | Whether to enable
company for completion. |
+| mastodon-toot-display-orig-in-reply-buffer | Display a copy of the
toot replied to in the compose buffer. |
+| mastodon-toot-mode-hook | Hook run after entering
or leaving `mastodon-toot-mode'. |
+| mastodon-toot-orig-in-reply-length | Length to crop toot
replied to in the compose buffer to. |
+| mastodon-toot-poll-use-transient | Whether to use the
transient menu to create a poll. |
+| mastodon-toot-timestamp-format | Format to use for
timestamps. |
+| mastodon-use-emojify | Whether to use
emojify.el to display emojis. |
diff --git a/test/mastodon-auth-tests.el b/test/mastodon-auth-tests.el
index af410364cb..5ce9910534 100644
--- a/test/mastodon-auth-tests.el
+++ b/test/mastodon-auth-tests.el
@@ -75,3 +75,39 @@
(with-mock
(mock (mastodon-client--active-user))
(should-error (mastodon-auth--access-token)))))
+
+(ert-deftest mastodon-auth-plstore-token-check ()
+ (let ((mastodon-instance-url "https://mastodon.example";)
+ (mastodon-active-user "test8000")
+ (user-details ;; order changed for new encrypted auth flow:
+ '( :client_id "id" :client_secret "secret"
+ :access_token "token"
+ :username "test8000@mastodon.example"
+ :instance "https://mastodon.example";))
+ ;; save token to plstore encrypted:
+ (mastodon-auth-use-auth-source nil)) ;; FIXME: test auth source
+ ;; setup plstore: store access token
+ (with-mock
+ (mock (mastodon-client) => '(:client_id "id" :client_secret "secret"))
+ (mock (mastodon-client--token-file) => "stubfile.plstore")
+ (should
+ (equal (mastodon-client--store-access-token "token")
+ user-details))
+ ;; should non-nil if we check with auth-source:
+ ;; because we saved with non auth-source:
+ (should
+ (equal
+ (let ((mastodon-auth-use-auth-source t))
+ (mastodon-auth--plstore-access-token-member :auth-source))
+ '(:secret-access_token t :username "test8000@mastodon.example"
+ :instance "https://mastodon.example";)))
+ ;; should nil if we don't check with auth source:
+ (should
+ (equal
+ (mastodon-auth--plstore-access-token-member)
+ nil)))
+ ;; FIXME: ideally we would also mock up a non-encrypted plstore and
+ ;; test against it too, as that's the work we really want
+ ;; `mastodon-auth--plstore-access-token-member' to do
+ ;; but we don't currently have a way to mock one up.
+ (delete-file "stubfile.plstore")))
diff --git a/test/mastodon-client-tests.el b/test/mastodon-client-tests.el
index b302ed6e5b..83dc106d48 100644
--- a/test/mastodon-client-tests.el
+++ b/test/mastodon-client-tests.el
@@ -1,6 +1,8 @@
;;; mastodon-client-test.el --- Tests for mastodon-client.el -*-
lexical-binding: nil -*-
(require 'el-mock)
+(require 'mastodon-client)
+(require 'mastodon-http)
(ert-deftest mastodon-client--register ()
"Should POST to /apps."
@@ -19,19 +21,22 @@
"Should return client registration JSON."
(with-temp-buffer
(with-mock
- (mock (mastodon-client--register) => (progn
- (insert "\n\n{\"foo\":\"bar\"}")
- (current-buffer)))
- (should (equal (mastodon-client--fetch) '(:foo "bar"))))))
-
+ (mock (mastodon-client--register) => (progn
+ (insert "\n\n{\"foo\":\"bar\"}")
+ (current-buffer)))
+ (should (equal (mastodon-client--fetch) '(:foo "bar"))))))
+
+;; FIXME: broken by new encrypted plstore flow
+;; (asks for gpg passphrase)
+;; otherwise test passes
(ert-deftest mastodon-client--store ()
"Test the value `mastodon-client--store' returns/stores."
(let ((mastodon-instance-url "http://mastodon.example";)
(plist '(:client_id "id" :client_secret "secret")))
(with-mock
- (mock (mastodon-client--token-file) => "stubfile.plstore")
- (mock (mastodon-client--fetch) => plist)
- (should (equal (mastodon-client--store) plist)))
+ (mock (mastodon-client--token-file) => "stubfile.plstore")
+ (mock (mastodon-client--fetch) => plist)
+ (should (equal (mastodon-client--store) plist)))
(let* ((plstore (plstore-open "stubfile.plstore"))
(client (mastodon-client--remove-key-from-plstore
(plstore-get plstore "mastodon-http://mastodon.example";))))
@@ -40,48 +45,47 @@
;; clean up - delete the stubfile
(delete-file "stubfile.plstore"))))
-
(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 mastodon-client--general-read-finds-match ()
(with-mock
- (mock (mastodon-client--token-file) => "fixture/client.plstore")
- (should (equal (mastodon-client--general-read
"user-test8000@mastodon.example")
- '(:username "test8000@mastodon.example"
- :instance "http://mastodon.example";
- :client_id "id2" :client_secret "secret2"
- :access_token "token2")))))
+ (mock (mastodon-client--token-file) => "fixture/client.plstore")
+ (should (equal (mastodon-client--general-read
"user-test8000@mastodon.example")
+ '(:username "test8000@mastodon.example"
+ :instance "http://mastodon.example";
+ :client_id "id2" :client_secret "secret2"
+ :access_token "token2")))))
(ert-deftest mastodon-client--general-read-finds-no-match ()
(with-mock
- (mock (mastodon-client--token-file) => "fixture/client.plstore")
- (should (equal (mastodon-client--general-read "nonexistant-key")
- nil))))
+ (mock (mastodon-client--token-file) => "fixture/client.plstore")
+ (should (equal (mastodon-client--general-read "nonexistant-key")
+ nil))))
(ert-deftest mastodon-client--general-read-empty-store ()
(with-mock
- (mock (mastodon-client--token-file) => "fixture/empty.plstore")
- (should (equal (mastodon-client--general-read "something")
- nil))))
+ (mock (mastodon-client--token-file) => "fixture/empty.plstore")
+ (should (equal (mastodon-client--general-read "something")
+ nil))))
(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 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))))
+ (mock (mastodon-client--token-file) => "fixture/empty.plstore")
+ (should (equal (mastodon-client--read) nil))))
(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."
@@ -95,32 +99,32 @@
(let ((mastodon-instance-url "http://mastodon.example";)
(mastodon-client--client-details-alist '(("http://other.example";
:wrong))))
(with-mock
- (mock (mastodon-client--read) => '(:client_id "foo" :client_secret
"bar"))
- (should (equal (mastodon-client) '(:client_id "foo" :client_secret
"bar")))
- (should (equal mastodon-client--client-details-alist
- '(("http://mastodon.example"; :client_id "foo"
:client_secret "bar")
- ("http://other.example"; :wrong)))))))
+ (mock (mastodon-client--read) => '(:client_id "foo" :client_secret "bar"))
+ (should (equal (mastodon-client) '(:client_id "foo" :client_secret
"bar")))
+ (should (equal mastodon-client--client-details-alist
+ '(("http://mastodon.example"; :client_id "foo"
:client_secret "bar")
+ ("http://other.example"; :wrong)))))))
(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))
(with-mock
- (mock (mastodon-client--read) => '(:client_id "foo" :client_secret
"bar"))
- (should (equal (mastodon-client) '(:client_id "foo" :client_secret
"bar")))
- (should (equal mastodon-client--client-details-alist
- '(("http://mastodon.example"; :client_id "foo"
:client_secret "bar")))))))
+ (mock (mastodon-client--read) => '(:client_id "foo" :client_secret "bar"))
+ (should (equal (mastodon-client) '(:client_id "foo" :client_secret
"bar")))
+ (should (equal mastodon-client--client-details-alist
+ '(("http://mastodon.example"; :client_id "foo"
:client_secret "bar")))))))
(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))
(with-mock
- (mock (mastodon-client--read))
- (mock (mastodon-client--store) => '(:client_id "foo" :client_secret
"baz"))
- (should (equal (mastodon-client) '(:client_id "foo" :client_secret
"baz")))
- (should (equal mastodon-client--client-details-alist
- '(("http://mastodon.example"; :client_id "foo"
:client_secret "baz")))))))
+ (mock (mastodon-client--read))
+ (mock (mastodon-client--store) => '(:client_id "foo" :client_secret
"baz"))
+ (should (equal (mastodon-client) '(:client_id "foo" :client_secret
"baz")))
+ (should (equal mastodon-client--client-details-alist
+ '(("http://mastodon.example"; :client_id "foo"
:client_secret "baz")))))))
(ert-deftest mastodon-client--form-user-from-vars ()
(let ((mastodon-active-user "test9000")
@@ -134,41 +138,54 @@
(mastodon-instance-url "https://mastodon.example";))
;; when the current user /is/ the active user
(with-mock
- (mock (mastodon-client--general-read "active-user") => '(:username
"test9000@mastodon.example" :client_id "id1"))
- (should (equal (mastodon-client--current-user-active-p)
- '(:username "test9000@mastodon.example" :client_id
"id1"))))
+ (mock (mastodon-client--general-read "active-user") => '(:username
"test9000@mastodon.example" :client_id "id1"))
+ (should (equal (mastodon-client--current-user-active-p)
+ '(:username "test9000@mastodon.example" :client_id
"id1"))))
;; when the current user is /not/ the active user
(with-mock
- (mock (mastodon-client--general-read "active-user") => '(:username
"user@other.example" :client_id "id1"))
- (should (null (mastodon-client--current-user-active-p))))))
+ (mock (mastodon-client--general-read "active-user") => '(:username
"user@other.example" :client_id "id1"))
+ (should (null (mastodon-client--current-user-active-p))))))
+;; FIXME: broken by new encrypted plstore flow
+;; (asks for gpg passphrase)
+;; otherwise test passes
(ert-deftest mastodon-client--store-access-token ()
(let ((mastodon-instance-url "https://mastodon.example";)
(mastodon-active-user "test8000")
- (user-details
- '(:username "test8000@mastodon.example"
- :instance "https://mastodon.example";
- :client_id "id" :client_secret "secret"
- :access_token "token")))
+ (user-details ;; order changed for new encrypted auth flow:
+ '( :client_id "id" :client_secret "secret"
+ :access_token "token"
+ :username "test8000@mastodon.example"
+ :instance "https://mastodon.example";))
+ (mastodon-auth-use-auth-source nil)) ;; FIXME: test auth source
;; test if mastodon-client--store-access-token /returns/ right
;; value
(with-mock
- (mock (mastodon-client) => '(:client_id "id" :client_secret "secret"))
- (mock (mastodon-client--token-file) => "stubfile.plstore")
- (should (equal (mastodon-client--store-access-token "token")
- user-details)))
+ (mock (mastodon-client) => '(:client_id "id" :client_secret "secret"))
+ (mock (mastodon-client--token-file) => "stubfile.plstore")
+ (should (equal (mastodon-client--store-access-token "token")
+ user-details)))
;; test if mastodon-client--store-access-token /stores/ right value
(with-mock
- (mock (mastodon-client--token-file) => "stubfile.plstore")
- (should (equal (mastodon-client--general-read
- "user-test8000@mastodon.example")
- user-details)))
+ (mock (mastodon-client--token-file) => "stubfile.plstore")
+ (should (equal (mastodon-client--general-read
+ "user-test8000@mastodon.example")
+ user-details)))
(delete-file "stubfile.plstore")))
+;; FIXME: broken by new encrypted plstore flow
+;; (asks for gpg passphrase)
+;; otherwise test passes
(ert-deftest mastodon-client--make-user-active ()
- (let ((user-details '(:username "test@mastodon.example")))
+ ;; match new encrypted plstore return value:
+ (let ((user-details '( :access_token nil
+ :client_id nil
+ :client_secret nil
+ :username "test@mastodon.example"))
+ (mastodon-auth-use-auth-source nil)) ;; FIXME: test auth source
(with-mock
- (mock (mastodon-client--token-file) => "stubfile.plstore")
- (mastodon-client--make-user-active user-details)
- (should (equal (mastodon-client--general-read "active-user")
- user-details)))))
+ (mock (mastodon-client--token-file) => "stubfile.plstore")
+ (mastodon-client--make-user-active user-details)
+ (should (equal (mastodon-client--general-read "active-user")
+ user-details)))
+ (delete-file "stubfile.plstore")))
diff --git a/test/mastodon-http-tests.el b/test/mastodon-http-tests.el
index 9e0b413909..4bef0eefe7 100644
--- a/test/mastodon-http-tests.el
+++ b/test/mastodon-http-tests.el
@@ -61,28 +61,32 @@ Strict-Transport-Security: max-age=31536000
"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"))))
+ (with-mock
+ (mock (url-http-parse-response) => 200)
+ (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"))))
+ (with-mock
+ (mock (url-http-parse-response) => 444)
+ (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")))))
(ert-deftest mastodon-http-params-build ()
"Should correctly format parameters from an alist."
diff --git a/test/mastodon-toot-tests.el b/test/mastodon-toot-tests.el
index b01c36fca5..7d5da284e6 100644
--- a/test/mastodon-toot-tests.el
+++ b/test/mastodon-toot-tests.el
@@ -209,6 +209,7 @@ mention string."
(toot mastodon-toot-test-base-toot)
(id 61208))
(with-mock
+ (mock (url-http-parse-response) => 200)
(mock (mastodon-tl--property 'base-item-id) => id)
(mock (mastodon-http--api "statuses/61208/pin")
=> "https://example.space/statuses/61208/pin";)
