diff options
| author | Craig Jennings <c@cjennings.net> | 2026-05-31 07:10:33 -0500 |
|---|---|---|
| committer | Craig Jennings <c@cjennings.net> | 2026-05-31 07:10:33 -0500 |
| commit | 394c75b2f92e2a72390b3417e483849bed13a399 (patch) | |
| tree | a5b92603ecb049381015fb7556f25dcf74fa6c21 | |
| parent | 4767d16423ff5c87cf1222603c7b8f1b59af8ef2 (diff) | |
| download | pearl-394c75b2f92e2a72390b3417e483849bed13a399.tar.gz pearl-394c75b2f92e2a72390b3417e483849bed13a399.zip | |
feat(accounts): multi-account support with tests
I added a named-account layer for working more than one Linear workspace from one Emacs.
Before this, everything that identified a workspace was a single global: pearl-api-key, pearl-graphql-url, pearl-org-file-path, and the lookup caches. Nothing stopped a work command from running under personal credentials or a work fetch from landing in the personal file, and switching accounts meant re-customizing the key, team, and file by hand and clearing the cache.
pearl-accounts maps a name to a per-workspace plist (credential source, org file, default team, optional endpoint), and pearl-switch-account makes one active. Account state flows through an explicit context rather than mutating globals. Every request snapshots its account at dispatch through pearl--graphql-request-async and re-establishes it around the callbacks. A switch mid-fetch can't bleed into a request already in flight: the result finishes into the account it was dispatched under. I centralized this in the one request primitive, so the leak surface is a single function instead of every call site.
Rendered files carry a #+LINEAR-ACCOUNT marker, and a buffer guard refuses a command run from one account's file while another is active, naming both, so a work edit can't push under personal credentials. An unmarked legacy file lets reads and refreshes through and acquires its marker on the first refresh. Mutations wait until then. Credentials resolve through auth-source, an env var, or an inline literal, and a resolved key is never persisted through Customize or logged. The active account shows in the mode line. A saved query can carry an :account so it refuses to run under the wrong workspace before any lookup.
With pearl-accounts unset, everything behaves exactly as before, off the legacy globals.
| -rw-r--r-- | README.org | 57 | ||||
| -rw-r--r-- | docs/multi-account-spec.org | 4 | ||||
| -rw-r--r-- | pearl.el | 347 | ||||
| -rw-r--r-- | tests/test-pearl-accounts.el | 481 |
4 files changed, 843 insertions, 46 deletions
@@ -22,6 +22,7 @@ Pearl (backronym: *Pearl Edits and Reflects Linear*) brings Linear issues into E - Add and delete your own comments, create issues, delete issues, and open the current issue or view in Linear - Refresh the active view from the source recorded in the file, or refresh one issue at point - Render Linear workflow states as Org TODO keywords +- Work multiple Linear workspaces from one Emacs: named accounts, a safe switch, per-file ownership, and a mode-line indicator - Use one transient dispatcher, =M-x pearl-menu=, for the whole command surface - [[file:TESTING.org][Well-tested]] with isolated ERT files, request fixtures, and coverage support @@ -362,9 +363,11 @@ Most users only need an API key and an output path. The rest are knobs for teams | Variable | Purpose | |-----------------------------+---------------------------------------------------| -| =pearl-api-key= | Linear API key | +| =pearl-api-key= | Linear API key (single-account) | | =pearl-org-file-path= | Active Org output file | | =pearl-default-team-id= | Default team for issue creation | +| =pearl-accounts= | Named accounts for multiple workspaces | +| =pearl-default-account= | Account made active at first need | | =pearl-saved-queries= | Named local issue queries | | =pearl-max-issue-pages= | Pagination cap, 100 issues per page | | =pearl-request-timeout= | Synchronous request timeout in seconds | @@ -391,6 +394,58 @@ Common shapes: For per-URL routing (e.g. "Linear goes to the work-account browser, everything else to my personal one"), set =browse-url-handlers= with a list of =(REGEXP . FUNCTION)= pairs. +** Multiple accounts +:PROPERTIES: +:CUSTOM_ID: multiple-accounts +:END: + +If you work more than one Linear workspace — say a work account and a personal one — set =pearl-accounts= and switch between them with =M-x pearl-switch-account=. Each account names where its key is found, which Org file holds its issues, and (optionally) a default team: + +#+begin_src elisp +(setq pearl-accounts + '(("work" :api-key-source (:auth-source :host "api.linear.app" :user "work") + :org-file "~/org/work-linear.org" + :default-team-id "TEAM_WORK") + ("personal" :api-key-source (:env "LINEAR_PERSONAL_API_KEY") + :org-file "~/org/personal-linear.org"))) +(setq pearl-default-account "work") +#+end_src + +=:api-key-source= says how the key is *found*, not the key itself. Three forms: + +| Form | Where the key comes from | +|-----------------------------------------+---------------------------------------------------| +| =(:auth-source :host H :user U)= | =~/.authinfo.gpg= (the documented default) | +| =(:env "VAR")= | the named environment variable | +| =(:literal "lin_...")= | the string inline (an escape hatch) | + +The auth-source form keeps the key out of your config. An =~/.authinfo.gpg= line for the example above: + +#+begin_example +machine api.linear.app login work password lin_api_xxxxxxxx +#+end_example + +A resolved key is never written back through Customize and never logged. =pearl-load-api-key-from-env= is a legacy single-account convenience and refuses once =pearl-accounts= is set — put =:api-key-source (:env "...")= in the account instead. + +*** Switching, ownership, and the indicator + +=pearl-switch-account= makes an account active, clears the per-workspace lookup caches so the next fetch resolves against the new workspace, and visits that account's Org file. The active account shows in the mode line as =Pearl[work]=. + +Each rendered file is stamped with =#+LINEAR-ACCOUNT:= naming the workspace that owns it. Pearl refuses to run a command from a file owned by a different account than the active one — it names both and tells you to switch first — so a work edit can't land under personal credentials. A file with no marker (a legacy file, or one you created before configuring accounts) lets read/refresh commands through and stamps ownership on the next refresh, but refuses a mutation until then. + +Leave =pearl-accounts= unset for single-account use; everything works off =pearl-api-key= and =pearl-org-file-path= exactly as before. + +*** Saved queries across accounts + +=pearl-saved-queries= is one shared list. A query entry may carry an optional =:account= so it only runs under that account: + +#+begin_src elisp +("My work bugs" :account "work" + :filter (:team "ENG" :label "bug" :assignee :me)) +#+end_src + +Running it under a different active account refuses before any lookup or fetch. A query *without* =:account= is shared and resolves its team / state / label names against whatever account is active — so the same name can mean different things across workspaces. Tag the ones that must not cross. + ** Development & Testing :PROPERTIES: :CUSTOM_ID: development--testing diff --git a/docs/multi-account-spec.org b/docs/multi-account-spec.org index bf85c29..f60adb1 100644 --- a/docs/multi-account-spec.org +++ b/docs/multi-account-spec.org @@ -62,7 +62,7 @@ Rather than mutating globals and hoping downstream is oblivious, account state f Every API operation *snapshots* its account context at dispatch time. The snapshot is the =pearl--resolve-account= plist captured before the request fires. Render and mutate callbacks act against the *snapshot's* org file / key, never the current global. -*v1 decision (confirm):* if the active account changed before a callback completes, the callback still finishes into its snapshot — writing the work result to the work file, with a status message naming the account ("Updated work: 24 issues"). It does *not* write to whatever file is now current, and it does *not* silently drop the result the user asked for. (The reviewer offered finish-into-snapshot or drop-stale; finish-into-snapshot is chosen because the fetch was an explicit user request whose data belongs to its own account's file regardless of a later switch, and round 2 endorsed it as the right default.) +*v1 decision (final):* if the active account changed before a callback completes, the callback still finishes into its snapshot — writing the work result to the work file, with a status message naming the account ("Updated work: 24 issues"). It does *not* write to whatever file is now current, and it does *not* silently drop the result the user asked for. (The reviewer offered finish-into-snapshot or drop-stale; finish-into-snapshot is chosen because the fetch was an explicit user request whose data belongs to its own account's file regardless of a later switch, and round 2 endorsed it as the right default.) *Implementation boundary (where the snapshot is captured and applied).* So a single missed render path can't reintroduce the leak: @@ -186,7 +186,7 @@ Passive. With =pearl-accounts= unset, the package behaves exactly as today off t - *MP2 (saved queries) — modified to a choice.* The reviewer offered account-scoped lists, an optional =:account= guard, or document-and-warn. Chose the optional =:account= guard plus a shared default and a README warning: it keeps the v1 saved-query store unchanged (one list) while giving a refusal path for queries that must not cross accounts, where full account-scoping would add a persistence/UX layer not yet justified for two workspaces. - *MP3 (cache clearing) — modified the test framing.* Accepted the helper (=pearl--clear-account-scoped-state= as the single source of truth, listing every account-scoped cache including future derived state). Softened the reviewer's "a test must fail when a new account-scoped cache is added without invalidation" — you can't test for an unwritten future cache directly. Instead the helper centralizes the list so a new cache is registered in one place, and a test asserts each cache the helper names is nil after a switch. -Also, the reviewer's three open questions and the HP1 finish-vs-drop choice are baked as proposed v1 decisions (finish-into-snapshot, refuse-on-mismatch, =:account= guard) and surfaced under Open Questions for Craig's confirmation rather than left unresolved. Everything else accepted as written. +Also, the reviewer's three open questions and the HP1 finish-vs-drop choice are baked as v1 decisions (finish-into-snapshot, refuse-on-mismatch, =:account= guard) and adopted as final — see Resolved safety decisions. Everything else accepted as written. *Round 2 (Codex, 2026-05-25).* Rubric moved to =Ready with caveats=. All findings accepted as written, no modifications or rejects: HP1 (the implementation-boundary rule — entry resolves context, callbacks run inside the context macro, shared render fns take an explicit target), HP2 (the precise unmarked-buffer rule — render/list proceed, mutations refuse until a refresh stamps ownership), HP3 (=pearl-active-account= is a runtime =defvar=, not a persisted defcustom — a genuine correction to the round-1 draft), MP1 (=pearl-load-api-key-from-env= legacy-only, refuses under accounts), MP2 (=:account= lives in the saved-query entry and is checked before filter compilation, with an example), MP3 (mode-line lighter is the v1 indicator, header-line optional), plus the UX refusal-message-names-both-accounts and the added tests. The remaining caveats are the safety calls, now endorsed by the reviewer. @@ -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 () diff --git a/tests/test-pearl-accounts.el b/tests/test-pearl-accounts.el new file mode 100644 index 0000000..c0514a8 --- /dev/null +++ b/tests/test-pearl-accounts.el @@ -0,0 +1,481 @@ +;;; test-pearl-accounts.el --- Tests for pearl multi-account support -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Craig Jennings + +;; Author: Craig Jennings <c@cjennings.net> + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Unit tests for the multi-account layer: the `:api-key-source' credential +;; resolver, `pearl--resolve-account', and `pearl--current-account-context'. +;; Live auth-source and the environment are stubbed so the tests need no real +;; credentials and never touch the user's `~/.authinfo.gpg'. + +;;; Code: + +(require 'test-bootstrap (expand-file-name "test-bootstrap.el")) + +;;; :api-key-source resolver + +(ert-deftest test-pearl-resolve-api-key-source-literal () + "A `:literal' source returns the embedded key verbatim." + (should (string-equal "lin_lit_123" + (pearl--resolve-api-key-source '(:literal "lin_lit_123") "work")))) + +(ert-deftest test-pearl-resolve-api-key-source-env-present () + "An `:env' source reads the named environment variable." + (let ((process-environment (cons "PEARL_TEST_KEY=lin_env_abc" process-environment))) + (should (string-equal "lin_env_abc" + (pearl--resolve-api-key-source '(:env "PEARL_TEST_KEY") "work"))))) + +(ert-deftest test-pearl-resolve-api-key-source-env-missing-errors-names-account () + "An unset `:env' variable errors, and the message names the account." + (let ((process-environment (list "PEARL_UNRELATED=1"))) ; var deliberately absent + (let ((err (should-error + (pearl--resolve-api-key-source '(:env "PEARL_NOPE_VAR") "work") + :type 'error))) + (should (string-match-p "work" (error-message-string err)))))) + +(ert-deftest test-pearl-resolve-api-key-source-auth-source () + "An `:auth-source' source returns the secret auth-source yields." + (cl-letf (((symbol-function 'auth-source-search) + (lambda (&rest _) (list (list :secret "lin_authinfo_xyz"))))) + (should (string-equal "lin_authinfo_xyz" + (pearl--resolve-api-key-source + '(:auth-source :host "api.linear.app" :user "work") "work"))))) + +(ert-deftest test-pearl-resolve-api-key-source-auth-source-secret-function () + "auth-source may hand back the secret as a thunk; the resolver funcalls it." + (cl-letf (((symbol-function 'auth-source-search) + (lambda (&rest _) (list (list :secret (lambda () "lin_thunk_secret")))))) + (should (string-equal "lin_thunk_secret" + (pearl--resolve-api-key-source + '(:auth-source :host "api.linear.app" :user "work") "work"))))) + +(ert-deftest test-pearl-resolve-api-key-source-auth-source-missing-errors-names-account () + "auth-source finding nothing errors with the account name, not lookup internals." + (cl-letf (((symbol-function 'auth-source-search) (lambda (&rest _) nil))) + (let ((err (should-error + (pearl--resolve-api-key-source + '(:auth-source :host "api.linear.app" :user "personal") "personal") + :type 'error))) + (should (string-match-p "personal" (error-message-string err)))))) + +(ert-deftest test-pearl-resolve-api-key-source-unknown-form-errors () + "An unrecognized source tag errors rather than silently yielding nil." + (should-error (pearl--resolve-api-key-source '(:bogus "x") "work") :type 'error)) + +;;; pearl--resolve-account + +(ert-deftest test-pearl-resolve-account-returns-full-context () + "A named account resolves to a context plist with every field populated." + (let ((pearl-accounts + '(("work" :api-key-source (:literal "lin_work_key") + :org-file "/tmp/work-linear.org" + :default-team-id "TEAM_WORK" + :url "https://example.test/graphql")))) + (let ((ctx (pearl--resolve-account "work"))) + (should (string-equal "work" (plist-get ctx :name))) + (should (string-equal "lin_work_key" (plist-get ctx :api-key))) + (should (string-equal "/tmp/work-linear.org" (plist-get ctx :org-file))) + (should (string-equal "TEAM_WORK" (plist-get ctx :default-team-id))) + (should (string-equal "https://example.test/graphql" (plist-get ctx :url)))))) + +(ert-deftest test-pearl-resolve-account-expands-org-file () + "A `~'-relative `:org-file' is expanded to an absolute path in the context." + (let ((pearl-accounts + '(("home" :api-key-source (:literal "k") :org-file "~/pearl-home.org")))) + (should (string-equal (expand-file-name "~/pearl-home.org") + (plist-get (pearl--resolve-account "home") :org-file))))) + +(ert-deftest test-pearl-resolve-account-url-defaults-to-graphql-endpoint () + "An account without `:url' inherits the package's default Linear endpoint." + (let ((pearl-accounts '(("work" :api-key-source (:literal "k") :org-file "/tmp/w.org"))) + (pearl-graphql-url "https://api.linear.app/graphql")) + (should (string-equal "https://api.linear.app/graphql" + (plist-get (pearl--resolve-account "work") :url))))) + +(ert-deftest test-pearl-resolve-account-unknown-name-errors () + "Resolving a name absent from `pearl-accounts' errors." + (let ((pearl-accounts '(("work" :api-key-source (:literal "k") :org-file "/tmp/w.org")))) + (should-error (pearl--resolve-account "ghost") :type 'error))) + +(ert-deftest test-pearl-resolve-account-missing-key-errors-names-account () + "A bad credential source surfaces as an account-named error from resolve." + (let ((pearl-accounts + '(("work" :api-key-source (:auth-source :host "api.linear.app" :user "work") + :org-file "/tmp/w.org")))) + (cl-letf (((symbol-function 'auth-source-search) (lambda (&rest _) nil))) + (let ((err (should-error (pearl--resolve-account "work") :type 'error))) + (should (string-match-p "work" (error-message-string err))))))) + +(ert-deftest test-pearl-resolve-account-does-not-mutate-global-key () + "Resolving an account returns its key in the context, never `setq's the global." + (let ((pearl-accounts '(("work" :api-key-source (:literal "lin_work") :org-file "/tmp/w.org"))) + (pearl-api-key "lin_legacy_global")) + (pearl--resolve-account "work") + (should (string-equal "lin_legacy_global" pearl-api-key)))) + +;;; pearl--current-account-context + +(ert-deftest test-pearl-current-account-context-accounts-nil-returns-nil () + "With no accounts configured the context is nil — legacy single-account mode." + (let ((pearl-accounts nil) + (pearl-active-account nil) + (pearl-default-account nil)) + (should (null (pearl--current-account-context))))) + +(ert-deftest test-pearl-current-account-context-resolves-default-on-first-need () + "Accounts set, none active: the default is resolved and becomes active." + (let ((pearl-accounts '(("work" :api-key-source (:literal "kw") :org-file "/tmp/w.org") + ("home" :api-key-source (:literal "kh") :org-file "/tmp/h.org"))) + (pearl-default-account "home") + (pearl-active-account nil)) + (let ((ctx (pearl--current-account-context))) + (should (string-equal "home" (plist-get ctx :name))) + (should (string-equal "home" pearl-active-account))))) + +(ert-deftest test-pearl-current-account-context-no-default-errors () + "Accounts set with neither an active nor a default account errors." + (let ((pearl-accounts '(("work" :api-key-source (:literal "kw") :org-file "/tmp/w.org"))) + (pearl-default-account nil) + (pearl-active-account nil)) + (should-error (pearl--current-account-context) :type 'error))) + +(ert-deftest test-pearl-current-account-context-uses-active-over-default () + "An explicit active account wins over the configured default." + (let ((pearl-accounts '(("work" :api-key-source (:literal "kw") :org-file "/tmp/w.org") + ("home" :api-key-source (:literal "kh") :org-file "/tmp/h.org"))) + (pearl-default-account "home") + (pearl-active-account "work")) + (should (string-equal "work" (plist-get (pearl--current-account-context) :name))))) + +;;; pearl--with-account-context macro + +(ert-deftest test-pearl-with-account-context-binds-globals () + "Inside the macro the legacy globals reflect the context's values." + (let ((pearl-api-key "legacy") (pearl-graphql-url "legacy-url") + (pearl-org-file-path "/legacy.org") (pearl-default-team-id "LEGACY")) + (pearl--with-account-context + '(:name "work" :api-key "kw" :url "https://w.test/gql" + :org-file "/tmp/w.org" :default-team-id "TEAM_W") + (should (string-equal "kw" pearl-api-key)) + (should (string-equal "https://w.test/gql" pearl-graphql-url)) + (should (string-equal "/tmp/w.org" pearl-org-file-path)) + (should (string-equal "TEAM_W" pearl-default-team-id))))) + +(ert-deftest test-pearl-with-account-context-nil-is-passthrough () + "A nil context leaves the globals untouched (legacy single-account mode)." + (let ((pearl-api-key "legacy") (pearl-org-file-path "/legacy.org")) + (pearl--with-account-context nil + (should (string-equal "legacy" pearl-api-key)) + (should (string-equal "/legacy.org" pearl-org-file-path))))) + +(ert-deftest test-pearl-with-account-context-restores-after () + "The globals are restored to their prior values after the macro body." + (let ((pearl-api-key "legacy") (pearl-org-file-path "/legacy.org")) + (pearl--with-account-context + '(:name "work" :api-key "kw" :url "u" :org-file "/tmp/w.org") + (ignore)) + (should (string-equal "legacy" pearl-api-key)) + (should (string-equal "/legacy.org" pearl-org-file-path)))) + +;;; Dispatch-time snapshot (HP1) + +(ert-deftest test-pearl-request-async-callback-runs-under-dispatch-context () + "request-async re-establishes the dispatch-time context around its callback. +A switch to another account after dispatch must not bleed into the callback — +the callback sees the key and org-file of the account that was active when the +request fired." + (let ((pearl-accounts + (list (list "work" :api-key-source '(:literal "kw") :org-file "/tmp/w.org") + (list "home" :api-key-source '(:literal "kh") :org-file "/tmp/h.org"))) + (pearl-default-account "work") + (pearl-active-account "work") + (pearl--account-context nil) + (captured nil) (seen-key nil) (seen-file nil)) + (cl-letf (((symbol-function 'request) + (lambda (_url &rest args) (setq captured (plist-get args :success))))) + (pearl--graphql-request-async + "q" nil + (lambda (_data) (setq seen-key pearl-api-key + seen-file pearl-org-file-path)))) + ;; The user switches accounts before the response lands. + (setq pearl-active-account "home") + (funcall captured :data '((data))) + (should (string-equal "kw" seen-key)) + (should (string-equal (expand-file-name "/tmp/w.org") seen-file)))) + +(ert-deftest test-pearl-request-async-uses-active-account-key-at-dispatch () + "With accounts configured, request-async builds headers from the active account." + (let ((pearl-accounts + (list (list "work" :api-key-source '(:literal "lin_work_dispatch") + :org-file "/tmp/w.org"))) + (pearl-default-account "work") + (pearl-active-account "work") + (pearl--account-context nil) + (seen-auth nil)) + (cl-letf (((symbol-function 'request) + (lambda (_url &rest args) + (setq seen-auth (cdr (assoc "Authorization" (plist-get args :headers))))))) + (pearl--graphql-request-async "q" nil #'ignore)) + (should (string-equal "lin_work_dispatch" seen-auth)))) + +(ert-deftest test-pearl-request-async-legacy-mode-uses-global-key () + "With no accounts configured, request-async uses the legacy global key unchanged." + (let ((pearl-accounts nil) + (pearl-active-account nil) + (pearl-default-account nil) + (pearl-api-key "lin_legacy_global") + (pearl--account-context nil) + (seen-auth nil)) + (cl-letf (((symbol-function 'request) + (lambda (_url &rest args) + (setq seen-auth (cdr (assoc "Authorization" (plist-get args :headers))))))) + (pearl--graphql-request-async "q" nil #'ignore)) + (should (string-equal "lin_legacy_global" seen-auth)))) + +;;; #+LINEAR-ACCOUNT header + buffer ownership + +(ert-deftest test-pearl-read-buffer-account-present () + "The buffer-account reader returns the #+LINEAR-ACCOUNT name." + (with-temp-buffer + (insert "#+title: x\n#+LINEAR-ACCOUNT: work\n#+LINEAR-SOURCE: (:type filter)\n") + (should (string-equal "work" (pearl--read-buffer-account))))) + +(ert-deftest test-pearl-read-buffer-account-absent () + "A buffer with no #+LINEAR-ACCOUNT marker reads as nil." + (with-temp-buffer + (insert "#+title: x\n#+LINEAR-SOURCE: (:type filter)\n") + (should (null (pearl--read-buffer-account))))) + +(ert-deftest test-pearl-build-org-content-emits-account-header () + "When an account name is supplied, the content carries #+LINEAR-ACCOUNT." + (let ((content (pearl--build-org-content nil nil nil nil "work"))) + (should (string-match-p "^#\\+LINEAR-ACCOUNT: work$" content)))) + +(ert-deftest test-pearl-build-org-content-omits-account-header-in-legacy () + "With no account name the content omits #+LINEAR-ACCOUNT (legacy file)." + (let ((content (pearl--build-org-content nil nil nil nil nil))) + (should-not (string-match-p "LINEAR-ACCOUNT" content)))) + +;;; pearl--require-account-context buffer guard + +(ert-deftest test-pearl-require-account-context-legacy-returns-nil () + "In legacy mode the guard is a no-op, even for a mutation." + (let ((pearl-accounts nil) (pearl-active-account nil) (pearl-default-account nil)) + (with-temp-buffer + (should (null (pearl--require-account-context t)))))) + +(ert-deftest test-pearl-require-account-context-matching-account-proceeds () + "A buffer owned by the active account passes the guard and yields its context." + (let ((pearl-accounts '(("work" :api-key-source (:literal "kw") :org-file "/tmp/w.org"))) + (pearl-active-account "work") (pearl-default-account "work")) + (with-temp-buffer + (insert "#+LINEAR-ACCOUNT: work\n") + (let ((ctx (pearl--require-account-context t))) + (should (string-equal "work" (plist-get ctx :name))))))) + +(ert-deftest test-pearl-require-account-context-wrong-account-refuses-mutation () + "A mutation from another account's file refuses, naming both accounts." + (let ((pearl-accounts '(("work" :api-key-source (:literal "kw") :org-file "/tmp/w.org") + ("home" :api-key-source (:literal "kh") :org-file "/tmp/h.org"))) + (pearl-active-account "home") (pearl-default-account "home")) + (with-temp-buffer + (insert "#+LINEAR-ACCOUNT: work\n") + (let ((err (should-error (pearl--require-account-context t) :type 'error))) + (should (string-match-p "work" (error-message-string err))) + (should (string-match-p "home" (error-message-string err))))))) + +(ert-deftest test-pearl-require-account-context-wrong-account-refuses-nonmutation () + "Even a non-mutating buffer command refuses against another account's file — +fetching the active account's issues into it would cross workspaces." + (let ((pearl-accounts '(("work" :api-key-source (:literal "kw") :org-file "/tmp/w.org") + ("home" :api-key-source (:literal "kh") :org-file "/tmp/h.org"))) + (pearl-active-account "home") (pearl-default-account "home")) + (with-temp-buffer + (insert "#+LINEAR-ACCOUNT: work\n") + (should-error (pearl--require-account-context nil) :type 'error)))) + +(ert-deftest test-pearl-require-account-context-unmarked-mutation-refuses () + "An unmarked buffer refuses a mutation until a refresh stamps ownership." + (let ((pearl-accounts '(("work" :api-key-source (:literal "kw") :org-file "/tmp/w.org"))) + (pearl-active-account "work") (pearl-default-account "work")) + (with-temp-buffer + (insert "#+LINEAR-SOURCE: (:type filter)\n") + (should-error (pearl--require-account-context t) :type 'error)))) + +(ert-deftest test-pearl-require-account-context-unmarked-nonmutation-proceeds () + "An unmarked buffer lets a render/list command through (it stamps ownership)." + (let ((pearl-accounts '(("work" :api-key-source (:literal "kw") :org-file "/tmp/w.org"))) + (pearl-active-account "work") (pearl-default-account "work")) + (with-temp-buffer + (insert "#+LINEAR-SOURCE: (:type filter)\n") + (let ((ctx (pearl--require-account-context nil))) + (should (string-equal "work" (plist-get ctx :name))))))) + +;;; Guard wiring — commands refuse before any API call + +(ert-deftest test-pearl-save-issue-refuses-wrong-account-buffer () + "`pearl-save-issue' from another account's buffer errors before touching the API." + (let ((pearl-accounts '(("work" :api-key-source (:literal "kw") :org-file "/tmp/w.org") + ("home" :api-key-source (:literal "kh") :org-file "/tmp/h.org"))) + (pearl-active-account "home") (pearl-default-account "home") + (api-called nil)) + (cl-letf (((symbol-function 'request) (lambda (&rest _) (setq api-called t)))) + (with-temp-buffer + (insert "#+LINEAR-ACCOUNT: work\n#+LINEAR-SOURCE: (:type filter)\n" + "* View\n** TODO thing\n:PROPERTIES:\n:LINEAR-ID: abc\n:END:\n") + (org-mode) + (goto-char (point-max)) + (should-error (pearl-save-issue) :type 'error) + (should-not api-called))))) + +(ert-deftest test-pearl-edit-description-refuses-unmarked-buffer () + "`pearl-edit-description' refuses to mutate an unmarked buffer under accounts." + (let ((pearl-accounts '(("work" :api-key-source (:literal "kw") :org-file "/tmp/w.org"))) + (pearl-active-account "work") (pearl-default-account "work") + (api-called nil)) + (cl-letf (((symbol-function 'request) (lambda (&rest _) (setq api-called t)))) + (with-temp-buffer + (insert "#+LINEAR-SOURCE: (:type filter)\n* View\n** TODO thing\n" + ":PROPERTIES:\n:LINEAR-ID: abc\n:END:\n") + (org-mode) + (goto-char (point-max)) + (should-error (pearl-edit-description) :type 'error) + (should-not api-called))))) + +;;; Cache isolation + switch + indicator + +(ert-deftest test-pearl-clear-account-scoped-state-nils-every-cache () + "The helper clears every account-scoped cache it names." + (let ((pearl--cache-teams '(x)) (pearl--cache-states '(x)) + (pearl--cache-team-collections '(x)) (pearl--cache-views '(x)) + (pearl--cache-viewer '(:id "v"))) + (pearl--clear-account-scoped-state) + (should (null pearl--cache-teams)) + (should (null pearl--cache-states)) + (should (null pearl--cache-team-collections)) + (should (null pearl--cache-views)) + (should (null pearl--cache-viewer)))) + +(ert-deftest test-pearl-switch-account-sets-active-and-clears-caches () + "Switching accounts sets `pearl-active-account' and clears the lookup caches." + (let ((pearl-accounts '(("work" :api-key-source (:literal "kw") :org-file "/tmp/w-nope.org") + ("home" :api-key-source (:literal "kh") :org-file "/tmp/h-nope.org"))) + (pearl-active-account "work") + (pearl--cache-teams '(stale)) (pearl--cache-viewer '(:id "stale"))) + (pearl-switch-account "home") + (should (string-equal "home" pearl-active-account)) + (should (null pearl--cache-teams)) + (should (null pearl--cache-viewer)))) + +(ert-deftest test-pearl-switch-account-unknown-name-errors () + "Switching to an unconfigured account errors (via the resolver)." + (let ((pearl-accounts '(("work" :api-key-source (:literal "kw") :org-file "/tmp/w.org"))) + (pearl-active-account "work")) + (should-error (pearl-switch-account "ghost") :type 'error))) + +(ert-deftest test-pearl-mode-line-lighter-shows-active-account () + "The lighter names the active account when accounts are configured." + (let ((pearl-accounts '(("work" :api-key-source (:literal "kw") :org-file "/tmp/w.org"))) + (pearl-active-account "work")) + (should (string-equal " Pearl[work]" (pearl--mode-line-lighter))))) + +(ert-deftest test-pearl-mode-line-lighter-plain-in-legacy () + "Without accounts the lighter is the plain \" Pearl\"." + (let ((pearl-accounts nil) (pearl-active-account nil)) + (should (string-equal " Pearl" (pearl--mode-line-lighter))))) + +;;; Saved-query :account guard + +(ert-deftest test-pearl-run-saved-query-refuses-other-account-before-network () + "A saved query tagged for another account refuses before any compilation or fetch." + (let ((pearl-accounts '(("work" :api-key-source (:literal "kw") :org-file "/tmp/w.org") + ("home" :api-key-source (:literal "kh") :org-file "/tmp/h.org"))) + (pearl-active-account "home") (pearl-default-account "home") + (pearl-saved-queries '(("Work bugs" :account "work" :filter (:assignee :me)))) + (api-called nil)) + (cl-letf (((symbol-function 'request) (lambda (&rest _) (setq api-called t)))) + (let ((err (should-error (pearl-run-saved-query "Work bugs") :type 'error))) + (should (string-match-p "work" (error-message-string err)))) + (should-not api-called)))) + +(ert-deftest test-pearl-run-saved-query-account-match-proceeds-to-fetch () + "A saved query tagged for the active account compiles and dispatches." + (let ((pearl-accounts '(("work" :api-key-source (:literal "kw") :org-file "/tmp/w.org"))) + (pearl-active-account "work") (pearl-default-account "work") + (pearl-saved-queries '(("Work bugs" :account "work" :filter (:assignee :me)))) + (api-called nil)) + (cl-letf (((symbol-function 'request) (lambda (&rest _) (setq api-called t)))) + (pearl-run-saved-query "Work bugs") + (should api-called)))) + +(ert-deftest test-pearl-run-saved-query-account-tag-ignored-in-legacy () + "With no accounts configured, an `:account' tag is inert (shared query)." + (let ((pearl-accounts nil) (pearl-active-account nil) (pearl-default-account nil) + (pearl-api-key "lin_legacy") + (pearl-saved-queries '(("Work bugs" :account "work" :filter (:assignee :me)))) + (api-called nil)) + (cl-letf (((symbol-function 'request) (lambda (&rest _) (setq api-called t)))) + (pearl-run-saved-query "Work bugs") + (should api-called)))) + +;;; pearl-load-api-key-from-env legacy-only + +(ert-deftest test-pearl-load-api-key-from-env-refuses-under-accounts () + "The env loader refuses once accounts are configured, to not bypass the resolver." + (let ((pearl-accounts '(("work" :api-key-source (:literal "kw") :org-file "/tmp/w.org")))) + (should-error (pearl-load-api-key-from-env) :type 'error))) + +;;; Refresh stamps ownership on a legacy file (closes the guard's "refresh first" loop) + +(ert-deftest test-pearl-update-source-header-stamps-missing-account () + "Refreshing an unmarked file under accounts mode stamps #+LINEAR-ACCOUNT, +so a later mutation isn't permanently refused with \"refresh it under an +account first\" — the refresh the guard tells the user to run must resolve." + (let ((pearl--account-context '(:name "work" :api-key "kw" :org-file "/tmp/w.org"))) + (with-temp-buffer + (insert "#+title: x\n#+LINEAR-SOURCE: (:type filter)\n" + "#+LINEAR-RUN-AT: 2020-01-01 00:00\n#+LINEAR-COUNT: 0\n" + "#+LINEAR-TRUNCATED: no\n* View\n") + (pearl--update-source-header 1 nil) + (should (string-equal "work" (pearl--read-buffer-account)))))) + +(ert-deftest test-pearl-update-source-header-leaves-existing-account () + "A file already stamped keeps its marker untouched on refresh." + (let ((pearl--account-context '(:name "work" :api-key "kw" :org-file "/tmp/w.org"))) + (with-temp-buffer + (insert "#+title: x\n#+LINEAR-ACCOUNT: work\n#+LINEAR-SOURCE: (:type filter)\n" + "#+LINEAR-RUN-AT: 2020-01-01 00:00\n#+LINEAR-COUNT: 0\n" + "#+LINEAR-TRUNCATED: no\n* View\n") + (pearl--update-source-header 1 nil) + (should (string-equal "work" (pearl--read-buffer-account))) + ;; exactly one marker, not duplicated + (should (= 1 (count-matches "^#\\+LINEAR-ACCOUNT:" (point-min) (point-max))))))) + +(ert-deftest test-pearl-update-source-header-legacy-mode-no-stamp () + "In legacy mode (no bound context) refresh adds no account marker." + (let ((pearl--account-context nil)) + (with-temp-buffer + (insert "#+title: x\n#+LINEAR-SOURCE: (:type filter)\n" + "#+LINEAR-RUN-AT: 2020-01-01 00:00\n#+LINEAR-COUNT: 0\n" + "#+LINEAR-TRUNCATED: no\n* View\n") + (pearl--update-source-header 1 nil) + (should (null (pearl--read-buffer-account)))))) + +(provide 'test-pearl-accounts) +;;; test-pearl-accounts.el ends here |
