diff options
| -rw-r--r-- | modules/ai-mcp.el | 416 | ||||
| -rw-r--r-- | tests/test-ai-mcp-helpers.el | 419 |
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 |