diff options
| -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 |