diff options
Diffstat (limited to 'pearl.el')
| -rw-r--r-- | pearl.el | 347 |
1 files changed, 304 insertions, 43 deletions
@@ -62,6 +62,7 @@ (require 'org) (require 'cl-lib) (require 'transient) +(require 'auth-source) ;;; Customization and Variables (defgroup pearl nil @@ -101,6 +102,34 @@ Defaults to \\='gtd/linear.org\\=' in your `org-directory'." :type 'file :group 'pearl) +(defcustom pearl-accounts nil + "Named Linear accounts for multi-workspace use. +An alist of (NAME . PLIST) where NAME is a string and PLIST carries the +per-workspace settings: + + :api-key-source how the key is *found* (not the key itself), a tagged + list -- one of (:auth-source :host H :user U), + (:env \"VAR\"), or (:literal \"lin_...\"). + :org-file the account's active org file (`~' is expanded). + :default-team-id default team for new issues; optional. + :url GraphQL endpoint; optional, defaults to + `pearl-graphql-url'. + +Leave nil for legacy single-account behavior off the standalone +`pearl-api-key' / `pearl-org-file-path' globals. See +`pearl-switch-account' and `pearl-default-account'." + :type '(alist :key-type string :value-type plist) + :group 'pearl) + +(defcustom pearl-default-account nil + "Name of the account `pearl-active-account' resolves to at first need. +A durable preference (unlike the runtime `pearl-active-account'). When +`pearl-accounts' is set and no account is active yet, the first command that +needs account context resolves this name; if it is nil, that command errors +asking the user to set it or run `pearl-switch-account'." + :type '(choice (const :tag "None" nil) string) + :group 'pearl) + (defcustom pearl-async-default t "Use async API calls by default. When t, all API calls will be asynchronous unless explicitly overridden. @@ -373,6 +402,190 @@ Backs the comment-edit permission check; clear it to force a refresh.") (defvar pearl--active-requests 0 "Number of currently active API requests.") +;;; Multi-Account Support + +(defvar pearl-active-account nil + "Name of the Linear account currently active, or nil. +Runtime state, never a persisted defcustom: which account you are on right +now. `pearl-switch-account' sets it with `setq'; persisting it would make +the last switch stick across sessions and fight `pearl-default-account'.") + +(defun pearl--resolve-api-key-source (source account) + "Resolve SOURCE to an API key string for ACCOUNT (named for error messages). +SOURCE is a tagged list: (:literal KEY), (:env VAR), or +\(:auth-source :host H :user U). Errors -- naming ACCOUNT, never dumping the +lookup -- when the key cannot be found or SOURCE is malformed." + (pcase source + (`(:literal ,key) key) + (`(:env ,var) + (or (getenv var) + (error "No API key for account %s: environment variable %s is unset" + account var))) + (`(:auth-source . ,plist) + (let* ((found (car (apply #'auth-source-search + (append plist '(:require (:secret) :max 1))))) + (secret (and found (plist-get found :secret)))) + (cond + ((null secret) + (error "No API key for account %s: auth-source found no matching entry" + account)) + ((functionp secret) (funcall secret)) + (t secret)))) + (_ (error "No API key for account %s: unrecognized :api-key-source form" + account)))) + +(defun pearl--resolve-account (name) + "Resolve account NAME from `pearl-accounts' to a context plist. +The plist is (:name :api-key :org-file :default-team-id :url) with the key +resolved from `:api-key-source', `:org-file' expanded, and `:url' defaulting +to `pearl-graphql-url'. Errors when NAME is unknown or its key is missing." + (let ((spec (cdr (assoc name pearl-accounts)))) + (unless spec + (error "No Pearl account named %s" name)) + (let ((org-file (plist-get spec :org-file))) + (list :name name + :api-key (pearl--resolve-api-key-source + (plist-get spec :api-key-source) name) + :org-file (and org-file (expand-file-name org-file)) + :default-team-id (plist-get spec :default-team-id) + :url (or (plist-get spec :url) pearl-graphql-url))))) + +(defun pearl--current-account-context () + "Return the active account's context plist, or nil in legacy single-account mode. +Returns nil when `pearl-accounts' is empty (downstream then reads the legacy +globals unchanged). Otherwise resolves `pearl-active-account', falling back to +`pearl-default-account' on first need -- which it then records as active. +Errors when accounts are configured but neither is set." + (when pearl-accounts + (let ((name (or pearl-active-account + pearl-default-account + (user-error (concat "Pearl accounts are configured but none is active; " + "set `pearl-default-account' or run " + "`pearl-switch-account'"))))) + (unless pearl-active-account + (setq pearl-active-account name)) + (pearl--resolve-account name)))) + +(defvar pearl--account-context nil + "The account context bound for the current dynamic extent, or nil. +`pearl--with-account-context' binds this so async continuations -- pagination +and render/mutate callbacks -- re-establish the account that was active when +the request was dispatched, rather than reading whatever account happens to be +active when they later run.") + +(defmacro pearl--with-account-context (context &rest body) + "Evaluate BODY with the legacy globals bound to CONTEXT's account values. +CONTEXT is a context plist from `pearl--resolve-account'. A nil CONTEXT is a +passthrough: BODY runs against the current globals (legacy single-account +mode), so nothing changes when `pearl-accounts' is unset. Also binds +`pearl--account-context' so a nested async dispatch propagates the same +account into its own callbacks." + (declare (indent 1) (debug (form body))) + (let ((ctx (make-symbol "ctx"))) + `(let ((,ctx ,context)) + (if (null ,ctx) + (progn ,@body) + (let ((pearl--account-context ,ctx) + (pearl-api-key (plist-get ,ctx :api-key)) + (pearl-graphql-url (plist-get ,ctx :url)) + (pearl-org-file-path (or (plist-get ,ctx :org-file) + pearl-org-file-path)) + (pearl-default-team-id (plist-get ,ctx :default-team-id))) + ,@body))))) + +(defun pearl--read-buffer-account (&optional buffer) + "Return the `#+LINEAR-ACCOUNT' name BUFFER carries, or nil. +BUFFER defaults to the current buffer; the search is bounded to the preamble so +it stays cheap on large buffers, matching `pearl--read-active-source'." + (with-current-buffer (or buffer (current-buffer)) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward "^#\\+LINEAR-ACCOUNT: \\(.*\\)$" 4000 t) + (string-trim (match-string 1)))))) + +(defun pearl--require-account-context (&optional mutation) + "Guard a current-buffer command against the active Linear account. +Returns the active account's context plist, or nil in legacy single-account +mode (`pearl-accounts' unset), where there is nothing to guard. + +Otherwise enforces buffer ownership before any API call: +- buffer owned by the active account -> proceed; +- buffer owned by a *different* configured account -> refuse, naming both, so a + command can't run under one account against another's file; +- no `#+LINEAR-ACCOUNT' marker and MUTATION non-nil -> refuse until a refresh + stamps ownership; a non-mutating render/list command proceeds (it will stamp + ownership on its next write)." + (when pearl-accounts + (let* ((ctx (pearl--current-account-context)) + (active (plist-get ctx :name)) + (buffer-account (pearl--read-buffer-account))) + (cond + ((and buffer-account (not (string-equal buffer-account active))) + (user-error (concat "This file belongs to %s; active account is %s. " + "Run M-x pearl-switch-account first") + buffer-account active)) + ((and (null buffer-account) mutation) + (user-error "No LINEAR-ACCOUNT in this file; refresh it under an account first")) + (t ctx))))) + +(defun pearl--ensure-buffer-account-header () + "Stamp `#+LINEAR-ACCOUNT' into the current buffer if missing (accounts mode). +A no-op in legacy mode or when the marker is already present. The merge/refresh +path doesn't rebuild the header through `pearl--build-org-content', so without +this a legacy file (rendered before accounts were configured) would never +acquire ownership -- leaving the buffer guard's \"refresh it under an account +first\" advice unresolvable, since the refresh itself wouldn't stamp it." + (when (and pearl--account-context + (not (pearl--read-buffer-account))) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward "^#\\+LINEAR-SOURCE:" nil t) + (beginning-of-line) + (insert (format "#+LINEAR-ACCOUNT: %s\n" + (plist-get pearl--account-context :name))))))) + +(defun pearl--clear-account-scoped-state () + "Clear every cache scoped to a single Linear workspace. +The one place that lists the account-scoped caches -- the five Linear lookups +plus any future account-derived state -- so a newly added cache is registered +here and `pearl-switch-account' invalidates it without re-implementing cache +semantics. A personal workspace's teams must never bleed into a work one." + (setq pearl--cache-teams nil + pearl--cache-states nil + pearl--cache-team-collections nil + pearl--cache-views nil + pearl--cache-viewer nil)) + +(defun pearl--mode-line-lighter () + "Return the `pearl-mode' mode-line lighter, naming the active account. +\" Pearl[work]\" when accounts are configured and one is active; plain +\" Pearl\" in legacy single-account mode." + (if (and pearl-accounts pearl-active-account) + (format " Pearl[%s]" pearl-active-account) + " Pearl")) + +(defun pearl-switch-account (name) + "Switch the active Linear account to NAME. +Interactively, completes over the configured `pearl-accounts'. Resolves the +account (erroring on an unknown name or missing key), makes it active, clears +the account-scoped caches so the next lookup refetches against the new +workspace, refreshes the mode-line indicator, and visits the account's org file +when it exists." + (interactive + (list (if (null pearl-accounts) + (user-error "No accounts configured; set `pearl-accounts' first") + (completing-read "Switch to account: " + (mapcar #'car pearl-accounts) nil t)))) + (let ((ctx (pearl--resolve-account name))) + (setq pearl-active-account name) + (pearl--clear-account-scoped-state) + (force-mode-line-update t) + (let ((file (plist-get ctx :org-file))) + (if (and file (file-exists-p file)) + (progn (find-file file) + (message "Switched to account %s" name)) + (message "Switched to account %s (no org file yet; run a fetch)" name))))) + ;;; Core API Functions (Async-First Architecture) (defun pearl--headers () @@ -428,38 +641,49 @@ If SUCCESS-FN or ERROR-FN are not provided, default handlers will be used." (message "Linear API error: %s" error-thrown) (pearl--log "Error response: %s" (prin1-to-string data))))) - (let ((request-data (json-encode `(("query" . ,query) - ,@(when variables `(("variables" . ,variables)))))) - ;; Build headers before bumping the counter: `pearl--headers' signals - ;; when the API key is unset, and that must happen before the increment - ;; or no callback ever runs to decrement it (leaking the count). - (headers (pearl--headers))) - (pearl--log "Request payload: %s" request-data) - (setq pearl--active-requests (1+ pearl--active-requests)) - - (request - pearl-graphql-url - :type "POST" - :headers headers - :data request-data - :parser 'json-read - :success (cl-function - (lambda (&key data &allow-other-keys) - (setq pearl--active-requests (1- pearl--active-requests)) - (pearl--log "Response received: %s" (prin1-to-string data)) - (funcall success-fn data))) - :error (cl-function - (lambda (&key error-thrown response data &allow-other-keys) - (setq pearl--active-requests (1- pearl--active-requests)) - (pearl--log "Error: %s" error-thrown) - ;; Guard the status-code read: `response' can be nil on some - ;; transport failures, and the accessor errors on a non-struct. - (when (request-response-p response) - (pearl--log "Response status: %s" - (request-response-status-code response))) - (when data - (pearl--log "Error response: %s" (prin1-to-string data))) - (funcall error-fn error-thrown response data)))))) + ;; Snapshot the account context once, at dispatch. Reuse the context already + ;; bound by an enclosing `pearl--with-account-context' (pagination, a wrapping + ;; command); otherwise resolve the active account now. The macro binds the + ;; legacy globals for the synchronous header build and is re-established around + ;; each callback, so a mid-flight `pearl-switch-account' can't bleed into a + ;; request that was already dispatched. In legacy mode (no `pearl-accounts') + ;; the context is nil and the macro is a passthrough. + (let ((ctx (or pearl--account-context (pearl--current-account-context)))) + (pearl--with-account-context ctx + (let ((request-data (json-encode `(("query" . ,query) + ,@(when variables `(("variables" . ,variables)))))) + ;; Build headers before bumping the counter: `pearl--headers' signals + ;; when the API key is unset, and that must happen before the increment + ;; or no callback ever runs to decrement it (leaking the count). + (headers (pearl--headers))) + (pearl--log "Request payload: %s" request-data) + (setq pearl--active-requests (1+ pearl--active-requests)) + + (request + pearl-graphql-url + :type "POST" + :headers headers + :data request-data + :parser 'json-read + :success (cl-function + (lambda (&key data &allow-other-keys) + (setq pearl--active-requests (1- pearl--active-requests)) + (pearl--log "Response received: %s" (prin1-to-string data)) + (pearl--with-account-context ctx + (funcall success-fn data)))) + :error (cl-function + (lambda (&key error-thrown response data &allow-other-keys) + (setq pearl--active-requests (1- pearl--active-requests)) + (pearl--log "Error: %s" error-thrown) + ;; Guard the status-code read: `response' can be nil on some + ;; transport failures, and the accessor errors on a non-struct. + (when (request-response-p response) + (pearl--log "Response status: %s" + (request-response-status-code response))) + (when data + (pearl--log "Error response: %s" (prin1-to-string data))) + (pearl--with-account-context ctx + (funcall error-fn error-thrown response data))))))))) (defun pearl--graphql-request (query &optional variables) "Synchronous wrapper for GraphQL requests (backward compatibility). @@ -1620,11 +1844,7 @@ none, returns nil. FORCE refreshes the collection cache first." "Clear the Linear lookup caches (teams, states, per-team collections, views). Use after renaming things in Linear, or to force the next lookup to refetch." (interactive) - (setq pearl--cache-teams nil - pearl--cache-states nil - pearl--cache-team-collections nil - pearl--cache-views nil - pearl--cache-viewer nil) + (pearl--clear-account-scoped-state) (message "Linear caches cleared")) (defun pearl-update-issue-state (issue-id state-name team-id) @@ -2677,6 +2897,7 @@ unpushed local edits, they are stashed first (kill ring + the conflict-backup buffer) so the refresh can't silently lose them (decision 4), then the refresh proceeds and the subtree is replaced with Linear's version." (interactive) + (pearl--require-account-context) (save-excursion (pearl--goto-issue-heading-or-error) (let ((issue-id (org-entry-get nil "LINEAR-ID")) @@ -2822,6 +3043,7 @@ comment instead of the one-line minibuffer. BODY, when supplied non-interactively, is sent as-is. Works from anywhere inside an issue subtree; the new comment is the viewer's own, so it renders editable." (interactive (list nil)) + (pearl--require-account-context t) (save-excursion (pearl--goto-issue-heading-or-error) (let ((issue-id (org-entry-get nil "LINEAR-ID")) @@ -2843,6 +3065,7 @@ the issue body and syncs to Linear through the usual conflict gate, C-c C-k cancels. An alternative to editing the description inline for anyone who wants a dedicated buffer. Works from anywhere inside an issue subtree." (interactive) + (pearl--require-account-context t) (save-excursion (pearl--goto-issue-heading-or-error) (let ((issue-id (org-entry-get nil "LINEAR-ID")) @@ -2909,6 +3132,7 @@ Works from anywhere inside an issue subtree. Confirms first, then issues a soft delete (Linear moves the issue to Trash, recoverable for about 30 days); on success the issue's Org subtree is removed from the buffer." (interactive) + (pearl--require-account-context t) (let* ((marker (save-excursion (pearl--goto-issue-heading-or-error) (point-marker))) (issue-id (org-entry-get marker "LINEAR-ID")) (ident (or (org-entry-get marker "LINEAR-IDENTIFIER") "this issue"))) @@ -2999,6 +3223,7 @@ including one a TODO-keyword cycle can't express." (mapcar (lambda (s) (cdr (assoc 'name s))) (and team-id (pearl--team-states team-id))) nil t)))) + (pearl--require-account-context t) (save-excursion (pearl--goto-issue-heading-or-error) (let* ((team-id (org-entry-get nil "LINEAR-TEAM-ID")) @@ -3030,6 +3255,7 @@ inside an issue subtree." (list (completing-read "Assignee: " (pearl--team-collection-names 'members team-id) nil t)))) + (pearl--require-account-context t) (save-excursion (pearl--goto-issue-heading-or-error) (let* ((team-id (org-entry-get nil "LINEAR-TEAM-ID")) @@ -3066,6 +3292,7 @@ inside an issue subtree." (list (completing-read-multiple "Labels (comma-separated, empty to clear): " (pearl--team-collection-names 'labels team-id))))) + (pearl--require-account-context t) (save-excursion (pearl--goto-issue-heading-or-error) (let* ((team-id (org-entry-get nil "LINEAR-TEAM-ID")) @@ -3157,13 +3384,16 @@ only add the ones a failed team fetch left out." issues)))) (append team-states issue-states)))) -(defun pearl--build-org-content (issues &optional source truncated states) +(defun pearl--build-org-content (issues &optional source truncated states account) "Build the Org content string for the linear org file from ISSUES. SOURCE is the active-source descriptor recorded in the header so a later `pearl-refresh-current-view' can re-run it; TRUNCATED marks that the page cap was hit. STATES is the ordered workflow-state list (see `pearl--gather-header-states') the `#+TODO:' line is derived from; a nil STATES -yields the hardcoded default. Pure function, no side effects." +yields the hardcoded default. ACCOUNT, when non-nil, is the Linear account name +stamped as `#+LINEAR-ACCOUNT' so the buffer guard can tell which workspace owns +this file; nil (legacy single-account mode) omits the marker. Pure function, +no side effects." (let* ((src (or source '(:type filter :name "Linear issues" :filter nil))) (name (pearl--source-name src)) (filter (plist-get src :filter))) @@ -3175,6 +3405,8 @@ yields the hardcoded default. Pure function, no side effects." (insert (format "#+TODO: %s\n" (pearl--derive-todo-line states))) ;; Source-tracking metadata: the serialized source drives refresh; the ;; rest is human-readable provenance. + (when account + (insert (format "#+LINEAR-ACCOUNT: %s\n" account))) (insert (format "#+LINEAR-SOURCE: %s\n" (prin1-to-string src))) (insert (format "#+LINEAR-RUN-AT: %s\n" (format-time-string "%Y-%m-%d %H:%M"))) (insert (format "#+LINEAR-FILTER: %s\n" (pearl--summarize-filter filter))) @@ -3227,8 +3459,10 @@ In every case the resulting buffer is surfaced (see `pearl--surface-buffer'), so a fetch run from a menu or dashboard actually shows the issues instead of just writing the file and leaving it off-screen." (let* ((org-file-path pearl-org-file-path) + (account (and pearl--account-context + (plist-get pearl--account-context :name))) (states (pearl--gather-header-states issues)) - (new-content (pearl--build-org-content issues source truncated states)) + (new-content (pearl--build-org-content issues source truncated states account)) (existing-buf (find-buffer-visiting org-file-path))) (cond ;; Branch A: no buffer visits the file -- atomic file write, then visit. @@ -3429,6 +3663,16 @@ active file with the query recorded as the source." (order (plist-get spec :order)) (source (list :type 'filter :name name :filter filter-plist :sort sort :order order))) + ;; Account guard, checked before any filter compilation or network call: + ;; a query tagged for another account would otherwise resolve its team / + ;; state / label names against the wrong workspace. Inert in legacy mode + ;; and for an untagged (shared) query. + (let ((q-account (plist-get spec :account))) + (when (and pearl-accounts q-account) + (let ((active (plist-get (pearl--current-account-context) :name))) + (unless (string-equal q-account active) + (user-error "Saved query '%s' belongs to %s; switch accounts first" + name q-account))))) ;; Validate the saved query's authoring plist at the command boundary so ;; a typo'd key or bad value surfaces as a clear user-error instead of ;; being silently dropped or failing deeper in the compiler. @@ -3988,6 +4232,7 @@ the user can re-sync with Replace to reconcile." nil t)))) (when (pearl--filter-sentinel-value-p name) (user-error "Cancelled; no saved query synced")) + (pearl--require-account-context t) (let ((entry (assoc name pearl-saved-queries))) (unless entry (user-error "No saved query named %s" name)) @@ -4119,6 +4364,7 @@ name to sync under), or no local saved query matches the recorded name. Bound under \\='C-; L f P\\=' inside `pearl-mode' buffers; reachable through the transient as the `U' (upload) entry in the Fetch group." (interactive) + (pearl--require-account-context t) (let* ((source (pearl--read-active-source)) (type (and source (plist-get source :type))) (name (and source (plist-get source :name)))) @@ -5024,6 +5270,7 @@ once, and only if comments are dirty; then each dirty field is saved sequentially through its conflict gate and a single summary is reported. A clean issue does no network at all." (interactive) + (pearl--require-account-context t) (save-excursion (pearl--goto-issue-heading-or-error) (let* ((marker (point-marker)) @@ -5154,6 +5401,7 @@ counts; declining mutates nothing. On confirm the dirty fields save sequentially, continuing past any per-field conflict, and one summary is reported. A clean file does nothing." (interactive) + (pearl--require-account-context t) (let* ((buffer (current-buffer)) (scan (pearl--scan-all-dirty))) (if (null scan) @@ -5246,7 +5494,10 @@ edit-then-merge flow keeps the user's expanded subtrees expanded." "Refresh the active file's run-at, count, and truncation header lines. ISSUE-COUNT is the new issue total; TRUNCATED marks a page-cap hit. The `#+LINEAR-SOURCE:' descriptor is left untouched -- only the human-readable -provenance advances on a refresh." +provenance advances on a refresh. Under accounts mode an unmarked file also +acquires its `#+LINEAR-ACCOUNT' stamp here (see +`pearl--ensure-buffer-account-header')." + (pearl--ensure-buffer-account-header) (save-excursion (goto-char (point-min)) (when (re-search-forward "^#\\+LINEAR-RUN-AT: .*$" nil t) @@ -5341,6 +5592,7 @@ are dropped, while any subtree with unpushed edits is kept. This is the same-source counterpart to the replace-on-switch behavior of the query and view commands. Errors if no source is recorded." (interactive) + (pearl--require-account-context) (let ((source (pearl--read-active-source)) (buffer (current-buffer))) (unless source @@ -5628,8 +5880,15 @@ resolves to a single label." ;;;###autoload (defun pearl-load-api-key-from-env () - "Try to load Linear API key from environment variable." + "Try to load Linear API key from environment variable. +Legacy single-account path only: once `pearl-accounts' is configured this +refuses, so it can't bypass the per-account resolver and overwrite the active +account's key in memory. Use `:api-key-source (:env \"...\")' in +`pearl-accounts' instead." (interactive) + (when pearl-accounts + (user-error + "Accounts are configured; put :api-key-source (:env \"...\") in `pearl-accounts'")) (let ((env-key (getenv "LINEAR_API_KEY"))) (if env-key (progn @@ -5784,6 +6043,7 @@ description sync -- unchanged since fetch sends nothing, a local edit against an unchanged remote pushes, and a both-sides-changed case is refused and reported (refresh to reconcile)." (interactive) + (pearl--require-account-context t) (save-excursion (pearl--goto-heading-or-error "Not on a Linear comment") (let ((comment-id (org-entry-get nil "LINEAR-COMMENT-ID")) @@ -5814,6 +6074,7 @@ with no stored hash, gets a stronger discard-local-edits confirmation. On success the comment's Org subtree is removed; sibling comments and the issue body stay." (interactive) + (pearl--require-account-context t) (save-excursion (pearl--goto-heading-or-error "Not on a Linear comment") (let ((comment-id (org-entry-get nil "LINEAR-COMMENT-ID")) @@ -6035,7 +6296,7 @@ Binds `pearl-prefix-map' under `pearl-keymap-prefix' so every Pearl command is reachable from the keyboard. Turns on automatically in any buffer Pearl rendered (one carrying a `#+LINEAR-SOURCE' header); see `pearl--maybe-enable-mode' on `org-mode-hook'." - :lighter " Pearl" + :lighter (:eval (pearl--mode-line-lighter)) :keymap pearl-mode-map) (defun pearl--buffer-is-pearl-p () |