diff --git a/bb.edn b/bb.edn index fe5cede..cc6f329 100644 --- a/bb.edn +++ b/bb.edn @@ -13,6 +13,7 @@ (require '[eca-cli.chat-test]) (require '[eca-cli.commands-test]) (require '[eca-cli.lifecycle-test]) + (require '[eca-cli.mcp-test]) (require '[eca-cli.protocol-test]) (require '[eca-cli.view-test]) (require '[eca-cli.view.blocks-test]) @@ -23,6 +24,7 @@ (clojure.test/run-tests 'eca-cli.chat-test 'eca-cli.commands-test 'eca-cli.lifecycle-test + 'eca-cli.mcp-test 'eca-cli.protocol-test 'eca-cli.view-test 'eca-cli.view.blocks-test diff --git a/src/eca_cli/commands.clj b/src/eca_cli/commands.clj index fe36c0a..d92d92e 100644 --- a/src/eca_cli/commands.clj +++ b/src/eca_cli/commands.clj @@ -10,6 +10,7 @@ [eca-cli.sessions :as sessions] [eca-cli.picker :as picker] [eca-cli.login :as login] + [eca-cli.mcp :as mcp] [eca-cli.view :as view])) (declare command-registry) @@ -67,6 +68,7 @@ (def command-registry {"/model" {:doc "Open model picker" :handler cmd-open-model-picker} "/agent" {:doc "Open agent picker" :handler cmd-open-agent-picker} + "/mcp" {:doc "View MCP server status" :handler mcp/cmd-open-mcp-panel} "/new" {:doc "Start a fresh chat" :handler cmd-new-chat} "/sessions" {:doc "Browse and resume previous chats" :handler cmd-list-sessions} "/clear" {:doc "Clear chat display (local only)" :handler cmd-clear-chat} diff --git a/src/eca_cli/mcp.clj b/src/eca_cli/mcp.clj new file mode 100644 index 0000000..1c8d149 --- /dev/null +++ b/src/eca_cli/mcp.clj @@ -0,0 +1,181 @@ +(ns eca-cli.mcp + "MCP server status: `tool/serverUpdated` handler, /mcp panel, status-bar slot, + and `mcp/connectServer` dispatch. Owns the `:mcps` state slice — a map of + server-name → server info kept in sync with the ECA server. No back-references + to eca-cli.state. + + :mcps shape — keyed by name (string): + {:name string + :status string ; running | starting | stopped | failed | disabled | requires-auth + :disabled boolean + :hasAuth boolean + :command string? :args [string]? :url string? + :tools [tool]? :prompts [prompt]? :resources [resource]?}" + (:require [charm.components.list :as cl] + [charm.components.text-input :as ti] + [charm.message :as msg] + [charm.program :as program] + [clojure.string :as str] + [eca-cli.protocol :as protocol])) + +;; --- /mcp command + panel --- + +(defn picker-open? + "True when state is in the `:picking` mode with the `:mcp` picker kind. Used + by mcp.clj (handler refresh, panel render) and state.clj (Enter dispatch) to + share one definition of \"MCP picker is the active overlay\"." + [state] + (and (= :picking (:mode state)) + (= :mcp (get-in state [:picker :kind])))) + +(defn- panel-list [mcps] + (mapv val (sort-by key mcps))) + +(defn- apply-query [entries query] + (if (str/blank? query) + entries + (let [q (str/lower-case query)] + (filterv #(str/includes? (str/lower-case (:name %)) q) entries)))) + +(defn- refresh-mcp-picker + "Rebuild the open :mcp picker from `:mcps`, re-applying `:query` and preserving + selection by server name when possible. Returns updated state. Caller must + guard that the picker is open + `:kind :mcp`." + [state] + (let [{:keys [list filtered query]} (:picker state) + prev-idx (cl/selected-index list) + prev-name (when (and (some? prev-idx) (< prev-idx (count filtered))) + (:name (nth filtered prev-idx))) + all (panel-list (:mcps state)) + filtered' (apply-query all query) + labels (mapv :name filtered') + new-idx (or (when prev-name + (some (fn [[i n]] (when (= n prev-name) i)) + (map-indexed vector labels))) + 0) + new-list (-> list (cl/set-items labels) (cl/select new-idx))] + (-> state + (assoc-in [:picker :all] all) + (assoc-in [:picker :filtered] filtered') + (assoc-in [:picker :list] new-list)))) + +;; --- ECA notification handler --- + +(defn handle-tool-server-updated + "Handles `tool/serverUpdated`. Non-MCP `:type` values are ignored. MCP servers + are upserted into `:mcps` keyed by `:name` — subsequent updates replace prior + entries rather than appending. If the `/mcp` picker is currently open the + picker's `:all`/`:filtered`/`:list` are refreshed in lockstep, preserving the + current query and selection (by server name) where possible." + [state params] + (if (= "mcp" (:type params)) + (let [name (:name params) + entry (-> params + (dissoc :type) + (update :tools #(or % [])) + (update :prompts #(or % [])) + (update :resources #(or % []))) + state' (assoc-in state [:mcps name] entry) + state' (if (picker-open? state') + (refresh-mcp-picker state') + state')] + [state' nil]) + [state nil])) + +(defn cmd-open-mcp-panel + "Opens the `/mcp` panel. Empty `:mcps` shows a system message instead." + [state] + (if (empty? (:mcps state)) + [(-> state + (update :items conj {:type :system :text "⚠ No MCP servers configured"})) + nil] + (let [entries (panel-list (:mcps state))] + [(-> state + (assoc :mode :picking + :picker {:kind :mcp + :list (cl/item-list (mapv :name entries) :height 8) + :all entries + :filtered entries + :query ""}) + (update :input ti/reset)) + nil]))) + +;; --- Render --- + +(defn- status-emoji [status] + (case status + "running" "🟢" + "starting" "🟡" + "failed" "🔴" + "stopped" "⚪" + "disabled" "⚫" + "requires-auth" "🟠" + "⚪")) + +(defn- render-row [{:keys [name status tools]}] + (let [base (str (status-emoji status) " " name " · " (count tools) " tools · " status)] + (cond-> base + (= "requires-auth" status) (str " [connect]") + (= "failed" status) (str " (check ~/.cache/eca/eca-cli.log)")))) + +(defn render-mcp-panel-lines + "Renders panel rows: one line per MCP server, sorted alphabetically by name. + When the `/mcp` picker is open, rows come from the picker's `:filtered` + entries so the display stays in lockstep with Enter's selection target." + [state] + (let [entries (if (picker-open? state) + (get-in state [:picker :filtered]) + (panel-list (:mcps state)))] + (mapv render-row entries))) + +;; --- Status-bar fragment --- + +(defn status-bar-fragment + "Returns the status-bar MCP slot string, or nil when no MCPs are known. + Wide (>=120 cols): `MCPs: n/m ✓` (or `⚠` when any non-running). Narrow: `M:n/m`." + [state width] + (let [mcps (:mcps state)] + (when (seq mcps) + (let [total (count mcps) + running (count (filter #(= "running" (:status (val %))) mcps)) + wide? (>= width 120) + sentinel (if (= running total) "✓" "⚠")] + (if wide? + (str "MCPs: " running "/" total " " sentinel) + (str "M:" running "/" total)))))) + +;; --- connect-server dispatch --- + +(defn connect-server! + "Sends `mcp/connectServer` notification for the given server name. Pure cmd + builder — returns [state cmd]." + [state name] + [state + (program/cmd + (fn [] + (protocol/mcp-connect-server! (:server state) name) + nil))]) + +;; --- :picking :kind :mcp key dispatch --- + +(defn- selected-entry [state] + (let [{:keys [list filtered]} (:picker state) + idx (cl/selected-index list)] + (when (and (some? idx) (< idx (count filtered))) + (nth filtered idx)))) + +(defn handle-key + "Dispatches keys for the :mcp picker. Enter on requires-auth → connect; + otherwise no-op. Escape and filter behaviours are handled by picker.clj." + [state msg] + (cond + (and (msg/key-press? msg) (msg/key-match? msg :enter)) + (if-let [entry (selected-entry state)] + (if (= "requires-auth" (:status entry)) + (let [[s' cmd] (connect-server! state (:name entry))] + [(-> s' (assoc :mode :ready) (dissoc :picker) (update :input ti/focus)) cmd]) + [state nil]) + [state nil]) + + :else + [state nil])) diff --git a/src/eca_cli/protocol.clj b/src/eca_cli/protocol.clj index 1fc14a1..001a44c 100644 --- a/src/eca_cli/protocol.clj +++ b/src/eca_cli/protocol.clj @@ -128,6 +128,9 @@ (defn selected-agent-changed! [srv agent] (send-notification! srv "chat/selectedAgentChanged" {:agent agent})) +(defn mcp-connect-server! [srv name] + (send-notification! srv "mcp/connectServer" {:name name})) + (defn list-chats! [srv callback] (send-request! srv "chat/list" {:limit 20} callback)) diff --git a/src/eca_cli/state.clj b/src/eca_cli/state.clj index 0cc8c57..cbde980 100644 --- a/src/eca_cli/state.clj +++ b/src/eca_cli/state.clj @@ -13,6 +13,7 @@ [eca-cli.chat :as chat] [eca-cli.picker :as picker] [eca-cli.login :as login] + [eca-cli.mcp :as mcp] [eca-cli.commands :as commands])) ;; Expose last-known state for nREPL inspection @@ -74,6 +75,9 @@ "chat/cleared" (chat/handle-chat-cleared state notification) + "tool/serverUpdated" + (mcp/handle-tool-server-updated state (:params notification)) + [state nil])) (defn- handle-eca-tick [state msgs] @@ -136,6 +140,7 @@ :scroll-offset 0 :width 80 :height 24 + :mcps {} :model nil :usage nil}) @@ -245,6 +250,12 @@ cmd-name) [state nil])) + ;; MCP-picker Enter arm — connect on requires-auth rows; everything else + ;; falls through to the generic picker dispatch (filter, navigation, Esc). + (and (msg/key-press? msg) (msg/key-match? msg :enter) + (mcp/picker-open? state)) + (mcp/handle-key state msg) + (= :picking (:mode state)) (picker/handle-key state msg) (#{:ready :chatting} (:mode state)) (chat/handle-key state msg) diff --git a/src/eca_cli/view.clj b/src/eca_cli/view.clj index ac35d98..08931aa 100644 --- a/src/eca_cli/view.clj +++ b/src/eca_cli/view.clj @@ -2,6 +2,7 @@ (:require [clojure.string :as str] [charm.components.list :as cl] [charm.components.text-input :as ti] + [eca-cli.mcp :as mcp] [eca-cli.view.blocks :as blocks])) (defn divider [width] @@ -65,11 +66,15 @@ (str "🚧 " summary "\n[y] approve [Y] always [n] reject")))) (defn- render-picker [state] - (let [{:keys [kind query list]} (:picker state) - label (case kind :model "model" :agent "agent" :session "chat" :command "command" "item")] - (str "Select " label " (type to filter): " query "\n" - (divider (:width state)) "\n" - (cl/list-view list)))) + (let [{:keys [kind query list]} (:picker state)] + (if (= :mcp kind) + (str "MCP servers\n" + (divider (:width state)) "\n" + (str/join "\n" (mcp/render-mcp-panel-lines state))) + (let [label (case kind :model "model" :agent "agent" :session "chat" :command "command" "item")] + (str "Select " label " (type to filter): " query "\n" + (divider (:width state)) "\n" + (cl/list-view list)))))) (defn render-status-bar [state] (let [workspace (-> (get-in state [:opts :workspace] ".") @@ -78,6 +83,7 @@ model (or (:selected-model state) (:model state) "…") agent (:selected-agent state) variant (:selected-variant state) + mcps-frag (mcp/status-bar-fragment state (or (:width state) 80)) usage (:usage state) tokens (some-> usage :sessionTokens (str "tok")) cost (some-> usage :sessionCost) @@ -91,7 +97,7 @@ (str "\"" (subs t 0 24) "…\"") (str "\"" t "\"")))) trust (if (:trust state) "TRUST" "SAFE")] - (str/join " " (remove nil? [workspace loading model agent variant tokens cost ctx-pct chat-title trust])))) + (str/join " " (remove nil? [workspace loading model agent variant mcps-frag tokens cost ctx-pct chat-title trust])))) (defn render-login [state] (let [{:keys [provider action field-idx]} (:login state) diff --git a/test/eca_cli/mcp_test.clj b/test/eca_cli/mcp_test.clj new file mode 100644 index 0000000..c68b815 --- /dev/null +++ b/test/eca_cli/mcp_test.clj @@ -0,0 +1,232 @@ +(ns eca-cli.mcp-test + (:require [charm.components.list :as cl] + [charm.components.text-input :as ti] + [charm.message :as msg] + [clojure.string :as str] + [clojure.test :refer [deftest is testing]] + [eca-cli.commands :as commands] + [eca-cli.mcp :as mcp] + [eca-cli.picker :as picker] + [eca-cli.protocol :as protocol])) + +(defn- base-state [] + {:mode :ready + :mcps {} + :items [] + :input (ti/text-input) + :width 160}) + +;; --- tool/serverUpdated handler --- + +(deftest tool-server-updated-handler-test + (testing "single mcp notification adds entry keyed by name" + (let [[s _] (mcp/handle-tool-server-updated + (base-state) + {:type "mcp" :name "fs" :status "running" + :disabled false :hasAuth false + :tools [{:name "read"} {:name "write"}]})] + (is (= #{"fs"} (set (keys (:mcps s))))) + (is (= "running" (get-in s [:mcps "fs" :status]))) + (is (= 2 (count (get-in s [:mcps "fs" :tools])))))) + + (testing "non-mcp type is ignored" + (let [[s _] (mcp/handle-tool-server-updated + (base-state) + {:type "other" :name "x" :status "running"})] + (is (empty? (:mcps s))))) + + (testing "missing tools/prompts/resources are normalised to []" + (let [[s _] (mcp/handle-tool-server-updated + (base-state) + {:type "mcp" :name "fs" :status "running"})] + (is (= [] (get-in s [:mcps "fs" :tools]))) + (is (= [] (get-in s [:mcps "fs" :prompts]))) + (is (= [] (get-in s [:mcps "fs" :resources])))))) + +(deftest tool-server-updated-update-not-duplicate-test + (testing "subsequent notification with same name updates existing entry" + (let [[s1 _] (mcp/handle-tool-server-updated + (base-state) + {:type "mcp" :name "fs" :status "starting" :tools []}) + [s2 _] (mcp/handle-tool-server-updated + s1 + {:type "mcp" :name "fs" :status "running" + :tools [{:name "read"}]})] + (is (= 1 (count (:mcps s2)))) + (is (= "running" (get-in s2 [:mcps "fs" :status]))) + (is (= 1 (count (get-in s2 [:mcps "fs" :tools]))))))) + +;; --- status-bar-fragment --- + +(deftest status-bar-fragment-empty-test + (testing "empty :mcps → nil (slot hidden)" + (is (nil? (mcp/status-bar-fragment (base-state) 160))) + (is (nil? (mcp/status-bar-fragment (base-state) 80))))) + +(deftest status-bar-fragment-wide-test + (let [state (assoc (base-state) + :mcps {"a" {:status "running"} + "b" {:status "running"} + "c" {:status "running"} + "d" {:status "failed"}})] + (testing "width 160, 3/4 running → ⚠ sentinel" + (is (= "MCPs: 3/4 ⚠" (mcp/status-bar-fragment state 160)))) + (testing "width 120 (boundary, wide path)" + (is (= "MCPs: 3/4 ⚠" (mcp/status-bar-fragment state 120)))) + (testing "width 80 → compact, no sentinel" + (is (= "M:3/4" (mcp/status-bar-fragment state 80)))) + (testing "width 100 (narrow)" + (is (= "M:3/4" (mcp/status-bar-fragment state 100))))) + + (testing "all running, wide → ✓ sentinel" + (let [state (assoc (base-state) + :mcps {"a" {:status "running"} + "b" {:status "running"}})] + (is (= "MCPs: 2/2 ✓" (mcp/status-bar-fragment state 160))) + (is (= "M:2/2" (mcp/status-bar-fragment state 80)))))) + +;; --- panel render --- + +(deftest mcp-panel-render-test + (testing "rows sorted by name, status text + tool count + emoji present" + (let [state (assoc (base-state) + :mcps {"zeta" {:name "zeta" :status "running" + :tools [{:name "z1"}]} + "alpha" {:name "alpha" :status "requires-auth" + :tools []} + "bravo" {:name "bravo" :status "failed" + :tools [{:name "b1"} {:name "b2"}]}}) + lines (mcp/render-mcp-panel-lines state)] + (is (= 3 (count lines))) + (is (str/starts-with? (nth lines 0) "🟠 alpha")) + (is (str/includes? (nth lines 0) "[connect]")) + (is (str/starts-with? (nth lines 1) "🔴 bravo")) + (is (str/includes? (nth lines 1) "2 tools")) + (is (str/includes? (nth lines 1) "check ~/.cache/eca/eca-cli.log")) + (is (str/starts-with? (nth lines 2) "🟢 zeta")) + (is (str/includes? (nth lines 2) "1 tools"))))) + +;; --- /mcp command + connect dispatch --- + +(deftest mcp-connect-server-dispatch-test + (testing "Enter on requires-auth row triggers mcp-connect-server!" + (let [sent (atom []) + state (assoc (base-state) + :mode :picking + :server :stub + :picker {:kind :mcp + :list (cl/item-list ["fs"] :height 8) + :all [{:name "fs" :status "requires-auth"}] + :filtered [{:name "fs" :status "requires-auth"}] + :query ""})] + (with-redefs [protocol/mcp-connect-server! + (fn [_srv name] (swap! sent conj name))] + (let [[_ cmd] (mcp/handle-key state (msg/key-press :enter))] + ;; cmd is a charm cmd; execute it to fire the notification + (when cmd ((:fn cmd))) + (is (= ["fs"] @sent)))))) + + (testing "Enter on running row does NOT send notification" + (let [sent (atom []) + state (assoc (base-state) + :mode :picking + :server :stub + :picker {:kind :mcp + :list (cl/item-list ["fs"] :height 8) + :all [{:name "fs" :status "running"}] + :filtered [{:name "fs" :status "running"}] + :query ""})] + (with-redefs [protocol/mcp-connect-server! + (fn [_srv name] (swap! sent conj name))] + (let [[_ cmd] (mcp/handle-key state (msg/key-press :enter))] + (when cmd ((:fn cmd))) + (is (empty? @sent))))))) + +;; --- picker/render in lockstep --- + +(defn- mcps-fixture [] + {"alpha" {:name "alpha" :status "running" :tools []} + "bravo" {:name "bravo" :status "requires-auth" :tools []} + "delta" {:name "delta" :status "running" :tools []}}) + +(deftest picker-renders-filtered-after-query-test + (testing "panel rows reflect picker :filtered after a filter is typed, and + Enter dispatches against that same filtered subset" + (let [sent (atom []) + state (-> (base-state) + (assoc :server :stub :mcps (mcps-fixture))) + [opened _] (mcp/cmd-open-mcp-panel state) + filtered (picker/filter-picker opened "b") + lines (mcp/render-mcp-panel-lines filtered)] + (is (= 1 (count lines))) + (is (str/starts-with? (first lines) "🟠 bravo")) + (with-redefs [protocol/mcp-connect-server! + (fn [_srv n] (swap! sent conj n))] + (let [[_ cmd] (mcp/handle-key filtered (msg/key-press :enter))] + (when cmd ((:fn cmd))) + (is (= ["bravo"] @sent) + "Enter targets the one filtered (visible) row, not the original list")))))) + +(deftest picker-refreshes-on-server-update-test + (testing "tool/serverUpdated arriving while picker open refreshes :all/:filtered" + (let [state (-> (base-state) (assoc :mcps (mcps-fixture))) + [opened _] (mcp/cmd-open-mcp-panel state) + [updated _] (mcp/handle-tool-server-updated + opened + {:type "mcp" :name "bravo" :status "running" + :tools [{:name "t1"}]})] + (is (= "running" (get-in updated [:mcps "bravo" :status]))) + (is (= "running" (->> updated :picker :all + (some #(when (= "bravo" (:name %)) (:status %)))))) + (is (= "running" (->> updated :picker :filtered + (some #(when (= "bravo" (:name %)) (:status %)))))) + (let [lines (mcp/render-mcp-panel-lines updated)] + (is (= 3 (count lines))) + (is (not (some #(str/includes? % "[connect]") lines)) + "row [connect] suffix gone after status transitions to running")))) + + (testing "with non-empty filter, update preserves :query and selection by name" + (let [state (-> (base-state) (assoc :mcps (mcps-fixture))) + [opened _] (mcp/cmd-open-mcp-panel state) + filtered (picker/filter-picker opened "b") + [updated _] (mcp/handle-tool-server-updated + filtered + {:type "mcp" :name "bravo" :status "running" + :tools [{:name "t1"}]})] + (is (= "b" (get-in updated [:picker :query])) + "query preserved across update") + (is (= ["bravo"] (mapv :name (get-in updated [:picker :filtered]))) + "filter re-applied to new :mcps") + (is (= 0 (cl/selected-index (get-in updated [:picker :list]))) + "cursor stays on bravo"))) + + (testing "selection by name is preserved when a different server updates" + (let [state (-> (base-state) (assoc :mcps (mcps-fixture))) + [opened _] (mcp/cmd-open-mcp-panel state) + ;; user moves cursor to delta (index 2) + on-delta (update-in opened [:picker :list] cl/select 2) + [updated _] (mcp/handle-tool-server-updated + on-delta + {:type "mcp" :name "bravo" :status "running" + :tools []}) + idx (cl/selected-index (get-in updated [:picker :list]))] + (is (= "delta" (:name (nth (get-in updated [:picker :filtered]) idx))) + "cursor follows the previously selected server name"))) + + (testing "update while picker closed does not synthesise picker keys" + (let [state (-> (base-state) (assoc :mcps (mcps-fixture))) + [updated _] (mcp/handle-tool-server-updated + state + {:type "mcp" :name "bravo" :status "running" :tools []})] + (is (nil? (:picker updated))) + (is (= :ready (:mode updated)))))) + +;; --- /mcp registration --- + +(deftest commands-registration-test + (testing "/mcp exists in command-registry with handler + doc" + (is (contains? commands/command-registry "/mcp")) + (let [entry (get commands/command-registry "/mcp")] + (is (string? (:doc entry))) + (is (seq (:doc entry))) + (is (fn? (:handler entry))))))