aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCraig Jennings <c@cjennings.net>2026-05-17 14:11:21 -0500
committerCraig Jennings <c@cjennings.net>2026-05-17 14:11:21 -0500
commit54d231be98bdde220355102abb8b37f3740db74d (patch)
treedbecd1198dc0965bc1cf7f207332c14d808ef436
parent2b61aa82afa39a0ff1b165fa9ff09d55d21bfabf (diff)
downloaddotemacs-54d231be98bdde220355102abb8b37f3740db74d.tar.gz
dotemacs-54d231be98bdde220355102abb8b37f3740db74d.zip
feat(ai-mcp): add pure-helper foundation with tests
First of nine phases for wiring mcp.el into GPTel. I scoped this phase to sections 1 (constants and defcustoms) and 3 (pure helpers) of the seven-section outline in the design doc. The other five sections ship in later phases. The module loads only under the test harness for now. init.el wiring waits for Phase 4. What I added: - cj/mcp-server-specs defconst: secret-free description of the 9 servers (linear, notion, figma, slack-deepsat, drawio, google-calendar, google-docs-personal, google-docs-work, google-keep). - Seven defcustoms: claude-config path, enabled-servers list, start-on-entry-points scope, two timeouts, per-tool confirm overrides, audit-log toggle. - cj/mcp--read-claude-config with an mtime cache and structured (:ok t/nil :reason ...) returns. - cj/mcp--get-server-entry, get-env, and get-secret-arg for pulling server data from the parsed config (figma's API key lives in args, not env). - cj/mcp--build-server-alist: pure transformer from specs plus config to the alist mcp-hub-servers expects. - cj/mcp--confirm-p classifier with write-pattern, read-pattern, and unknown-fails-closed branches, plus a cj/mcp-tool-confirm-overrides alist override. - cj/mcp--normalize-description prefixing tool descriptions with [SERVER], [SERVER WRITE], or [SERVER ?]. - cj/mcp--redact masking --token, --secret, --password, and --figma-api-key flags, Authorization headers, and ?token= URL params. Tests in tests/test-ai-mcp-helpers.el (41 ERT tests, all green): fixtures via make-temp-file, no real ~/.claude.json reads, no subprocesses, no network. Sentinel REDACTED_TEST_SECRET never appears in any redactor output. Design doc: docs/design/mcp-el-gptel-integration.org
-rw-r--r--modules/ai-mcp.el416
-rw-r--r--tests/test-ai-mcp-helpers.el419
2 files changed, 835 insertions, 0 deletions
diff --git a/modules/ai-mcp.el b/modules/ai-mcp.el
new file mode 100644
index 00000000..3b552d8d
--- /dev/null
+++ b/modules/ai-mcp.el
@@ -0,0 +1,416 @@
+;;; ai-mcp.el --- MCP server integration for GPTel -*- lexical-binding: t; coding: utf-8; -*-
+;; Author: Craig Jennings <c@cjennings.net>
+;; Maintainer: Craig Jennings <c@cjennings.net>
+;; Version 0.1
+;; Package-Requires: ((emacs "30.1") (mcp "0.1.0") (gptel "0.9.8"))
+;; Keywords: convenience, tools, ai
+;;
+;;; Commentary:
+;; Wires mcp.el's MCP server inventory into GPTel. GPTel agents gain
+;; access to the MCP servers Claude Code already uses (linear, notion,
+;; figma, slack-deepsat, drawio, google-calendar, google-docs-personal,
+;; google-docs-work, google-keep), with write-confirmation gating and a
+;; doctor for diagnosing prerequisites.
+;;
+;; Design doc: docs/design/mcp-el-gptel-integration.org
+;;
+;; File organization (seven sections, populated by phases):
+;; 1. Constants and defcustoms <- this phase
+;; 2. Public commands <- later phase
+;; 3. Pure helpers <- this phase
+;; 4. mcp.el compatibility layer <- later phase
+;; 5. Registration pipeline <- later phase
+;; 6. Async state machine <- later phase
+;; 7. UI <- later phase
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'json)
+
+;;;; --- 1. Constants and defcustoms -----------------------------------
+
+(defgroup cj/ai-mcp nil
+ "MCP server integration for GPTel."
+ :group 'gptel
+ :prefix "cj/")
+
+(defcustom cj/mcp-claude-config
+ (expand-file-name "~/.claude.json")
+ "Path to the Claude Code config that holds MCP server env vars.
+The config is read at server-spawn time and cached by mtime."
+ :type 'file
+ :group 'cj/ai-mcp)
+
+(defconst cj/mcp-server-specs
+ '((:name "linear"
+ :transport http
+ :url "https://mcp.linear.app/mcp"
+ :auth in-protocol
+ :risk write-capable)
+ (:name "notion"
+ :transport http
+ :url "https://mcp.notion.com/mcp"
+ :auth in-protocol
+ :risk write-capable)
+ (:name "figma"
+ :transport stdio
+ :command "npx"
+ :args ("-y" "figma-developer-mcp" "--stdio")
+ :secret-args ("--figma-api-key" :figma-api-key)
+ :auth args-token
+ :risk arg-leak)
+ (:name "slack-deepsat"
+ :transport sse
+ :url "http://127.0.0.1:13080/sse"
+ :auth local
+ :risk write-capable)
+ (:name "drawio"
+ :transport stdio
+ :command "npx"
+ :args ("-y" "@drawio/mcp")
+ :auth none
+ :risk none)
+ (:name "google-calendar"
+ :transport stdio
+ :command "npx"
+ :args ("-y" "@cocal/google-calendar-mcp")
+ :env (:GOOGLE_OAUTH_CREDENTIALS t)
+ :auth oauth
+ :risk write-capable)
+ (:name "google-docs-personal"
+ :transport stdio
+ :command "npx"
+ :args ("-y" "@a-bonus/google-docs-mcp")
+ :env (:GOOGLE_CLIENT_ID t :GOOGLE_CLIENT_SECRET t :GOOGLE_MCP_PROFILE t)
+ :auth oauth
+ :risk write-capable)
+ (:name "google-docs-work"
+ :transport stdio
+ :command "npx"
+ :args ("-y" "@a-bonus/google-docs-mcp")
+ :env (:GOOGLE_CLIENT_ID t :GOOGLE_CLIENT_SECRET t :GOOGLE_MCP_PROFILE t)
+ :auth oauth
+ :risk write-capable)
+ (:name "google-keep"
+ :transport stdio
+ :command "uvx"
+ :args ("--from" "keep-mcp" "python" "-m" "server.cli")
+ :env (:GOOGLE_EMAIL t :GOOGLE_MASTER_TOKEN t)
+ :auth token
+ :risk write-capable))
+ "Static, secret-free description of the MCP servers we wire to GPTel.
+Each entry is a plist describing one server. `:env' values are
+placeholders (t) replaced at spawn time from `cj/mcp-claude-config'.
+`:secret-args' (e.g. for figma) names the flag whose value is pulled
+from the Claude config's args at spawn time.")
+
+(defcustom cj/mcp-enabled-servers
+ (mapcar (lambda (s) (plist-get s :name)) cj/mcp-server-specs)
+ "List of MCP server names to start.
+Defaults to every server in `cj/mcp-server-specs'. Set to a
+shorter list to disable specific servers without editing the
+spec. Changes take effect on next `cj/mcp-restart-failed' or
+Emacs restart."
+ :type '(repeat string)
+ :group 'cj/ai-mcp)
+
+(defcustom cj/mcp-start-on-entry-points
+ '(toggle-gptel)
+ "GPTel entry points that trigger MCP startup.
+Symbols correspond to commands: `toggle-gptel', `gptel-send',
+`gptel-quick-ask', `gptel-rewrite-with-directive',
+`gptel-magit-generate-message'. Default: only full chat
+\(`toggle-gptel')."
+ :type '(repeat symbol)
+ :group 'cj/ai-mcp)
+
+(defcustom cj/mcp-startup-timeout 30
+ "Seconds before a still-starting MCP server is marked failed."
+ :type 'integer
+ :group 'cj/ai-mcp)
+
+(defcustom cj/mcp-tool-timeout 60
+ "Seconds before an in-flight MCP tool call times out."
+ :type 'integer
+ :group 'cj/ai-mcp)
+
+(defcustom cj/mcp-tool-confirm-overrides nil
+ "Per-tool confirmation overrides.
+Alist mapping fully qualified MCP tool name (e.g.,
+\"mcp__linear__create_issue\") to t or nil. Wins over the
+pattern-based classifier in `cj/mcp--confirm-p'."
+ :type '(alist :key-type string :value-type boolean)
+ :group 'cj/ai-mcp)
+
+(defcustom cj/mcp-tool-audit-log-enabled t
+ "When non-nil, append metadata for every MCP tool call to the audit log."
+ :type 'boolean
+ :group 'cj/ai-mcp)
+
+;; Classifier patterns: name prefixes that indicate read vs write.
+
+(defconst cj/mcp--write-name-patterns
+ '("\\`create\\b" "\\`update\\b" "\\`delete\\b" "\\`remove\\b"
+ "\\`send\\b" "\\`post\\b" "\\`add\\b" "\\`move\\b"
+ "\\`invite\\b" "\\`share\\b" "\\`upload\\b" "\\`set\\b"
+ "\\`patch\\b" "\\`import\\b" "\\`sync\\b" "\\`merge\\b"
+ "\\`close\\b" "\\`reopen\\b" "\\`archive\\b" "\\`unarchive\\b"
+ "\\`approve\\b" "\\`reject\\b" "\\`label\\b" "\\`assign\\b"
+ "\\`reply\\b" "\\`comment\\b" "\\`trash\\b" "\\`restore\\b"
+ "\\`pin\\b" "\\`unpin\\b" "\\`copy\\b" "\\`rename\\b")
+ "Tool-name prefixes that indicate a write/mutate operation.
+Matched after the `mcp__SERVER__' prefix is stripped.")
+
+(defconst cj/mcp--read-name-patterns
+ '("\\`get\\b" "\\`list\\b" "\\`read\\b" "\\`search\\b"
+ "\\`find\\b" "\\`fetch\\b" "\\`view\\b" "\\`query\\b"
+ "\\`describe\\b" "\\`show\\b" "\\`check\\b")
+ "Tool-name prefixes that indicate a read-only operation.")
+
+;; Secret-pattern list for redaction. Each entry is (REGEX
+;; . GROUP-NUMBER); the substring matched by GROUP-NUMBER is replaced
+;; with "***".
+
+(defconst cj/mcp--secret-redaction-patterns
+ '(("\\(--token\\)\\(=\\|\\s-+\\)\\(\\S-+\\)" . 3)
+ ("\\(--secret\\)\\(=\\|\\s-+\\)\\(\\S-+\\)" . 3)
+ ("\\(--password\\)\\(=\\|\\s-+\\)\\(\\S-+\\)" . 3)
+ ("\\(--figma-api-key\\)\\(=\\|\\s-+\\)\\(\\S-+\\)" . 3)
+ ("\\(Authorization:\\s-*\\)\\(\\S-[^\"\n]*\\)" . 2)
+ ("\\([?&]token=\\)\\([^&[:space:]\"]+\\)" . 2))
+ "List of (REGEX . GROUP-NUMBER) for masking secrets in user-facing strings.
+Applied in order by `cj/mcp--redact'.")
+
+;;;; --- 3. Pure helpers -----------------------------------------------
+
+;; ---- secrets redaction ----
+
+(defun cj/mcp--redact (str)
+ "Return STR with known secret patterns replaced by `***'.
+Returns nil when STR is not a string. See
+`cj/mcp--secret-redaction-patterns' for the matched patterns."
+ (when (stringp str)
+ (let ((result str))
+ (dolist (entry cj/mcp--secret-redaction-patterns result)
+ (let ((re (car entry))
+ (group (cdr entry))
+ (start 0))
+ (while (and (< start (length result))
+ (string-match re result start))
+ (setq result
+ (concat (substring result 0 (match-beginning group))
+ "***"
+ (substring result (match-end group))))
+ (setq start (+ (match-beginning group) 3))))))))
+
+;; ---- confirm-policy classifier ----
+
+(defun cj/mcp--strip-name-prefix (name)
+ "Strip the `mcp__SERVER__' prefix from NAME, if present."
+ (replace-regexp-in-string "\\`mcp__[^_]+__" "" name))
+
+(defun cj/mcp--name-matches-p (name patterns)
+ "Non-nil if NAME matches any regexp in PATTERNS."
+ (cl-some (lambda (p) (string-match-p p name)) patterns))
+
+(defun cj/mcp--confirm-p (gptel-name &optional remote-name)
+ "Return non-nil if a tool should register with `:confirm t'.
+GPTEL-NAME is the fully qualified `mcp__SERVER__TOOL' string.
+REMOTE-NAME, if provided, overrides the prefix-strip of GPTEL-NAME.
+
+Decision order:
+1. `cj/mcp-tool-confirm-overrides' alist entry wins.
+2. Bare name matches a write pattern → t.
+3. Bare name matches a read pattern → nil.
+4. Neither → t (fail closed)."
+ (let ((override (assoc gptel-name cj/mcp-tool-confirm-overrides)))
+ (cond
+ (override (cdr override))
+ (t
+ (let ((bare (or remote-name (cj/mcp--strip-name-prefix gptel-name))))
+ (cond
+ ((cj/mcp--name-matches-p bare cj/mcp--write-name-patterns) t)
+ ((cj/mcp--name-matches-p bare cj/mcp--read-name-patterns) nil)
+ (t t)))))))
+
+;; ---- description normalizer ----
+
+(defun cj/mcp--normalize-description (server-name raw-tool)
+ "Return a normalized description string for RAW-TOOL from SERVER-NAME.
+Prefix `[SERVER]' for reads, `[SERVER WRITE]' for writes,
+`[SERVER ?]' for unknown classification, then the upstream
+description unchanged."
+ (let* ((remote-name (plist-get raw-tool :name))
+ (upstream (or (plist-get raw-tool :description)
+ "(no description provided by server)"))
+ (suffix (cond
+ ((cj/mcp--name-matches-p remote-name
+ cj/mcp--write-name-patterns)
+ " WRITE")
+ ((cj/mcp--name-matches-p remote-name
+ cj/mcp--read-name-patterns)
+ "")
+ (t " ?"))))
+ (format "[%s%s] %s" server-name suffix upstream)))
+
+;; ---- Claude config reader (mtime-cached, structured returns) ----
+
+(defvar cj/mcp--config-cache nil
+ "Cache for the parsed Claude config.
+Plist of (:path P :mtime M :data PARSED) or nil when empty.")
+
+(defun cj/mcp--invalidate-config-cache ()
+ "Force the next `cj/mcp--read-claude-config' call to reparse."
+ (setq cj/mcp--config-cache nil))
+
+(defun cj/mcp--read-claude-config (&optional path)
+ "Return a structured plist describing the Claude config state.
+PATH defaults to `cj/mcp-claude-config'.
+
+Result shape:
+ (:ok t :data PLIST)
+ (:ok nil :reason missing-file)
+ (:ok nil :reason unreadable)
+ (:ok nil :reason malformed-json :message STR)
+
+The parsed result is cached by (PATH, MTIME); subsequent calls
+reparse only if the file has changed."
+ (let ((path (or path cj/mcp-claude-config)))
+ (cond
+ ((not (file-exists-p path))
+ (list :ok nil :reason 'missing-file))
+ ((not (file-readable-p path))
+ (list :ok nil :reason 'unreadable))
+ (t
+ (let ((mtime (file-attribute-modification-time
+ (file-attributes path))))
+ (if (and cj/mcp--config-cache
+ (equal (plist-get cj/mcp--config-cache :path) path)
+ (equal (plist-get cj/mcp--config-cache :mtime) mtime))
+ (list :ok t :data (plist-get cj/mcp--config-cache :data))
+ (condition-case err
+ (let* ((json-object-type 'plist)
+ (json-array-type 'list)
+ (data (with-temp-buffer
+ (insert-file-contents path)
+ (goto-char (point-min))
+ (json-read))))
+ (setq cj/mcp--config-cache
+ (list :path path :mtime mtime :data data))
+ (list :ok t :data data))
+ (error
+ (setq cj/mcp--config-cache nil)
+ (list :ok nil :reason 'malformed-json
+ :message (error-message-string err))))))))))
+
+;; ---- env / secret-args resolution ----
+
+(defun cj/mcp--get-server-entry (server-name &optional config-result)
+ "Return the parsed Claude-config entry plist for SERVER-NAME.
+CONFIG-RESULT, if provided, is a return value from
+`cj/mcp--read-claude-config' (avoids re-reading). Returns nil
+when the config is unavailable or SERVER-NAME is unknown."
+ (let ((result (or config-result (cj/mcp--read-claude-config))))
+ (when (plist-get result :ok)
+ (let* ((data (plist-get result :data))
+ (servers (plist-get data :mcpServers))
+ (server-key (intern (concat ":" server-name))))
+ (plist-get servers server-key)))))
+
+(defun cj/mcp--get-env (server-name &optional config-result)
+ "Return the env plist for SERVER-NAME from the parsed Claude config.
+CONFIG-RESULT, if provided, is reused to avoid re-reading the
+config. Returns nil when the config is unavailable, the server
+is unknown, or the server has no env section."
+ (plist-get (cj/mcp--get-server-entry server-name config-result) :env))
+
+(defun cj/mcp--get-secret-arg (server-name flag &optional config-result)
+ "Return the secret value for SERVER-NAME's FLAG from the Claude config.
+FLAG is the option name (e.g. \"--figma-api-key\"). Returns the
+value following `FLAG=' in the server entry's args, or nil if
+not found."
+ (let* ((entry (cj/mcp--get-server-entry server-name config-result))
+ (args (plist-get entry :args))
+ (prefix (concat flag "=")))
+ (cl-some
+ (lambda (a)
+ (when (and (stringp a) (string-prefix-p prefix a))
+ (substring a (length prefix))))
+ args)))
+
+;; ---- server-alist builder (pure transform from specs + config) ----
+
+(defun cj/mcp--resolve-env (env-spec server-name config-result)
+ "Return a flat (KEY1 VAL1 KEY2 VAL2 ...) list for ENV-SPEC.
+ENV-SPEC is a plist of `(:VAR1 t :VAR2 t)`. Values come from
+SERVER-NAME's env subtree in the parsed Claude config. Vars
+without a value are omitted."
+ (let ((source-env (cj/mcp--get-env server-name config-result))
+ (result nil))
+ (cl-loop for (key _placeholder) on env-spec by #'cddr
+ do (let ((value (plist-get source-env key)))
+ (when value
+ (push key result)
+ (push value result))))
+ (nreverse result)))
+
+(defun cj/mcp--resolve-args (args secret-args-spec server-name config-result)
+ "Return ARGS with `:secret-args' placeholders filled in.
+SECRET-ARGS-SPEC is (FLAG-STRING SLOT-KEYWORD). When the value is
+available in the Claude config, append `FLAG=VALUE' to ARGS;
+otherwise return ARGS unchanged."
+ (if (not secret-args-spec)
+ args
+ (let* ((flag (car secret-args-spec))
+ (value (cj/mcp--get-secret-arg server-name flag config-result)))
+ (if value
+ (append args (list (format "%s=%s" flag value)))
+ args))))
+
+(defun cj/mcp--spec-to-alist-entry (spec config-result)
+ "Translate one SPEC plist into a `(NAME . PLIST)' alist entry.
+Pulls env values from CONFIG-RESULT; splices `:secret-args' into
+`:args' for stdio specs that declare one."
+ (let* ((name (plist-get spec :name))
+ (transport (plist-get spec :transport))
+ (entry (list :type (symbol-name transport)))
+ (env-spec (plist-get spec :env))
+ (secret-args-spec (plist-get spec :secret-args)))
+ (pcase transport
+ ('stdio
+ (setq entry (append entry
+ (list :command (plist-get spec :command)
+ :args (cj/mcp--resolve-args
+ (plist-get spec :args)
+ secret-args-spec
+ name
+ config-result)))))
+ ((or 'http 'sse)
+ (setq entry (append entry
+ (list :url (plist-get spec :url))))))
+ (when env-spec
+ (let ((env-pairs (cj/mcp--resolve-env env-spec name config-result)))
+ (when env-pairs
+ (setq entry (append entry (list :env env-pairs))))))
+ (cons name entry)))
+
+(defun cj/mcp--build-server-alist (&optional specs enabled-names config-result)
+ "Return an alist suitable for `mcp-hub-servers'.
+SPECS defaults to `cj/mcp-server-specs'. ENABLED-NAMES defaults
+to `cj/mcp-enabled-servers'. CONFIG-RESULT, if provided, is a
+parsed Claude-config result (reused for env/secret resolution).
+Does not mutate SPECS."
+ (let* ((specs (or specs cj/mcp-server-specs))
+ (enabled-names (or enabled-names cj/mcp-enabled-servers))
+ (config-result (or config-result (cj/mcp--read-claude-config))))
+ (delq nil
+ (mapcar
+ (lambda (spec)
+ (let ((name (plist-get spec :name)))
+ (when (member name enabled-names)
+ (cj/mcp--spec-to-alist-entry spec config-result))))
+ specs))))
+
+(provide 'ai-mcp)
+;;; ai-mcp.el ends here
diff --git a/tests/test-ai-mcp-helpers.el b/tests/test-ai-mcp-helpers.el
new file mode 100644
index 00000000..5a995ff2
--- /dev/null
+++ b/tests/test-ai-mcp-helpers.el
@@ -0,0 +1,419 @@
+;;; test-ai-mcp-helpers.el --- Tests for pure helpers in ai-mcp.el -*- lexical-binding: t; -*-
+
+;;; Commentary:
+;; Normal / Boundary / Error tests for the side-effect-free helpers in
+;; ai-mcp.el: secrets redaction, confirm-policy classifier, description
+;; normalizer, Claude-config reader (mtime-cached), env / secret-args
+;; resolution, server-alist builder. No real `~/.claude.json' reads;
+;; fixtures are written to per-test temp files. No real subprocesses
+;; or network calls.
+
+;;; Code:
+
+(require 'ert)
+(require 'cl-lib)
+
+(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory))
+(require 'ai-mcp)
+
+;; -------------------------------------------------------- fixtures
+
+(defconst test-ai-mcp--sentinel "REDACTED_TEST_SECRET"
+ "Sentinel that must never appear in any user-facing output.")
+
+(defconst test-ai-mcp--fixture-json
+ "{
+ \"mcpServers\": {
+ \"drawio\": {
+ \"type\": \"stdio\",
+ \"command\": \"npx\",
+ \"args\": [\"-y\", \"@drawio/mcp\"]
+ },
+ \"google-calendar\": {
+ \"type\": \"stdio\",
+ \"command\": \"npx\",
+ \"args\": [\"-y\", \"@cocal/google-calendar-mcp\"],
+ \"env\": {
+ \"GOOGLE_OAUTH_CREDENTIALS\": \"REDACTED_TEST_SECRET\"
+ }
+ },
+ \"google-docs-personal\": {
+ \"type\": \"stdio\",
+ \"command\": \"npx\",
+ \"args\": [\"-y\", \"@a-bonus/google-docs-mcp\"],
+ \"env\": {
+ \"GOOGLE_CLIENT_ID\": \"REDACTED_TEST_SECRET\",
+ \"GOOGLE_CLIENT_SECRET\": \"REDACTED_TEST_SECRET\",
+ \"GOOGLE_MCP_PROFILE\": \"personal\"
+ }
+ },
+ \"figma\": {
+ \"type\": \"stdio\",
+ \"command\": \"npx\",
+ \"args\": [\"-y\", \"figma-developer-mcp\", \"--figma-api-key=REDACTED_TEST_SECRET\", \"--stdio\"]
+ },
+ \"linear\": {
+ \"type\": \"http\",
+ \"url\": \"https://mcp.linear.app/mcp\"
+ },
+ \"slack-deepsat\": {
+ \"type\": \"sse\",
+ \"url\": \"http://127.0.0.1:13080/sse\"
+ }
+ }
+}"
+ "Fixture matching the shape of a real ~/.claude.json mcpServers tree.")
+
+(defun test-ai-mcp--write-fixture (&optional content)
+ "Write CONTENT (defaults to the standard fixture) to a temp file.
+Return the file path."
+ (let ((tmp (make-temp-file "test-ai-mcp-" nil ".json")))
+ (with-temp-file tmp
+ (insert (or content test-ai-mcp--fixture-json)))
+ tmp))
+
+(defmacro test-ai-mcp--with-fixture (var &rest body)
+ "Bind VAR to a fresh fixture file path and BODY-eval. Clean up after."
+ (declare (indent 1))
+ `(let ((,var (test-ai-mcp--write-fixture))
+ (cj/mcp--config-cache nil))
+ (unwind-protect (progn ,@body)
+ (when (file-exists-p ,var) (delete-file ,var)))))
+
+;; -------------------------------------------------------- redact
+
+(ert-deftest test-ai-mcp-redact-token-eq-normal ()
+ "Normal: --token=VALUE has the value replaced by ***."
+ (should (equal (cj/mcp--redact "--token=abc123") "--token=***")))
+
+(ert-deftest test-ai-mcp-redact-token-spaced-boundary ()
+ "Boundary: --token VALUE (space separator) is also redacted."
+ (should (equal (cj/mcp--redact "--token abc123") "--token ***")))
+
+(ert-deftest test-ai-mcp-redact-secret-flag-normal ()
+ "Normal: --secret=VALUE is redacted."
+ (should (equal (cj/mcp--redact "--secret=topsecret") "--secret=***")))
+
+(ert-deftest test-ai-mcp-redact-password-flag-normal ()
+ "Normal: --password=VALUE is redacted."
+ (should (equal (cj/mcp--redact "--password=hunter2") "--password=***")))
+
+(ert-deftest test-ai-mcp-redact-figma-api-key-normal ()
+ "Normal: --figma-api-key=VALUE is redacted (covers the figma case)."
+ (should (equal (cj/mcp--redact "--figma-api-key=figd_xyz")
+ "--figma-api-key=***")))
+
+(ert-deftest test-ai-mcp-redact-authorization-header-normal ()
+ "Normal: Authorization header value (scheme + token) is masked."
+ (should (equal (cj/mcp--redact "Authorization: Bearer ghp_xyz123")
+ "Authorization: ***")))
+
+(ert-deftest test-ai-mcp-redact-url-token-normal ()
+ "Normal: ?token=VALUE in a URL is masked."
+ (should (equal (cj/mcp--redact "https://api.example/v1?token=abc123&page=2")
+ "https://api.example/v1?token=***&page=2")))
+
+(ert-deftest test-ai-mcp-redact-no-secrets-boundary ()
+ "Boundary: a string with no known secrets is returned unchanged."
+ (should (equal (cj/mcp--redact "hello world, nothing secret here")
+ "hello world, nothing secret here")))
+
+(ert-deftest test-ai-mcp-redact-empty-string-boundary ()
+ "Boundary: empty string returns empty string."
+ (should (equal (cj/mcp--redact "") "")))
+
+(ert-deftest test-ai-mcp-redact-multiple-secrets-boundary ()
+ "Boundary: multiple secrets in one string are all redacted."
+ (let* ((input "--token=abc --secret=xyz --password=qwe")
+ (out (cj/mcp--redact input)))
+ (should (equal out "--token=*** --secret=*** --password=***"))))
+
+(ert-deftest test-ai-mcp-redact-nil-input-error ()
+ "Error: nil input returns nil rather than signaling."
+ (should (null (cj/mcp--redact nil))))
+
+(ert-deftest test-ai-mcp-redact-sentinel-never-leaks ()
+ "Sentinel REDACTED_TEST_SECRET is replaced wherever it lives in a secret slot."
+ (dolist (input (list (format "--token=%s" test-ai-mcp--sentinel)
+ (format "--figma-api-key=%s" test-ai-mcp--sentinel)
+ (format "Authorization: Bearer %s" test-ai-mcp--sentinel)
+ (format "https://x/y?token=%s" test-ai-mcp--sentinel)))
+ (let ((out (cj/mcp--redact input)))
+ (should-not (string-match-p test-ai-mcp--sentinel out)))))
+
+;; -------------------------------------------------------- confirm-p
+
+(ert-deftest test-ai-mcp-confirm-p-write-pattern-normal ()
+ "Normal: a write-prefixed tool name returns t."
+ (should (cj/mcp--confirm-p "mcp__linear__create_issue")))
+
+(ert-deftest test-ai-mcp-confirm-p-read-pattern-normal ()
+ "Normal: a read-prefixed tool name returns nil."
+ (should-not (cj/mcp--confirm-p "mcp__linear__list_issues")))
+
+(ert-deftest test-ai-mcp-confirm-p-unknown-fails-closed-boundary ()
+ "Boundary: a name matching neither read nor write defaults to t (fail closed)."
+ (should (cj/mcp--confirm-p "mcp__linear__frobnicate")))
+
+(ert-deftest test-ai-mcp-confirm-p-explicit-remote-name-boundary ()
+ "Boundary: REMOTE-NAME arg overrides the prefix-strip of GPTEL-NAME."
+ ;; The gptel-name claims read, but the explicit remote-name is a write
+ ;; verb, so confirm should still fire.
+ (should (cj/mcp--confirm-p "mcp__linear__list_issues" "create_issue")))
+
+(ert-deftest test-ai-mcp-confirm-p-override-wins-boundary ()
+ "Boundary: cj/mcp-tool-confirm-overrides wins over the classifier."
+ (let ((cj/mcp-tool-confirm-overrides
+ '(("mcp__linear__create_issue" . nil))))
+ (should-not (cj/mcp--confirm-p "mcp__linear__create_issue"))))
+
+;; -------------------------------------------------------- normalize-description
+
+(ert-deftest test-ai-mcp-normalize-description-read-normal ()
+ "Normal: a read tool gets the bare [SERVER] prefix."
+ (should (equal
+ (cj/mcp--normalize-description
+ "linear"
+ '(:name "list_issues" :description "List issues in a Linear team."))
+ "[linear] List issues in a Linear team.")))
+
+(ert-deftest test-ai-mcp-normalize-description-write-normal ()
+ "Normal: a write tool gets [SERVER WRITE] prefix."
+ (should (equal
+ (cj/mcp--normalize-description
+ "linear"
+ '(:name "create_issue" :description "Create a new Linear issue."))
+ "[linear WRITE] Create a new Linear issue.")))
+
+(ert-deftest test-ai-mcp-normalize-description-unknown-boundary ()
+ "Boundary: a tool matching neither classifier gets [SERVER ?] prefix."
+ (should (equal
+ (cj/mcp--normalize-description
+ "google-keep"
+ '(:name "frobnicate" :description "Do the frob thing."))
+ "[google-keep ?] Do the frob thing.")))
+
+(ert-deftest test-ai-mcp-normalize-description-missing-upstream-boundary ()
+ "Boundary: missing upstream description falls back to a placeholder."
+ (should (equal
+ (cj/mcp--normalize-description
+ "linear"
+ '(:name "list_issues"))
+ "[linear] (no description provided by server)")))
+
+;; -------------------------------------------------------- read-claude-config
+
+(ert-deftest test-ai-mcp-read-claude-config-good-fixture-normal ()
+ "Normal: parsing a well-formed fixture returns :ok t and the parsed data."
+ (test-ai-mcp--with-fixture path
+ (let ((result (cj/mcp--read-claude-config path)))
+ (should (plist-get result :ok))
+ (should (plist-get (plist-get result :data) :mcpServers)))))
+
+(ert-deftest test-ai-mcp-read-claude-config-missing-file-error ()
+ "Error: missing file returns :ok nil with :reason missing-file."
+ (let ((cj/mcp--config-cache nil)
+ (path "/nonexistent/path/never-will-exist.json"))
+ (let ((result (cj/mcp--read-claude-config path)))
+ (should-not (plist-get result :ok))
+ (should (eq (plist-get result :reason) 'missing-file)))))
+
+(ert-deftest test-ai-mcp-read-claude-config-malformed-json-error ()
+ "Error: malformed JSON returns :ok nil with :reason malformed-json and a message."
+ (let ((cj/mcp--config-cache nil)
+ (tmp (make-temp-file "test-ai-mcp-malformed-" nil ".json")))
+ (unwind-protect
+ (progn
+ (with-temp-file tmp (insert "{ this is not valid json ::: "))
+ (let ((result (cj/mcp--read-claude-config tmp)))
+ (should-not (plist-get result :ok))
+ (should (eq (plist-get result :reason) 'malformed-json))
+ (should (stringp (plist-get result :message)))))
+ (delete-file tmp))))
+
+(ert-deftest test-ai-mcp-read-claude-config-empty-object-boundary ()
+ "Boundary: an empty JSON object parses to ok with empty data plist."
+ (let ((cj/mcp--config-cache nil)
+ (tmp (make-temp-file "test-ai-mcp-empty-" nil ".json")))
+ (unwind-protect
+ (progn
+ (with-temp-file tmp (insert "{}"))
+ (let ((result (cj/mcp--read-claude-config tmp)))
+ (should (plist-get result :ok))
+ ;; :mcpServers is absent; plist-get returns nil.
+ (should-not (plist-get (plist-get result :data) :mcpServers))))
+ (delete-file tmp))))
+
+(ert-deftest test-ai-mcp-read-claude-config-cache-hit-boundary ()
+ "Boundary: a second read with the same mtime reuses the cache.
+We detect cache reuse by mutating the cached :data alist after the first
+read and verifying the second read returns the mutated value."
+ (test-ai-mcp--with-fixture path
+ (let* ((first (cj/mcp--read-claude-config path))
+ (cache cj/mcp--config-cache))
+ (should (plist-get first :ok))
+ ;; Mutate the cached :data so a cache-hit returns the marker.
+ (plist-put cache :data '(:sentinel cache-was-hit))
+ (let ((second (cj/mcp--read-claude-config path)))
+ (should (equal (plist-get second :data) '(:sentinel cache-was-hit)))))))
+
+(ert-deftest test-ai-mcp-read-claude-config-cache-invalidate-on-mtime-boundary ()
+ "Boundary: changing the file's mtime forces a reparse."
+ (test-ai-mcp--with-fixture path
+ (let* ((first (cj/mcp--read-claude-config path))
+ (cache cj/mcp--config-cache))
+ (should (plist-get first :ok))
+ ;; Poison the cache, then bump mtime; the next read should reparse.
+ (plist-put cache :data '(:sentinel cache-was-hit))
+ (set-file-times path (time-add (current-time) 2))
+ ;; Update the cache var since set-file-times changed file mtime.
+ (setq cj/mcp--config-cache cache)
+ (let ((second (cj/mcp--read-claude-config path)))
+ ;; Real reparse should give us the real data, not the sentinel.
+ (should (plist-get (plist-get second :data) :mcpServers))))))
+
+(ert-deftest test-ai-mcp-read-claude-config-missing-mcpservers-boundary ()
+ "Boundary: a valid JSON without :mcpServers parses but the subtree is nil."
+ (let ((cj/mcp--config-cache nil)
+ (tmp (make-temp-file "test-ai-mcp-no-mcp-" nil ".json")))
+ (unwind-protect
+ (progn
+ (with-temp-file tmp (insert "{\"other\": 1}"))
+ (let ((result (cj/mcp--read-claude-config tmp)))
+ (should (plist-get result :ok))
+ (should-not (plist-get (plist-get result :data) :mcpServers))))
+ (delete-file tmp))))
+
+;; -------------------------------------------------------- get-env / get-secret-arg
+
+(ert-deftest test-ai-mcp-get-env-known-server-with-env-normal ()
+ "Normal: env-bearing server returns its env plist."
+ (test-ai-mcp--with-fixture path
+ (let* ((cj/mcp-claude-config path)
+ (env (cj/mcp--get-env "google-calendar")))
+ (should (equal (plist-get env :GOOGLE_OAUTH_CREDENTIALS)
+ test-ai-mcp--sentinel)))))
+
+(ert-deftest test-ai-mcp-get-env-known-server-without-env-boundary ()
+ "Boundary: a server with no env subtree returns nil."
+ (test-ai-mcp--with-fixture path
+ (let* ((cj/mcp-claude-config path))
+ (should-not (cj/mcp--get-env "drawio")))))
+
+(ert-deftest test-ai-mcp-get-env-unknown-server-error ()
+ "Error: unknown server returns nil without signaling."
+ (test-ai-mcp--with-fixture path
+ (let* ((cj/mcp-claude-config path))
+ (should-not (cj/mcp--get-env "no-such-server")))))
+
+(ert-deftest test-ai-mcp-get-secret-arg-figma-normal ()
+ "Normal: figma's --figma-api-key= value is extracted from args."
+ (test-ai-mcp--with-fixture path
+ (let* ((cj/mcp-claude-config path)
+ (value (cj/mcp--get-secret-arg "figma" "--figma-api-key")))
+ (should (equal value test-ai-mcp--sentinel)))))
+
+(ert-deftest test-ai-mcp-get-secret-arg-missing-flag-error ()
+ "Error: a flag not in the server's args returns nil."
+ (test-ai-mcp--with-fixture path
+ (let* ((cj/mcp-claude-config path)
+ (value (cj/mcp--get-secret-arg "figma" "--no-such-flag")))
+ (should (null value)))))
+
+;; -------------------------------------------------------- build-server-alist
+
+(ert-deftest test-ai-mcp-build-server-alist-all-enabled-normal ()
+ "Normal: with default specs and all-enabled list, alist has all 9 entries."
+ (test-ai-mcp--with-fixture path
+ (let* ((cj/mcp-claude-config path)
+ (alist (cj/mcp--build-server-alist)))
+ (should (= (length alist) 9))
+ ;; Every name appears.
+ (dolist (name '("linear" "notion" "figma" "slack-deepsat" "drawio"
+ "google-calendar" "google-docs-personal"
+ "google-docs-work" "google-keep"))
+ (should (assoc name alist))))))
+
+(ert-deftest test-ai-mcp-build-server-alist-filter-by-enabled-boundary ()
+ "Boundary: enabled subset of names produces a subset alist."
+ (test-ai-mcp--with-fixture path
+ (let* ((cj/mcp-claude-config path)
+ (alist (cj/mcp--build-server-alist
+ cj/mcp-server-specs
+ '("drawio" "linear"))))
+ (should (= (length alist) 2))
+ (should (assoc "drawio" alist))
+ (should (assoc "linear" alist))
+ (should-not (assoc "figma" alist)))))
+
+(ert-deftest test-ai-mcp-build-server-alist-stdio-shape-normal ()
+ "Normal: a stdio entry has :type, :command, :args (no :url)."
+ (test-ai-mcp--with-fixture path
+ (let* ((cj/mcp-claude-config path)
+ (alist (cj/mcp--build-server-alist
+ cj/mcp-server-specs '("drawio"))))
+ (let ((entry (cdr (assoc "drawio" alist))))
+ (should (equal (plist-get entry :type) "stdio"))
+ (should (equal (plist-get entry :command) "npx"))
+ (should (listp (plist-get entry :args)))
+ (should-not (plist-get entry :url))))))
+
+(ert-deftest test-ai-mcp-build-server-alist-http-shape-normal ()
+ "Normal: an http entry has :type and :url (no :command)."
+ (test-ai-mcp--with-fixture path
+ (let* ((cj/mcp-claude-config path)
+ (alist (cj/mcp--build-server-alist
+ cj/mcp-server-specs '("linear"))))
+ (let ((entry (cdr (assoc "linear" alist))))
+ (should (equal (plist-get entry :type) "http"))
+ (should (equal (plist-get entry :url) "https://mcp.linear.app/mcp"))
+ (should-not (plist-get entry :command))))))
+
+(ert-deftest test-ai-mcp-build-server-alist-sse-shape-normal ()
+ "Normal: an sse entry has :type and :url."
+ (test-ai-mcp--with-fixture path
+ (let* ((cj/mcp-claude-config path)
+ (alist (cj/mcp--build-server-alist
+ cj/mcp-server-specs '("slack-deepsat"))))
+ (let ((entry (cdr (assoc "slack-deepsat" alist))))
+ (should (equal (plist-get entry :type) "sse"))
+ (should (equal (plist-get entry :url)
+ "http://127.0.0.1:13080/sse"))))))
+
+(ert-deftest test-ai-mcp-build-server-alist-env-merge-normal ()
+ "Normal: env-bearing server has its env plist merged into the entry."
+ (test-ai-mcp--with-fixture path
+ (let* ((cj/mcp-claude-config path)
+ (alist (cj/mcp--build-server-alist
+ cj/mcp-server-specs '("google-calendar"))))
+ (let* ((entry (cdr (assoc "google-calendar" alist)))
+ (env (plist-get entry :env)))
+ (should env)
+ (should (equal (plist-get env :GOOGLE_OAUTH_CREDENTIALS)
+ test-ai-mcp--sentinel))))))
+
+(ert-deftest test-ai-mcp-build-server-alist-secret-args-splice-normal ()
+ "Normal: figma's --figma-api-key= is spliced into :args from Claude config."
+ (test-ai-mcp--with-fixture path
+ (let* ((cj/mcp-claude-config path)
+ (alist (cj/mcp--build-server-alist
+ cj/mcp-server-specs '("figma"))))
+ (let* ((entry (cdr (assoc "figma" alist)))
+ (args (plist-get entry :args))
+ (api-arg (cl-find-if
+ (lambda (a) (string-prefix-p "--figma-api-key=" a))
+ args)))
+ (should api-arg)
+ (should (equal api-arg (format "--figma-api-key=%s"
+ test-ai-mcp--sentinel)))))))
+
+(ert-deftest test-ai-mcp-build-server-alist-no-mutation-boundary ()
+ "Boundary: building the alist does not mutate `cj/mcp-server-specs'."
+ (test-ai-mcp--with-fixture path
+ (let* ((cj/mcp-claude-config path)
+ (snapshot (copy-tree cj/mcp-server-specs)))
+ (cj/mcp--build-server-alist)
+ (should (equal cj/mcp-server-specs snapshot)))))
+
+(provide 'test-ai-mcp-helpers)
+;;; test-ai-mcp-helpers.el ends here