├── README.md ├── components ├── http-server │ ├── deps.edn │ ├── src │ │ └── mcp_clj │ │ │ └── http_server │ │ │ └── adapter.clj │ └── test │ │ └── mcp_clj │ │ └── http_server │ │ └── adapter_test.clj ├── http │ ├── deps.edn │ └── src │ │ └── mcp_clj │ │ └── http.clj ├── json-rpc │ ├── deps.edn │ ├── src │ │ └── mcp_clj │ │ │ └── json_rpc │ │ │ ├── protocol.clj │ │ │ └── server.clj │ └── test │ │ └── mcp_clj │ │ └── json_rpc │ │ ├── protocol_test.clj │ │ └── server_test.clj ├── log │ ├── deps.edn │ └── src │ │ └── mcp_clj │ │ └── log.clj └── mcp-server │ ├── deps.edn │ ├── src │ └── mcp_clj │ │ ├── mcp_server │ │ ├── core.clj │ │ ├── prompts.clj │ │ ├── resources.clj │ │ └── tools.clj │ │ └── sse.clj │ └── test │ └── mcp_clj │ ├── mcp_server │ └── tools_test.clj │ └── mcp_server_test.clj ├── deps.edn ├── design ├── namespaces.md └── project-scope.md ├── doc └── adr │ └── 001-json-rpc-server.md └── projects └── server └── deps.edn /README.md: -------------------------------------------------------------------------------- 1 | # mcp-clj 2 | 3 | An implementation of the Model-Channel Protocol (MCP) in Clojure, 4 | designed to expose Clojure REPL functionality over an SSE transport. 5 | 6 | ## Project Description 7 | 8 | mcp-clj is a Clojure implementation of the Model-Channel Protocol (MCP) 9 | defined by Anthropic. It provides both client and server components for 10 | MCP communication, with a specific focus on exposing Clojure REPL 11 | functionality. The project aims to maintain compatibility with 12 | Anthropic's MCP specification while providing a simple and reliable 13 | implementation. 14 | 15 | ## Usage 16 | 17 | Add mcp-clj as a dependency to your project. 18 | 19 | 1. Add the mcp-project as a dependency: 20 | 21 | ```clojure 22 | :deps {org.hugoduncan/mcp-clj 23 | {:git/url "https://github.com/hugoduncan/mcp-clj" 24 | :git/sha "replace with latest git sha" 25 | :deps/root "projects/server"}} 26 | ``` 27 | 28 | 2. In the project, start the server: 29 | 30 | ```clojure 31 | (require 'mcp-clj.mcp-server.core) 32 | (def server (mcp-clj.mcp-server.core/create-server {:port 3001})) 33 | ``` 34 | 35 | This will start the server on port 3001. You can then connect to the 36 | server using an MCP client. 37 | 38 | ## Configuration 39 | 40 | ### Configuring Claude Desktop 41 | 42 | To configure Claude Desktop to use mcp-clj, you need to use 43 | [mcp-proxy](https://github.com/sparfenyuk/mcp-proxy). 44 | 45 | In `claude_desktop_config.json`, add: 46 | 47 | ```json 48 | "mcp-proxy": { 49 | "command": "mcp-proxy", 50 | "args": [ 51 | "http://localhost:3001/sse" 52 | ], 53 | "env": { 54 | "API_ACCESS_TOKEN": "ABC" 55 | } 56 | } 57 | ``` 58 | 59 | ## Contributing 60 | 61 | Contributions to mcp-clj are welcome! Please follow these steps to contribute: 62 | 63 | 1. Fork the repository. 64 | 2. Create a new branch for your feature or bugfix. 65 | 3. Make your changes and ensure all tests pass. 66 | 4. Submit a pull request with a detailed description of your changes. 67 | 68 | ## License 69 | 70 | mcp-clj is licensed under the MIT License. See the [LICENSE](LICENSE) file for more details. 71 | -------------------------------------------------------------------------------- /components/http-server/deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {}} 2 | -------------------------------------------------------------------------------- /components/http-server/src/mcp_clj/http_server/adapter.clj: -------------------------------------------------------------------------------- 1 | (ns mcp-clj.http-server.adapter 2 | "Adapter for Java's com.sun.net.httpserver.HttpServer with SSE support" 3 | (:require 4 | [clojure.string :as str] 5 | [mcp-clj.log :as log]) 6 | (:import 7 | [com.sun.net.httpserver HttpExchange 8 | HttpHandler 9 | HttpServer] 10 | [java.net InetSocketAddress 11 | URLDecoder])) 12 | 13 | (defn- set-response-header! 14 | [^HttpExchange exchange k v] 15 | (.add (.getResponseHeaders exchange) (name k) (str v))) 16 | 17 | (defn- set-response-headers! 18 | [^HttpExchange exchange headers] 19 | (doseq [[k v] headers] 20 | (set-response-header! exchange k v))) 21 | 22 | (defn- send-response-headers! 23 | [^HttpExchange exchange status num-bytes] 24 | (.sendResponseHeaders exchange status num-bytes)) 25 | 26 | (defn- close-response-body! 27 | [^HttpExchange exchange] 28 | (.close (.getResponseBody exchange))) 29 | 30 | (defn- parse-query 31 | [raw-query] 32 | (let [decode #(URLDecoder/decode % "UTF-8")] 33 | (if (str/blank? raw-query) 34 | {} 35 | (into {} 36 | (map (fn [pair] 37 | (let [[key value] (str/split pair #"=" 2)] 38 | [(decode key) (decode (or value ""))])) 39 | (str/split raw-query #"&")))))) 40 | 41 | (defn- exchange->request-map 42 | "Convert HttpExchange to Ring request map" 43 | [^HttpExchange exchange] 44 | {:server-port (.getPort (.getLocalAddress exchange)) 45 | :server-name (.getHostName (.getLocalAddress exchange)) 46 | :remote-addr (-> exchange .getRemoteAddress .getAddress .getHostAddress) 47 | :uri (.getPath (.getRequestURI exchange)) 48 | :query-string (.getRawQuery (.getRequestURI exchange)) 49 | :query-params (fn query-params [] 50 | (parse-query 51 | (.getRawQuery (.getRequestURI exchange)))) 52 | :scheme :http 53 | :request-method (-> exchange .getRequestMethod .toLowerCase keyword) 54 | :headers (into {} 55 | (for [k (.keySet (.getRequestHeaders exchange)) 56 | :let [vs (.get (.getRequestHeaders exchange) k)]] 57 | [(str/lower-case k) (str (first vs))])) 58 | :body (.getRequestBody exchange) 59 | :on-response-done (fn [] (close-response-body! exchange)) 60 | :on-response-error (fn [] (close-response-body! exchange)) 61 | :response-body (.getResponseBody exchange)}) 62 | 63 | (defn- send-streaming-response 64 | "Handle streaming response for SSE" 65 | [^HttpExchange exchange response] 66 | (let [{:keys [body status headers]} response] 67 | (set-response-headers! exchange headers) 68 | (send-response-headers! exchange status 0) 69 | (body))) 70 | 71 | (defn- send-ring-response 72 | "Send Ring response, detecting streaming vs normal response" 73 | [^HttpExchange exchange response] 74 | (if (fn? (:body response)) 75 | (send-streaming-response exchange response) 76 | (let [{:keys [status headers body]} 77 | response 78 | _ (log/info :http/response {:body-type (type body)}) 79 | body-bytes (if (string? body) 80 | (.getBytes body) 81 | body) 82 | n (if body-bytes 83 | (alength body-bytes) 84 | 0)] 85 | (set-response-headers! exchange headers) 86 | (send-response-headers! exchange status (if (pos? n) n -1)) 87 | (if (pos? n) 88 | (with-open [os (.getResponseBody exchange)] 89 | (.write os body-bytes) 90 | (.flush os)) 91 | (close-response-body! exchange))))) 92 | 93 | (defn run-server 94 | "Start an HttpServer instance with the given Ring handler. 95 | Returns a server map containing :server and :stop fn." 96 | [handler {:keys [executor port join?] 97 | :or {port 8080 98 | join? false}}] 99 | (let [server (HttpServer/create (InetSocketAddress. port) 0) 100 | handler-fn (reify HttpHandler 101 | (handle [_ exchange] 102 | (try 103 | (let [request (exchange->request-map exchange) 104 | response (handler request)] 105 | (log/info 106 | :http/request 107 | {:request 108 | (select-keys 109 | request 110 | [:uri :method :headers]) 111 | :response response}) 112 | (if (fn? (:body response)) 113 | (send-streaming-response exchange response) 114 | (send-ring-response exchange response))) 115 | (catch Exception e 116 | (.printStackTrace e) 117 | (send-response-headers! exchange 500 0)) 118 | ;; Removed exchange close from finally block 119 | )))] 120 | (.createContext server "/" handler-fn) 121 | (.setExecutor server executor) 122 | (.start server) 123 | (when join? 124 | (.awaitTermination 125 | (.getExecutor server) 126 | Long/MAX_VALUE 127 | java.util.concurrent.TimeUnit/SECONDS)) 128 | {:server server 129 | :port (.getPort (.getAddress server)) 130 | :stop (fn [] (.stop server 0))})) 131 | -------------------------------------------------------------------------------- /components/http-server/test/mcp_clj/http_server/adapter_test.clj: -------------------------------------------------------------------------------- 1 | (ns mcp-clj.http-server.adapter-test 2 | "Tests for adapter for Java's HttpServer" 3 | (:require 4 | [clojure.test :refer [deftest testing is use-fixtures]] 5 | [mcp-clj.http :as http] 6 | [mcp-clj.http-server.adapter :as adapter]) 7 | (:import 8 | [java.net URL HttpURLConnection])) 9 | 10 | (defn test-handler [request] 11 | (case (:uri request) 12 | "/" (-> (http/response "Hello World") 13 | (http/content-type "text/plain")) 14 | 15 | "/stream" (-> (http/response (fn [] 16 | (with-open [out (:response-body request)] 17 | (doseq [n (range 3)] 18 | (.write out (.getBytes (str "data: " n "\n\n")))) 19 | (.flush out)))) 20 | (http/content-type "text/event-stream")) 21 | 22 | "/echo-headers" (-> (http/response 23 | (pr-str {:headers (:headers request)})) 24 | (http/content-type "application/edn")) 25 | 26 | "/echo-query" (-> (http/response 27 | (pr-str {:query-string (:query-string request) 28 | :query-params ((:query-params request))})) 29 | (http/content-type "application/edn")) 30 | 31 | "/post-echo" (-> (http/response 32 | (slurp (:body request))) 33 | (http/content-type "text/plain")) 34 | 35 | "/throw-error" (throw (RuntimeException. "Deliberate test error")) 36 | 37 | "/error" {:status 500 38 | :headers {"Content-Type" "text/plain"} 39 | :body "Error"})) 40 | 41 | (def ^:dynamic *server* nil) 42 | (def ^:dynamic *port* nil) 43 | 44 | (defn server-fixture [f] 45 | (println "Starting test server") 46 | (let [server-map (adapter/run-server test-handler {:port 0}) 47 | port (:port server-map)] 48 | (println "Server started:" server-map) 49 | (try 50 | (println "Running test with server") 51 | (binding [*server* server-map 52 | *port* port] 53 | (f)) 54 | (finally 55 | (println "Stopping server") 56 | ((:stop server-map)) 57 | (println "Server stopped"))))) 58 | 59 | (use-fixtures :each server-fixture) 60 | 61 | (defn make-connection [method path] 62 | (let [url (URL. (str "http://localhost:" *port* path)) 63 | conn ^HttpURLConnection (.openConnection url)] 64 | (.setRequestMethod conn method) 65 | conn)) 66 | 67 | (defn http-get [path] 68 | (make-connection "GET" path)) 69 | 70 | (defn http-post [path body] 71 | (let [conn (make-connection "POST" path)] 72 | (.setDoOutput conn true) 73 | (when body 74 | (.setRequestProperty conn "Content-Type" "text/plain") 75 | (with-open [w (.getOutputStream conn)] 76 | (.write w (.getBytes body)))) 77 | conn)) 78 | 79 | (deftest query-string-test 80 | (testing "query string parsing" 81 | (testing "empty query string" 82 | (let [conn (http-get "/echo-query") 83 | response (read-string (slurp (.getInputStream conn)))] 84 | (is (nil? (:query-string response))) 85 | (is (empty? (:query-params response))))) 86 | 87 | (testing "single parameter" 88 | (let [conn (http-get "/echo-query?name=value") 89 | response (read-string (slurp (.getInputStream conn)))] 90 | (is (= "name=value" (:query-string response))) 91 | (is (= {"name" "value"} (:query-params response))))) 92 | 93 | (testing "multiple parameters" 94 | (let [conn (http-get "/echo-query?a=1&b=2") 95 | response (read-string (slurp (.getInputStream conn)))] 96 | (is (= "a=1&b=2" (:query-string response))) 97 | (is (= {"a" "1" "b" "2"} (:query-params response))))) 98 | 99 | (testing "URL encoded parameters" 100 | (let [conn (http-get "/echo-query?message=hello%20world&type=greeting%21") 101 | response (read-string (slurp (.getInputStream conn)))] 102 | (is (= {"message" "hello world" "type" "greeting!"} (:query-params response))))) 103 | 104 | (testing "missing value parameter" 105 | (let [conn (http-get "/echo-query?key=") 106 | response (read-string (slurp (.getInputStream conn)))] 107 | (is (= {"key" ""} (:query-params response))))) 108 | 109 | (testing "duplicate parameters - last value wins" 110 | (let [conn (http-get "/echo-query?key=1&key=2") 111 | response (read-string (slurp (.getInputStream conn)))] 112 | (is (= {"key" "2"} (:query-params response))))))) 113 | 114 | (deftest post-request-test 115 | (testing "POST with body" 116 | (let [test-body "Hello Server" 117 | conn (http-post "/post-echo" test-body)] 118 | (is (= 200 (.getResponseCode conn))) 119 | (is (= test-body (slurp (.getInputStream conn))))))) 120 | 121 | (deftest error-handling-test 122 | (testing "handler throwing runtime exception" 123 | (let [conn (http-get "/throw-error")] 124 | (is (= 500 (.getResponseCode conn)))))) 125 | 126 | (deftest basic-request-test 127 | (println "Starting basic-request-test") 128 | (testing "basic GET request" 129 | (try 130 | (let [conn (http-get "/") 131 | _ (println "Got response code:" (.getResponseCode conn)) 132 | _ (println "Got content type:" (.getHeaderField conn "Content-Type")) 133 | response (slurp (.getInputStream conn))] 134 | (println "Got response:" response) 135 | (is (= 200 (.getResponseCode conn))) 136 | (is (= "text/plain" (.getHeaderField conn "Content-Type"))) 137 | (is (= "Hello World" response))) 138 | (catch Exception e 139 | (println "Error in test:" (.getMessage e)) 140 | (.printStackTrace e)))) 141 | 142 | (testing "streaming SSE response" 143 | (let [conn (http-get "/stream")] 144 | (is (= 200 (.getResponseCode conn))) 145 | (is (= "text/event-stream" (.getHeaderField conn "Content-Type"))) 146 | (.setReadTimeout conn 1000) ; ensure we don't hang 147 | (let [response (slurp (.getInputStream conn))] 148 | (is (= "data: 0\n\ndata: 1\n\ndata: 2\n\n" response))))) 149 | 150 | (testing "error response" 151 | (let [conn (http-get "/error")] 152 | (is (= 500 (.getResponseCode conn))) 153 | (is (= "text/plain" (.getHeaderField conn "Content-Type"))) 154 | (is (= "Error" (slurp (.getErrorStream conn)))))) 155 | 156 | (testing "header passing and case insensitivity" 157 | (let [conn (http-get "/echo-headers")] 158 | (.setRequestProperty conn "X-Test" "test-value") 159 | (.setRequestProperty conn "CONTENT-TYPE" "text/special") 160 | (let [response (read-string (slurp (.getInputStream conn)))] 161 | (is (= "test-value" (get-in response [:headers "x-test"]))) 162 | (is (= "text/special" (get-in response [:headers "content-type"]))) 163 | (is (= "application/edn" (.getHeaderField conn "Content-Type"))))))) 164 | -------------------------------------------------------------------------------- /components/http/deps.edn: -------------------------------------------------------------------------------- 1 | {} 2 | -------------------------------------------------------------------------------- /components/http/src/mcp_clj/http.clj: -------------------------------------------------------------------------------- 1 | (ns mcp-clj.http 2 | (:require 3 | [clojure.data.json :as json])) 4 | 5 | (defn response 6 | "Return a minimal status 200 response map with the given body." 7 | [body] 8 | {:status 200 9 | :headers {} 10 | :body body}) 11 | 12 | (defn status 13 | "Returns an updated response map with the given status." 14 | [resp status] 15 | (assoc resp :status status)) 16 | 17 | (defn header 18 | "Update a response map with the given header." 19 | [resp name value] 20 | (assoc-in resp [:headers name] (str value))) 21 | 22 | (defn content-type 23 | "Add a Content-Type header to the response headers." 24 | [resp content-type] 25 | (header resp "Content-Type" content-type)) 26 | 27 | (defn json-response 28 | "Create a JSON response with given status" 29 | [data status-code] 30 | (-> (response (json/write-str data)) 31 | (status status-code) 32 | (content-type "application/json"))) 33 | 34 | (defn text-response 35 | "Create a JSON response with given status" 36 | [body status-code] 37 | (-> (response body) 38 | (status status-code) 39 | (content-type "text/plain"))) 40 | 41 | (def Ok 200) 42 | (def Accepted 202) 43 | (def BadRequest 400) 44 | (def NotFound 404) 45 | (def Unavailable 503) 46 | (def InternalServerError 500) 47 | -------------------------------------------------------------------------------- /components/json-rpc/deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src"] 2 | :deps {org.clojure/clojure {:mvn/version "1.12.0"} 3 | org.clojure/data.json {:mvn/version "2.5.0"}} 4 | :aliases 5 | {:test {:extra-paths ["test"] 6 | :extra-deps {}}}} 7 | -------------------------------------------------------------------------------- /components/json-rpc/src/mcp_clj/json_rpc/protocol.clj: -------------------------------------------------------------------------------- 1 | (ns mcp-clj.json-rpc.protocol 2 | "JSON-RPC 2.0 protocol constants and utilities" 3 | (:require 4 | [clojure.data.json :as json])) 5 | 6 | ;;; Protocol version 7 | (def ^:const version "2.0") 8 | 9 | ;;; Standard error codes 10 | (def error-codes 11 | {:parse-error -32700 12 | :invalid-request -32600 13 | :method-not-found -32601 14 | :invalid-params -32602 15 | :internal-error -32603 16 | :overloaded -32000 ; non-standard 17 | :server-error-start -32000 18 | :server-error-end -32099}) 19 | 20 | ;;; Response construction 21 | 22 | (defn error-response 23 | "Create a JSON-RPC error response" 24 | ([code message] 25 | (error-response code message nil)) 26 | ([code message data] 27 | {:jsonrpc version 28 | :error {:code code 29 | :message message 30 | :data data} 31 | :id nil})) 32 | 33 | (defn result-response 34 | "Create a JSON-RPC result response" 35 | [id result] 36 | {:jsonrpc version 37 | :result result 38 | :id id}) 39 | 40 | ;;; Request validation 41 | 42 | (defn validate-request 43 | "Validate a JSON-RPC request. 44 | Returns nil if valid, error response if invalid." 45 | [{:keys [jsonrpc method] :as request}] 46 | (cond 47 | (not= jsonrpc version) 48 | (error-response 49 | (:invalid-request error-codes) 50 | "Invalid JSON-RPC version") 51 | 52 | (not (string? method)) 53 | (error-response 54 | (:invalid-request error-codes) 55 | "Method must be a string") 56 | 57 | :else nil)) 58 | 59 | ;;; JSON conversion 60 | 61 | (def write-json-options 62 | "Options for writing JSON" 63 | {:key-fn name}) ; Convert keywords to strings 64 | 65 | (def read-json-options 66 | "Options for reading JSON" 67 | {:key-fn keyword}) ; Convert strings to keywords 68 | 69 | (defn parse-json 70 | "Parse JSON string to EDN, with error handling" 71 | [s] 72 | (try 73 | [(json/read-str s read-json-options) nil] 74 | (catch Exception e 75 | [nil (error-response (:parse-error error-codes) 76 | "Invalid JSON")]))) 77 | 78 | (defn write-json 79 | "Convert EDN to JSON string, with error handling" 80 | [data] 81 | (try 82 | [(json/write-str data write-json-options) nil] 83 | (catch Exception e 84 | [nil (error-response (:internal-error error-codes) 85 | "JSON conversion error")]))) 86 | -------------------------------------------------------------------------------- /components/json-rpc/src/mcp_clj/json_rpc/server.clj: -------------------------------------------------------------------------------- 1 | (ns mcp-clj.json-rpc.server 2 | "JSON-RPC 2.0 server with Server-Sent Events (SSE) support" 3 | (:require 4 | [clojure.data.json :as json] 5 | [mcp-clj.http :as http] 6 | [mcp-clj.http-server.adapter :as http-server] 7 | [mcp-clj.json-rpc.protocol :as protocol] 8 | [mcp-clj.log :as log] 9 | [mcp-clj.sse :as sse]) 10 | (:import 11 | [java.util.concurrent 12 | ExecutorService 13 | Executors 14 | RejectedExecutionException 15 | ScheduledExecutorService 16 | ThreadPoolExecutor 17 | TimeUnit 18 | TimeUnit])) 19 | 20 | 21 | ;;; Executor Service 22 | 23 | (def ^:private request-timeout-ms 30000) 24 | 25 | (defn- wrap-log-throwables [f] 26 | (fn [] 27 | (try 28 | (f) 29 | (catch Exception e 30 | (log/error :rpc/unexpected e))))) 31 | 32 | (defn- create-executor 33 | "Create bounded executor service" 34 | [num-threads] 35 | (Executors/newScheduledThreadPool num-threads)) 36 | 37 | (defn- shutdown-executor 38 | "Shutdown executor service gracefully" 39 | [^ThreadPoolExecutor executor] 40 | (.shutdown executor) 41 | (try 42 | (when-not (.awaitTermination executor 5 TimeUnit/SECONDS) 43 | (.shutdownNow executor)) 44 | (catch InterruptedException _ 45 | (.shutdownNow executor)))) 46 | 47 | (defn- submit! 48 | ([executor f] 49 | (.submit ^ExecutorService executor ^Callable (wrap-log-throwables f))) 50 | ([executor f delay-millis] 51 | (.schedule 52 | ^ScheduledExecutorService executor 53 | ^Callable (wrap-log-throwables f) 54 | (long delay-millis) 55 | TimeUnit/MILLISECONDS))) 56 | 57 | (defrecord Session 58 | [^String session-id 59 | reply!-fn 60 | close!-fn]) 61 | 62 | ;;; Response Format 63 | 64 | (defn- json-rpc-result 65 | "Wrap a handler result in a JSON-RPC response" 66 | [result id] 67 | {:jsonrpc "2.0" 68 | :id id 69 | :result result}) 70 | 71 | (defn- json-rpc-notification 72 | "Wrap a handler result in a JSON-RPC response" 73 | [method params] 74 | (cond-> {:jsonrpc "2.0" 75 | :method method} 76 | params (assoc :params params))) 77 | 78 | (defn- json-rpc-error 79 | "Wrap a handler error in a JSON-RPC error response" 80 | [code message & [id]] 81 | (cond-> {:jsonrpc "2.0" 82 | :error {:code (protocol/error-codes code code) 83 | :message message}} 84 | id (assoc :id id))) 85 | 86 | ;;; Request Handling 87 | 88 | (defn- request-session-id [request] 89 | (get ((:query-params request)) "session_id")) 90 | 91 | (defn- handle-json-rpc 92 | "Process a JSON-RPC request" 93 | [handler {:keys [method params id]} request reply!-fn] 94 | (log/info :rpc/invoke {:method method :params params}) 95 | (when-let [response (handler request params)] 96 | (log/info :server/handler-response response) 97 | (reply!-fn (json-rpc-result response id)))) 98 | 99 | (defn- dispatch-rpc-call 100 | [executor handler rpc-call request reply!-fn] 101 | ;; futures will cancel each other 102 | (let [cf (promise) 103 | f (submit! 104 | executor 105 | #(do (handle-json-rpc handler rpc-call request reply!-fn) 106 | (when (realized? cf) 107 | (future-cancel @cf))))] 108 | (deliver 109 | cf 110 | (submit! executor #(future-cancel f) request-timeout-ms)))) 111 | 112 | (defn- handle-request 113 | "Handle a JSON-RPC request" 114 | [executor session-id->session handlers request] 115 | (try 116 | (let [session-id (request-session-id request) 117 | session (session-id->session session-id) 118 | reply!-fn (:reply!-fn session) 119 | rpc-call (json/read-str (slurp (:body request)) :key-fn keyword)] 120 | (log/info :rpc/json-request 121 | {:json-request rpc-call 122 | :session-id session-id}) 123 | (if-let [validation-error (protocol/validate-request rpc-call)] 124 | (http/json-response 125 | (json-rpc-error 126 | (:code (:error validation-error)) 127 | (:message (:error validation-error))) 128 | http/BadRequest) 129 | (if-let [handler (get handlers (:method rpc-call))] 130 | (do 131 | (dispatch-rpc-call executor handler rpc-call request reply!-fn) 132 | (http/text-response "Accepted" http/Accepted)) 133 | (http/json-response 134 | (json-rpc-error 135 | :method-not-found 136 | (str "Method not found: " (:method rpc-call)) 137 | (:id rpc-call)) 138 | http/BadRequest)))) 139 | (catch RejectedExecutionException _ 140 | (log/warn :rpc/overload-rejection) 141 | (http/json-response 142 | (json-rpc-error :overloaded "Server overloaded") 143 | http/Unavailable)) 144 | (catch Exception e 145 | (.printStackTrace e) 146 | (log/error :rpc/error {:e e}) 147 | (http/json-response 148 | (json-rpc-error 149 | :internal-error 150 | (.getMessage e)) 151 | http/InternalServerError)))) 152 | 153 | (defn data->str [v] 154 | (if (string? v) 155 | (pr-str v) 156 | (json/write-str v))) 157 | 158 | (defn- uuid->hex 159 | [^java.util.UUID uuid] 160 | (let [msb (.getMostSignificantBits uuid) 161 | lsb (.getLeastSignificantBits uuid)] 162 | (format "%016x%016x" msb lsb))) 163 | 164 | (defn create-server 165 | "Create JSON-RPC server with SSE support" 166 | [{:keys [num-threads 167 | port 168 | on-sse-connect 169 | on-sse-close] 170 | :or {num-threads (* 2 (.availableProcessors (Runtime/getRuntime))) 171 | port 0 172 | on-sse-connect (fn [& _]) 173 | on-sse-close (fn [& _])}}] 174 | {:pre [(ifn? on-sse-connect) (ifn? on-sse-close)]} 175 | (let [executor (create-executor num-threads) 176 | session-id->session (atom {}) 177 | handlers (atom {}) 178 | handler (fn [{:keys [request-method uri] :as request}] 179 | (log/info :rpc/http-request 180 | {:method request-method :uri uri}) 181 | (case [request-method uri] 182 | [:post "/messages"] 183 | (handle-request 184 | executor 185 | @session-id->session 186 | @handlers 187 | request) 188 | 189 | [:get "/sse"] 190 | (let [id (uuid->hex (random-uuid)) 191 | uri (str "/messages?session_id=" id) 192 | {:keys [reply! close! response]} 193 | (sse/handler request) 194 | session (->Session 195 | id 196 | (fn [rpc-response] 197 | (reply! 198 | (sse/message 199 | (data->str rpc-response)))) 200 | (fn [] 201 | (on-sse-close id) 202 | (close!)))] 203 | (swap! session-id->session assoc id session) 204 | (log/info :rpc/sse-connect {:id id}) 205 | (update response 206 | :body 207 | (fn [f] 208 | (fn [& args] 209 | (log/info :rpc/on-sse-connect {}) 210 | (apply f args) 211 | (reply! 212 | {:event "endpoint" :data uri}) 213 | (on-sse-connect id))))) 214 | (do 215 | (log/warn :rpc/invalid 216 | {:method request-method :uri uri}) 217 | (http/text-response 218 | "Not Found" 219 | http/NotFound)))) 220 | 221 | {:keys [server port stop]} 222 | (http-server/run-server handler {:executor executor :port port}) 223 | server {:server server 224 | :port port 225 | :handlers handlers 226 | :stop (fn [] 227 | (stop) 228 | (shutdown-executor executor)) 229 | :session-id->session session-id->session}] 230 | server)) 231 | 232 | (defn set-handlers! 233 | [server handlers] 234 | (when-not (map? handlers) 235 | (throw (ex-info "Handlers must be a map" 236 | {:handlers handlers}))) 237 | (update server :handlers swap! (constantly handlers))) 238 | 239 | (defn close! 240 | [server id] 241 | (let [session (@(:session-id->session server) id)] 242 | ((:close!-fn session)) 243 | (swap! (:session-id->session server) dissoc id))) 244 | 245 | (defn notify-all! 246 | "Send a notification to all active sessions" 247 | [server method params] 248 | (log/info :rpc/notify-all! {:method method :params params}) 249 | (doseq [{:keys [reply!-fn] :as session} (vals @(:session-id->session server))] 250 | (log/info :rpc/notify-all! {:session-id (:session-id session)}) 251 | (reply!-fn (json-rpc-notification method params)))) 252 | 253 | (defn notify! 254 | "Send a notification to all active sessions" 255 | [server id method params] 256 | (log/info :rpc/notify-all! {:id id :method method :params params}) 257 | (when-let [{:keys [reply!-fn]} (@(:session-id->session server) id)] 258 | (reply!-fn (json-rpc-notification method params)))) 259 | -------------------------------------------------------------------------------- /components/json-rpc/test/mcp_clj/json_rpc/protocol_test.clj: -------------------------------------------------------------------------------- 1 | (ns mcp-clj.json-rpc.protocol-test 2 | (:require 3 | [clojure.test :refer :all] 4 | [mcp-clj.json-rpc.protocol :as protocol])) 5 | 6 | (deftest json-conversion 7 | (testing "EDN to JSON conversion" 8 | (let [[json err] (protocol/write-json {:a 1 :b [1 2 3]})] 9 | (is (nil? err)) 10 | (is (= "{\"a\":1,\"b\":[1,2,3]}" json)))) 11 | 12 | (testing "JSON to EDN conversion" 13 | (let [[data err] (protocol/parse-json "{\"a\":1,\"b\":[1,2,3]}")] 14 | (is (nil? err)) 15 | (is (= {:a 1 :b [1 2 3]} data))))) 16 | 17 | (deftest request-validation 18 | (testing "Valid request" 19 | (is (nil? (protocol/validate-request 20 | {:jsonrpc "2.0" 21 | :method "test" 22 | :params {:a 1}})))) 23 | 24 | (testing "Invalid version" 25 | (let [response (protocol/validate-request 26 | {:jsonrpc "1.0" 27 | :method "test"})] 28 | (is (= "Invalid JSON-RPC version" 29 | (get-in response [:error :message])))))) 30 | -------------------------------------------------------------------------------- /components/json-rpc/test/mcp_clj/json_rpc/server_test.clj: -------------------------------------------------------------------------------- 1 | (ns mcp-clj.json-rpc.server-test 2 | (:require 3 | [clojure.data.json :as json] 4 | [clojure.string :as str] 5 | [clojure.test :refer [deftest is testing use-fixtures]] 6 | [hato.client :as hato] 7 | [hato.middleware :as mw] 8 | [mcp-clj.http :as http] 9 | [mcp-clj.json-rpc.server :as server]) 10 | (:import 11 | [java.util.concurrent 12 | CountDownLatch 13 | Executors 14 | TimeUnit])) 15 | 16 | ;;; Test Fixtures and Helpers 17 | 18 | (def ^:private ^:dynamic *server* nil) 19 | (def ^:private ^:dynamic *client-session* nil) 20 | 21 | (defn read-sse-map 22 | [reader] 23 | (loop [resp {}] 24 | (when-let [line (try 25 | (.readLine reader) 26 | (catch java.io.IOException _))] 27 | (cond 28 | (or (empty? line) 29 | (.startsWith line ":")) 30 | resp 31 | :else 32 | (when-let [[k v] (str/split line #":" 2)] 33 | (let [v (str/trim v)] 34 | (recur 35 | (assoc resp (keyword k) 36 | (if (= "message" (:event resp)) 37 | (json/read-str v :key-fn keyword) 38 | v))))))))) 39 | 40 | (defn- parse-sse-message 41 | "Parse an SSE message from a line of text" 42 | [reader] 43 | (when-let [m (read-sse-map reader)] 44 | (:data m))) 45 | 46 | (defn- wait-for-endpoint 47 | "Wait for the endpoint message from the SSE stream" 48 | [reader] 49 | (let [m (read-sse-map reader)] 50 | (when (= (:event m) "endpoint") 51 | (:data m)))) 52 | 53 | (defn- establish-sse-connection 54 | "Establish an SSE connection and return session information" 55 | [port] 56 | (let [sse-url (format "http://localhost:%d/sse" port) 57 | response (hato/get sse-url 58 | {:headers {"Accept" "text/event-stream"} 59 | :as :stream}) 60 | reader (java.io.BufferedReader. 61 | (java.io.InputStreamReader. 62 | (:body response)))] 63 | (when (= http/Ok (:status response)) 64 | (when-let [endpoint (wait-for-endpoint reader)] 65 | {:reader reader 66 | :response response 67 | :endpoint endpoint})))) 68 | 69 | (def middleware 70 | "The default list of middleware hato uses for wrapping requests." 71 | [mw/wrap-request-timing 72 | 73 | mw/wrap-query-params 74 | mw/wrap-basic-auth 75 | mw/wrap-oauth 76 | mw/wrap-user-info 77 | mw/wrap-url 78 | 79 | mw/wrap-decompression 80 | mw/wrap-output-coercion 81 | mw/wrap-accept 82 | mw/wrap-accept-encoding 83 | mw/wrap-multipart 84 | 85 | mw/wrap-content-type 86 | mw/wrap-form-params 87 | mw/wrap-nested-params 88 | mw/wrap-method]) 89 | 90 | (defn- send-request 91 | "Send a JSON-RPC request to the server using the established session" 92 | [request] 93 | (when-let [{:keys [endpoint]} *client-session*] 94 | (let [url (str "http://localhost:" (:port *server*) endpoint)] 95 | (hato/post url 96 | {:headers {"Content-Type" "application/json"} 97 | :body (json/write-str request) 98 | :middleware middleware})))) 99 | 100 | (defn- make-request 101 | "Create a JSON-RPC request map" 102 | [method params & [id]] 103 | (cond-> {:jsonrpc "2.0" 104 | :method method 105 | :params params} 106 | id (assoc :id id))) 107 | 108 | (defn- parse-response 109 | "Parse a JSON-RPC response" 110 | [response] 111 | (try 112 | (some-> response 113 | :body 114 | (json/read-str :key-fn keyword)) 115 | (catch Exception _ 116 | {:jsonrpc "2.0" 117 | :error {:code -32700 118 | :message "Parse error"}}))) 119 | 120 | (defn- with-test-server 121 | "Test fixture that creates a server with basic configuration" 122 | [f] 123 | (let [executor (Executors/newScheduledThreadPool 2) 124 | server (server/create-server 125 | {:port 0 126 | :num-threads 2 127 | :on-sse-connect (fn [_] nil) 128 | :on-sse-close (fn [_] nil)})] 129 | (try 130 | (binding [*server* server] 131 | (let [session (establish-sse-connection (:port server))] 132 | (binding [*client-session* session] 133 | (server/set-handlers! server {"echo" (fn [_ params] params)}) 134 | (f)))) 135 | (finally 136 | (when-let [reader (:reader *client-session*)] 137 | (.close reader)) 138 | ((:stop server)) 139 | (.shutdown executor) 140 | (.awaitTermination executor 1 TimeUnit/SECONDS))))) 141 | 142 | (use-fixtures :each with-test-server) 143 | 144 | ;;; Tests 145 | 146 | (deftest connection-establishment-test 147 | (testing "SSE connection establishment" 148 | (is (some? *client-session*) "SSE connection should be established") 149 | (is (string? (:endpoint *client-session*)) "Should receive endpoint URL") 150 | (is (str/includes? (:endpoint *client-session*) "session_id=") 151 | "Endpoint should include session_id"))) 152 | 153 | (deftest server-request-handling-test 154 | (testing "Basic request handling" 155 | (testing "Echo request" 156 | (let [test-data {:test "data"} 157 | response (send-request (make-request "echo" test-data 1)) 158 | result (parse-response response)] 159 | (is (= http/Accepted (:status response))) 160 | (is (= "Accepted" (:body response))) 161 | 162 | ;; Check SSE response 163 | (let [reader (:reader *client-session*) 164 | message (parse-sse-message reader)] 165 | (is (= "2.0" (:jsonrpc message)) (pr-str message)) 166 | (is (= 1 (:id message))) 167 | (is (= test-data (:result message)))))) 168 | 169 | (testing "Invalid request format" 170 | (let [response (send-request {:not "valid"}) 171 | error (parse-response response)] 172 | (is (= http/BadRequest (:status response))) 173 | (is (-> error :error :code) (pr-str error)) 174 | (is (-> error :error :message) (pr-str error)))) 175 | 176 | (testing "Method not found" 177 | (let [response (send-request (make-request "nonexistent" {} 1)) 178 | result (parse-response response)] 179 | (is (= http/BadRequest (:status response))) 180 | (is (-> result :error :message)) 181 | (is (= -32601 (get-in result [:error :code]))))))) 182 | 183 | (deftest server-handlers-test 184 | (testing "Handler management" 185 | (let [test-handler (fn [_ params] {:processed params})] 186 | (testing "Add handler" 187 | (server/set-handlers! *server* 188 | {"echo" (fn [_ params] params) 189 | "test" test-handler}) 190 | (let [test-data {:value "test"} 191 | response (send-request (make-request "test" test-data 1)) 192 | _ (is (= http/Accepted (:status response))) 193 | reader (:reader *client-session*) 194 | message (parse-sse-message reader)] 195 | (is (= {:processed test-data} (:result message))))) 196 | 197 | (testing "Replace handlers" 198 | (server/set-handlers! *server* {"only" test-handler}) 199 | (let [response (send-request (make-request "echo" {} 1)) 200 | result (parse-response response)] 201 | (is (contains? result :error)) 202 | (is (= -32601 (get-in result [:error :code])))))))) 203 | 204 | (deftest notification-test 205 | (testing "Server notifications" 206 | (testing "Broadcast notification" 207 | (server/notify-all! *server* "test-event" {:data "test"}) 208 | (let [reader (:reader *client-session*) 209 | notification (parse-sse-message reader)] 210 | (is (= "2.0" (:jsonrpc notification))) 211 | (is (= "test-event" (:method notification))) 212 | (is (= {:data "test"} (:params notification))))) 213 | 214 | (testing "Single client notification" 215 | (let [session-id (-> *client-session* 216 | :endpoint 217 | (str/split #"=") 218 | second)] 219 | (server/notify! *server* session-id "single-event" {:data "test"}) 220 | (let [reader (:reader *client-session*) 221 | notification (parse-sse-message reader)] 222 | (is (= "2.0" (:jsonrpc notification))) 223 | (is (= "single-event" (:method notification))) 224 | (is (= {:data "test"} (:params notification)))))))) 225 | 226 | (deftest concurrent-requests-test 227 | (testing "Concurrent request handling" 228 | (let [request-count 5 229 | latch (CountDownLatch. request-count) 230 | responses (atom []) 231 | slow-handler (fn [_ _] 232 | (.countDown latch) 233 | (Thread/sleep 100) ; simulate work 234 | {:result "ok"}) 235 | reader (:reader *client-session*)] 236 | 237 | (server/set-handlers! *server* {"slow" slow-handler}) 238 | 239 | (testing "Multiple simultaneous requests" 240 | (let [requests (repeat request-count (make-request "slow" {} 1)) 241 | futures (doall 242 | (for [req requests] 243 | (future 244 | (send-request req))))] 245 | 246 | (is (.await latch 2 TimeUnit/SECONDS) 247 | "All requests should start within 2 seconds") 248 | 249 | (let [http-responses (doall (map deref futures))] 250 | (is (every? #(= http/Accepted (:status %)) http-responses) 251 | "All HTTP requests should be accepted")) 252 | 253 | ;; Collect SSE responses 254 | (dotimes [_ request-count] 255 | (swap! responses conj (parse-sse-message reader))) 256 | 257 | (is (every? #(= {:result "ok"} (:result %)) @responses) 258 | "All requests should complete successfully")))))) 259 | -------------------------------------------------------------------------------- /components/log/deps.edn: -------------------------------------------------------------------------------- 1 | {} 2 | -------------------------------------------------------------------------------- /components/log/src/mcp_clj/log.clj: -------------------------------------------------------------------------------- 1 | (ns mcp-clj.log 2 | (:require 3 | [clojure.string :as str])) 4 | 5 | (def ^:private levels #{:error :warn :info :debug :trace}) 6 | (def ^:private level-names 7 | (reduce 8 | (fn [res k] 9 | (assoc res k (str/upper-case (name k)))) 10 | {} 11 | levels)) 12 | 13 | (def ^:private aspects #{"sse" "http" "rpc" "client" "server"}) 14 | 15 | (defonce ^:private config (atom {})) 16 | 17 | (defn enable! 18 | "Enable logging for the specified level and aspect." 19 | [level aspect] 20 | {:pre [(contains? levels level)]} 21 | (swap! config assoc-in [level aspect] true)) 22 | 23 | (doseq [aspect aspects] 24 | (enable! :error aspect) 25 | (enable! :warn aspect)) 26 | 27 | 28 | (defn disable! 29 | "Disable logging for the specified level and aspect." 30 | [level aspect] 31 | {:pre [(contains? levels level)]} 32 | (swap! config assoc-in [level aspect] false)) 33 | 34 | (defn enabled? 35 | "Check if logging is enabled for the specified level and aspect." 36 | [level aspect] 37 | {:pre [(contains? levels level)]} 38 | (get-in @config [level aspect])) 39 | 40 | (defn output [level aspect id data] 41 | (locking *out* 42 | (println 43 | (str (level-names level) " [" aspect "/" (name id) "]" 44 | (when data (str " " (pr-str data))))))) 45 | 46 | (defmacro log 47 | "Log a message if enabled for the specified level and aspect. 48 | id - Identifier for the log entry, the namespace is the aspect 49 | level - One of :error, :warn, :info, :debug, :trace 50 | aspect - Keyword identifying the aspect being logged 51 | data - Optional map of data to include" 52 | [level id & [data]] 53 | `(let [id# ~id 54 | aspect# (namespace id#)] 55 | (when (enabled? ~level aspect#) 56 | (output ~level aspect# id# ~data)))) 57 | 58 | (defmacro error [id & [data]] `(log :error ~id ~data)) 59 | (defmacro warn [id & [data]] `(log :warn ~id ~data)) 60 | (defmacro info [id & [data]] `(log :info ~id ~data)) 61 | (defmacro debug [id & [data]] `(log :debug ~id ~data)) 62 | (defmacro trace [id & [data]] `(log :trace ~id ~data)) 63 | 64 | (comment 65 | (enable! :info "http") 66 | (enable! :info "sse") 67 | (enable! :info "rpc") 68 | (enable! :info "server") 69 | 70 | (enable! :debug "fred") 71 | (debug :fred/bloggs {:hello "some data"}) 72 | (info :sse/send! {:hello "some data"}) 73 | (info :rpc/request {:hello "some data"}) 74 | ) 75 | -------------------------------------------------------------------------------- /components/mcp-server/deps.edn: -------------------------------------------------------------------------------- 1 | {} 2 | -------------------------------------------------------------------------------- /components/mcp-server/src/mcp_clj/mcp_server/core.clj: -------------------------------------------------------------------------------- 1 | (ns mcp-clj.mcp-server.core 2 | "MCP server implementation supporting the Anthropic Model Context Protocol" 3 | (:require 4 | [mcp-clj.json-rpc.server :as json-rpc] 5 | [mcp-clj.log :as log] 6 | [mcp-clj.mcp-server.prompts :as prompts] 7 | [mcp-clj.mcp-server.resources :as resources] 8 | [mcp-clj.mcp-server.tools :as tools])) 9 | 10 | (def ^:private server-protocol-version "2024-11-05") 11 | (def ^:private required-client-version "2024-11-05") 12 | 13 | (defrecord ^:private Session 14 | [^String session-id 15 | initialized? 16 | client-info 17 | client-capabilities]) 18 | 19 | (defrecord ^:private MCPServer 20 | [json-rpc-server 21 | session-id->session 22 | tool-registry 23 | prompt-registry 24 | resource-registry]) 25 | 26 | (defn- request-session-id [request] 27 | (get ((:query-params request)) "session_id")) 28 | 29 | (defn- request-session 30 | [server request] 31 | (let [session-id (request-session-id request) 32 | session-id->session (:session-id->session server)] 33 | (get @session-id->session session-id))) 34 | 35 | (defn- notify-tools-changed! 36 | "Notify all sessions that the tool list has changed" 37 | [server] 38 | (log/info :server/notify-tools-changed {:server server}) 39 | (json-rpc/notify-all! 40 | @(:json-rpc-server server) 41 | "notifications/tools/list_changed" 42 | nil)) 43 | 44 | (defn- notify-prompts-changed! 45 | "Notify all sessions that the prompt list has changed" 46 | [server] 47 | (log/info :server/notify-prompts-changed {:server server}) 48 | (json-rpc/notify-all! 49 | @(:json-rpc-server server) 50 | "notifications/prompts/list_changed" 51 | nil)) 52 | 53 | (defn- notify-resources-changed! 54 | "Notify all sessions that the resource list has changed" 55 | [server] 56 | (log/info :server/notify-resources-changed {:server server}) 57 | (json-rpc/notify-all! 58 | @(:json-rpc-server server) 59 | "notifications/resources/list_changed" 60 | nil)) 61 | 62 | (defn- notify-resource-updated! 63 | "Notify all sessions that a resource has been updated" 64 | [server uri] 65 | (log/info :server/notify-resource-updated {:server server :uri uri}) 66 | (json-rpc/notify-all! 67 | @(:json-rpc-server server) 68 | "notifications/resources/updated" 69 | {:uri uri})) 70 | 71 | (defn- text-map [msg] 72 | {:type "text" :text msg}) 73 | 74 | (defn- validate-initialization! 75 | "Validate initialization request" 76 | [{:keys [protocolVersion capabilities]}] 77 | (when (not= protocolVersion required-client-version) 78 | {:isError true 79 | :content [(text-map "Unsupported MCP protocol version") 80 | (text-map (str "Expected: " required-client-version)) 81 | (text-map (str "Client: " protocolVersion))] }) 82 | #_(when-not (get-in capabilities [:tools]) 83 | (throw (ex-info "Client must support tools capability" 84 | {:code -32001 85 | :data {:missing [:tools]}})))) 86 | 87 | (defn- handle-initialize 88 | "Handle initialize request from client" 89 | [_server params] 90 | (log/info :server/initialize) 91 | (or (validate-initialization! params) 92 | {:serverInfo {:name "mcp-clj" 93 | :version "0.1.0"} 94 | :protocolVersion server-protocol-version 95 | :capabilities {:tools {:listChanged true} 96 | :resources {:listChanged false 97 | :subscribe false} 98 | :prompts {:listChanged true}} 99 | :instructions "mcp-clj is used to interact with a clojure REPL."})) 100 | 101 | (defn- handle-initialized 102 | "Handle initialized notification" 103 | [server _params] 104 | (log/info :server/initialized) 105 | (fn [session] 106 | (swap! (:session-id->session server) 107 | update (:session-id session) 108 | assoc :initialized? true))) 109 | 110 | (defn- handle-ping 111 | "Handle ping request" 112 | [_server _params] 113 | (log/info :server/ping) 114 | {}) 115 | 116 | (defn- handle-list-tools 117 | "Handle tools/list request from client" 118 | [server _params] 119 | (log/info :server/tools-list) 120 | {:tools (mapv tools/tool-definition (vals @(:tool-registry server)))}) 121 | 122 | (defn- handle-call-tool 123 | "Handle tools/call request from client" 124 | [server {:keys [name arguments] :as _params}] 125 | (log/info :server/tools-call) 126 | (if-let [{:keys [implementation]} (get @(:tool-registry server) name)] 127 | (try 128 | (implementation arguments) 129 | (catch Throwable e 130 | {:content [(text-map (str "Error: " (.getMessage e)))] 131 | :isError true})) 132 | {:content [(text-map (str "Tool not found: " name))] 133 | :isError true})) 134 | 135 | (defn- handle-list-resources 136 | "Handle resources/list request from client" 137 | [server params] 138 | (log/info :server/resources-list) 139 | (resources/list-resources (:resource-registry server) params)) 140 | 141 | (defn- handle-read-resource 142 | "Handle resources/read request from client" 143 | [server params] 144 | (log/info :server/resources-read) 145 | (resources/read-resource (:resource-registry server) params)) 146 | 147 | (defn- handle-subscribe-resource 148 | "Handle resources/subscribe request from client" 149 | [server params] 150 | (log/info :server/resources-subscribe) 151 | (resources/subscribe-resource (:resource-registry server) params)) 152 | 153 | (defn- handle-unsubscribe-resource 154 | "Handle resources/unsubscribe request from client" 155 | [server params] 156 | (log/info :server/resources-unsubscribe) 157 | (resources/unsubscribe-resource (:resource-registry server) params)) 158 | 159 | (defn- handle-list-prompts 160 | "Handle prompts/list request from client" 161 | [server params] 162 | (log/info :server/prompts-list) 163 | (prompts/list-prompts (:prompt-registry server) params)) 164 | 165 | (defn- handle-get-prompt 166 | "Handle prompts/get request from client" 167 | [server params] 168 | (log/info :server/prompts-get) 169 | (prompts/get-prompt (:prompt-registry server) params)) 170 | 171 | (defn- request-handler 172 | "Wrap a handler to support async responses" 173 | [server handler request params] 174 | (let [response (handler server params)] 175 | (if (fn? response) 176 | (let [session (request-session server request)] 177 | (if session 178 | (do 179 | (response session) 180 | nil) 181 | (log/error "missing mcp session"))) 182 | response))) 183 | 184 | (defn- create-handlers 185 | "Create request handlers with server reference" 186 | [server] 187 | (update-vals 188 | {"initialize" handle-initialize 189 | "notifications/initialized" handle-initialized 190 | "ping" handle-ping 191 | "tools/list" handle-list-tools 192 | "tools/call" handle-call-tool 193 | "resources/list" handle-list-resources 194 | "resources/read" handle-read-resource 195 | "resources/subscribe" handle-subscribe-resource 196 | "resources/unsubscribe" handle-unsubscribe-resource 197 | "prompts/list" handle-list-prompts 198 | "prompts/get" handle-get-prompt} 199 | (fn [handler] 200 | #(request-handler server handler %1 %2)))) 201 | 202 | (defn add-tool! 203 | "Add or update a tool in a running server" 204 | [server tool] 205 | (log/info :server/add-tool!) 206 | (when-not (tools/valid-tool? tool) 207 | (throw (ex-info "Invalid tool definition" {:tool tool}))) 208 | (swap! (:tool-registry server) assoc (:name tool) tool) 209 | (notify-tools-changed! server) 210 | server) 211 | 212 | (defn remove-tool! 213 | "Remove a tool from a running server" 214 | [server tool-name] 215 | (log/info :server/remove-tool!) 216 | (swap! (:tool-registry server) dissoc tool-name) 217 | (notify-tools-changed! server) 218 | server) 219 | 220 | (defn add-prompt! 221 | "Add or update a prompt in a running server" 222 | [server prompt] 223 | (log/info :server/add-prompt!) 224 | (when-not (prompts/valid-prompt? prompt) 225 | (throw (ex-info "Invalid prompt definition" {:prompt prompt}))) 226 | (swap! (:prompt-registry server) assoc (:name prompt) prompt) 227 | (notify-prompts-changed! server) 228 | server) 229 | 230 | (defn remove-prompt! 231 | "Remove a prompt from a running server" 232 | [server prompt-name] 233 | (log/info :server/remove-prompt!) 234 | (swap! (:prompt-registry server) dissoc prompt-name) 235 | (notify-prompts-changed! server) 236 | server) 237 | 238 | (defn- on-sse-connect 239 | [server id] 240 | (let [session (->Session id false nil nil)] 241 | (log/info :server/sse-connect {:session-id id}) 242 | (swap! (:session-id->session server) assoc id session))) 243 | 244 | (defn- on-sse-close 245 | [server id] 246 | (swap! (:session-id->session server) dissoc id)) 247 | 248 | (defn- stop! 249 | [server] 250 | (doseq [session (vals @(:session-id->session server))] 251 | (json-rpc/close! 252 | @(:json-rpc-server server) 253 | (:session-id session)))) 254 | 255 | (defn add-resource! 256 | "Add or update a resource in a running server" 257 | [server resource] 258 | (log/info :server/add-resource!) 259 | (when-not (resources/valid-resource? resource) 260 | (throw (ex-info "Invalid resource definition" {:resource resource}))) 261 | (swap! (:resource-registry server) assoc (:name resource) resource) 262 | (notify-resources-changed! server) 263 | server) 264 | 265 | (defn remove-resource! 266 | "Remove a resource from a running server" 267 | [server resource-name] 268 | (log/info :server/remove-resource!) 269 | (swap! (:resource-registry server) dissoc resource-name) 270 | (notify-resources-changed! server) 271 | server) 272 | 273 | (defn create-server 274 | "Create MCP server instance" 275 | [{:keys [port tools prompts resources] 276 | :or {tools tools/default-tools 277 | prompts prompts/default-prompts 278 | resources resources/default-resources}}] 279 | (doseq [tool (vals tools)] 280 | (when-not (tools/valid-tool? tool) 281 | (throw (ex-info "Invalid tool in constructor" {:tool tool})))) 282 | (doseq [prompt (vals prompts)] 283 | (when-not (prompts/valid-prompt? prompt) 284 | (throw (ex-info "Invalid prompt in constructor" {:prompt prompt})))) 285 | (let [session-id->session (atom {}) 286 | tool-registry (atom tools) 287 | prompt-registry (atom prompts) 288 | resource-registry (atom resources) 289 | rpc-server-prom (promise) 290 | server (->MCPServer 291 | rpc-server-prom 292 | session-id->session 293 | tool-registry 294 | prompt-registry 295 | resource-registry) 296 | json-rpc-server (json-rpc/create-server 297 | {:port port 298 | :on-sse-connect (partial on-sse-connect server) 299 | :on-sse-close (partial on-sse-close server)}) 300 | server (assoc server 301 | :stop #(do (stop! server) 302 | ((:stop json-rpc-server)))) 303 | handlers (create-handlers server)] 304 | (json-rpc/set-handlers! json-rpc-server handlers) 305 | (deliver rpc-server-prom json-rpc-server) 306 | server)) 307 | -------------------------------------------------------------------------------- /components/mcp-server/src/mcp_clj/mcp_server/prompts.clj: -------------------------------------------------------------------------------- 1 | (ns mcp-clj.mcp-server.prompts 2 | "MCP prompt endpoints" 3 | (:require 4 | [clojure.string :as str] 5 | [mcp-clj.log :as log])) 6 | 7 | (defn- validate-argument 8 | "Validate a prompt argument definition" 9 | [{:keys [name description]}] 10 | (and (string? name) 11 | (not (str/blank? name)) 12 | (or (nil? description) 13 | (string? description)))) 14 | 15 | (defn- validate-message 16 | "Validate a prompt message" 17 | [{:keys [role content]}] 18 | (and (contains? #{"user" "assistant" "system"} role) 19 | (or (and (map? content) 20 | (= "text" (:type content)) 21 | (string? (:text content))) 22 | (and (map? content) 23 | (= "resource" (:type content)) 24 | (map? (:resource content)))))) 25 | 26 | (defn valid-prompt? 27 | "Validate a prompt definition" 28 | [{:keys [name description arguments messages] :as prompt}] 29 | (when (and (string? name) 30 | (not (str/blank? name)) 31 | (or (nil? description) 32 | (string? description)) 33 | (or (nil? arguments) 34 | (and (vector? arguments) 35 | (every? validate-argument arguments))) 36 | (vector? messages) 37 | (every? validate-message messages)) 38 | prompt)) 39 | 40 | (defn- apply-template 41 | "Apply template arguments to a message" 42 | [message arguments] 43 | (if (and (= "text" (get-in message [:content :type])) 44 | (seq arguments)) 45 | (update-in message [:content :text] 46 | (fn [text] 47 | (reduce-kv 48 | (fn [t k v] 49 | (str/replace t (str "{{" (name k) "}}") v)) 50 | text 51 | arguments))) 52 | message)) 53 | 54 | (defn prompt-definition 55 | "Get the prompt definition without implementation details" 56 | [prompt] 57 | (select-keys prompt [:name :description :arguments])) 58 | 59 | (defn list-prompts 60 | "List available prompts" 61 | [registry _params] 62 | (log/info :prompts/list) 63 | {:prompts (mapv prompt-definition (vals @registry))}) 64 | 65 | (defn get-prompt 66 | "Get a specific prompt with optional arguments" 67 | [registry {:keys [name arguments] :as params}] 68 | (log/info :prompts/get {:params params}) 69 | (if-let [prompt (get @registry name)] 70 | (let [messages (if arguments 71 | (mapv #(apply-template % arguments) (:messages prompt)) 72 | (:messages prompt))] 73 | {:messages messages 74 | :description (:description prompt)}) 75 | {:content [{:type "text" 76 | :text (str "Prompt not found: " name)}] 77 | :isError true})) 78 | 79 | (def ^:private repl-prompt 80 | (valid-prompt? 81 | {:name "repl" 82 | :description "Standard REPL prompt for code evaluation" 83 | :messages [{:role "system" 84 | :content {:type "text" 85 | :text "You are interacting with a Clojure REPL."}} 86 | {:role "user" 87 | :content {:type "text" 88 | :text "Please evaluate {{code}}"}}] 89 | :arguments [{:name "code" 90 | :description "Clojure code to evaluate" 91 | :required true}]})) 92 | 93 | (def default-prompts 94 | "Default set of built-in prompts" 95 | {"repl" repl-prompt}) 96 | -------------------------------------------------------------------------------- /components/mcp-server/src/mcp_clj/mcp_server/resources.clj: -------------------------------------------------------------------------------- 1 | (ns mcp-clj.mcp-server.resources 2 | "MCP resource endpoints" 3 | (:require [mcp-clj.log :as log])) 4 | 5 | (defrecord ResourceDefinition [name uri mime-type description annotations implementation]) 6 | 7 | (defn- valid-string? [x] 8 | (and (string? x) 9 | (pos? (count x)))) 10 | 11 | (defn- valid-uri? [x] 12 | (try 13 | (java.net.URI. x) 14 | true 15 | (catch Exception _ 16 | false))) 17 | 18 | (defn- valid-audience-value? [x] 19 | (#{"user" "assistant"} x)) 20 | 21 | (defn- valid-audience? [x] 22 | (and (vector? x) 23 | (every? valid-audience-value? x))) 24 | 25 | (defn- valid-priority? [x] 26 | (and (number? x) 27 | (<= 0 x 1))) 28 | 29 | (defn- valid-annotations? [annotations] 30 | (and (map? annotations) 31 | (or (nil? (:priority annotations)) 32 | (valid-priority? (:priority annotations))) 33 | (or (nil? (:audience annotations)) 34 | (valid-audience? (:audience annotations))))) 35 | 36 | (defn valid-resource? 37 | "Validate a resource definition. 38 | Returns true if valid, throws ex-info with explanation if not." 39 | [{:keys [name uri mime-type annotations] :as resource}] 40 | (when-not (valid-string? name) 41 | (throw (ex-info "name must be a non-empty string" 42 | {:type :validation-error 43 | :field :name 44 | :value name 45 | :resource resource}))) 46 | (when-not (valid-uri? uri) 47 | (throw (ex-info "uri must be a valid URI string" 48 | {:type :validation-error 49 | :field :uri 50 | :value uri 51 | :resource resource}))) 52 | (when (and mime-type (not (valid-string? mime-type))) 53 | (throw (ex-info "mime-type must be a non-empty string" 54 | {:type :validation-error 55 | :field :mime-type 56 | :value mime-type 57 | :resource resource}))) 58 | (when (and annotations (not (valid-annotations? annotations))) 59 | (throw (ex-info "invalid annotations" 60 | {:type :validation-error 61 | :field :annotations 62 | :value annotations 63 | :resource resource}))) 64 | true) 65 | 66 | (defn resource-definition 67 | "Convert a ResourceDefinition to the wire format" 68 | [{:keys [name uri mime-type description annotations]}] 69 | (cond-> {:name name 70 | :uri uri} 71 | mime-type (assoc :mimeType mime-type) 72 | description (assoc :description description) 73 | annotations (assoc :annotations annotations))) 74 | 75 | (def default-resources {}) 76 | 77 | (defn list-resources 78 | "List available resources. 79 | Returns a map with :resources containing resource definitions." 80 | [registry params] 81 | (log/info :resources/list {:params params}) 82 | {:resources (mapv resource-definition (vals @registry))}) 83 | 84 | (defn- read-resource-impl 85 | "Default implementation for reading a resource" 86 | [{:keys [implementation] :as resource} uri] 87 | (if implementation 88 | (implementation uri) 89 | {:contents [{:uri uri 90 | :text "Resource not implemented"}] 91 | :isError true})) 92 | 93 | (defn read-resource 94 | "Read a resource by URI. 95 | Returns contents of the resource." 96 | [registry {:keys [uri] :as params}] 97 | (log/info :resources/read {:params params}) 98 | (if-let [resource (some #(when (= uri (:uri %)) %) (vals @registry))] 99 | (read-resource-impl resource uri) 100 | {:contents [{:uri uri 101 | :text "Resource not found"}] 102 | :isError true})) 103 | 104 | (defn subscribe-resource 105 | "Subscribe to updates for a resource. 106 | Returns empty result if successful, error if resource not found." 107 | [registry {:keys [uri] :as params}] 108 | (log/info :resources/subscribe {:params params}) 109 | (if (some #(when (= uri (:uri %)) %) (vals @registry)) 110 | {} 111 | {:content [{:type "text" 112 | :text (str "Resource not found: " uri)}] 113 | :isError true})) 114 | 115 | (defn unsubscribe-resource 116 | "Unsubscribe from updates for a resource. 117 | Returns empty result if successful." 118 | [_registry {:keys [uri] :as params}] 119 | (log/info :resources/unsubscribe {:params params}) 120 | {}) -------------------------------------------------------------------------------- /components/mcp-server/src/mcp_clj/mcp_server/tools.clj: -------------------------------------------------------------------------------- 1 | (ns mcp-clj.mcp-server.tools 2 | "Tool definitions and validation for MCP server") 3 | 4 | (defn safe-eval 5 | "Safely evaluate Clojure code, returning a result map" 6 | [code-str] 7 | (try 8 | (let [form (read-string code-str)] 9 | {:success true 10 | :result (with-out-str 11 | (binding [*err* *out*] 12 | (try 13 | (println (eval form)) 14 | (catch Throwable e 15 | (println (ex-message e) (pr-str (ex-data e))) 16 | (.printStackTrace e)))))}) 17 | (catch Throwable e 18 | {:success false 19 | :error (str (.getMessage e) "\n" 20 | "ex-data : " (pr-str (ex-data e)) "\n" 21 | (with-out-str 22 | (binding [*err* *out*] 23 | (.printStackTrace (ex-info "err" {})))))}))) 24 | 25 | 26 | (def clj-eval-impl 27 | "Implementation function for clj-eval tool" 28 | (fn [{:keys [code]}] 29 | (let [{:keys [success result error]} (safe-eval code)] 30 | (if success 31 | {:content [{:type "text" 32 | :text result}]} 33 | {:content [{:type "text" 34 | :text (str "Error: " error)}] 35 | :isError true})))) 36 | 37 | (def clj-eval-tool 38 | "Built-in clojure evaluation tool" 39 | {:name "clj-eval" 40 | :description "Evaluates a Clojure expression and returns the result" 41 | :inputSchema {:type "object" 42 | :properties {"code" {:type "string"}} 43 | :required ["code"]} 44 | :implementation clj-eval-impl}) 45 | 46 | (defn valid-tool? 47 | "Validate a tool definition" 48 | [{:keys [name description inputSchema implementation] :as tool}] 49 | (and (string? name) 50 | (not (empty? name)) 51 | (string? description) 52 | (map? inputSchema) 53 | (ifn? implementation))) 54 | 55 | (defn tool-definition 56 | [tool] 57 | (dissoc tool :implementation)) 58 | 59 | (def default-tools 60 | "Default set of built-in tools" 61 | {"clj-eval" clj-eval-tool}) 62 | -------------------------------------------------------------------------------- /components/mcp-server/src/mcp_clj/sse.clj: -------------------------------------------------------------------------------- 1 | (ns mcp-clj.sse 2 | (:require 3 | [mcp-clj.log :as log]) 4 | (:import 5 | [java.io Closeable 6 | OutputStream 7 | OutputStreamWriter])) 8 | 9 | (defn message 10 | [data] 11 | {:event "message" 12 | :data data}) 13 | 14 | (defn send! 15 | "Send SSE message with error handling" 16 | [^java.io.Writer writer message] 17 | (log/info :sse/send! message) 18 | (locking writer 19 | (doseq [[k v] message] 20 | (log/trace :sse/write (str (name k) ": " v "\n")) 21 | (.write writer (str (name k) ": " v "\n"))) 22 | (.write writer "\n") 23 | (.flush writer))) 24 | 25 | (defn- writer 26 | [^OutputStream output-stream] 27 | (OutputStreamWriter. output-stream "UTF-8")) 28 | 29 | (defn handler 30 | [request] 31 | (log/info :sse/handler) 32 | (let [output-stream (:response-body request) 33 | writer (writer output-stream) 34 | on-response-error (:on-response-error request) 35 | on-response-done (:on-response-done request) 36 | response-headers {"Cache-Control" "no-cache" 37 | "Connection" "keep-alive" 38 | "Content-Type" "text/event-stream"} 39 | initialised (promise)] 40 | {:reply! (fn reply! [response] 41 | (log/info :sse/reply! response) 42 | (try 43 | @initialised 44 | (send! writer response) 45 | true 46 | (catch Exception e 47 | (binding [*out* *err*] 48 | (println "Unexpected error writing SSE response") 49 | (println (ex-message e) (ex-data e)) 50 | (.printStackTrace e) 51 | (on-response-error) 52 | (on-response-done) 53 | (.close ^Closeable output-stream) 54 | (throw e))))) 55 | :close! (fn close [] 56 | (log/info :sse/close!) 57 | (try 58 | (on-response-done) 59 | (catch Exception e 60 | (binding [*out* *err*] 61 | (on-response-error) 62 | (.close ^Closeable output-stream) 63 | (println "Unexpected error closing SSE session") 64 | (println (ex-message e) (ex-data e)) 65 | (.printStackTrace e) 66 | (throw e))))) 67 | :response {:status 200 68 | :headers response-headers 69 | :body (fn [& _] (deliver initialised :initialised))}})) 70 | -------------------------------------------------------------------------------- /components/mcp-server/test/mcp_clj/mcp_server/tools_test.clj: -------------------------------------------------------------------------------- 1 | (ns mcp-clj.mcp-server.tools-test 2 | (:require 3 | [clojure.test :refer [deftest is testing use-fixtures]] 4 | [mcp-clj.mcp-server.core :as mcp] 5 | [mcp-clj.mcp-server.tools])) 6 | 7 | (def ^:private ^:dynamic *server*) 8 | 9 | (defn with-server 10 | "Test fixture for server lifecycle" 11 | [f] 12 | (let [server (mcp/create-server {:port 0 :threads 2 :queue-size 10})] 13 | (try 14 | (binding [*server* server] 15 | (f)) 16 | (finally 17 | ((:stop server)))))) 18 | 19 | (use-fixtures :each with-server) 20 | 21 | (deftest clj-eval-test 22 | (testing "clj eval" 23 | (let [{:keys [implementation]} (get @(:tool-registry *server*) "clj-eval")] 24 | 25 | (testing "successful evaluation" 26 | (let [result (implementation {:code "(+ 1 2)"})] 27 | (is (= {:content [{:type "text" 28 | :text "3\n"}]} 29 | result)))) 30 | 31 | (testing "divide by zero error" 32 | (let [result (implementation {:code "(/ 1 0)"})] 33 | (is (:isError result)) 34 | (is (= "text" (-> result :content first :type))) 35 | (is (.contains 36 | (-> result :content first :text) 37 | "Divide by zero")))) 38 | 39 | (testing "invalid syntax" 40 | (let [result (implementation {:code "(/ 1 0"})] 41 | (is (:isError result)) 42 | (is (= "text" (-> result :content first :type))) 43 | (is (.contains 44 | (-> result :content first :text) 45 | "EOF while reading"))))))) 46 | -------------------------------------------------------------------------------- /components/mcp-server/test/mcp_clj/mcp_server_test.clj: -------------------------------------------------------------------------------- 1 | (ns mcp-clj.mcp-server-test 2 | (:require 3 | [clojure.data.json :as json] 4 | [clojure.java.io :as io] 5 | [clojure.string :as str] 6 | [clojure.test :refer [deftest is testing use-fixtures]] 7 | [hato.client :as hato] 8 | [mcp-clj.mcp-server.core :as mcp]) 9 | (:import 10 | [java.util.concurrent BlockingQueue 11 | LinkedBlockingQueue 12 | TimeUnit])) 13 | 14 | (def test-tool 15 | "Test tool for server testing" 16 | {:name "test-tool" 17 | :description "A test tool for server testing" 18 | :inputSchema {:type "object" 19 | :properties {"value" {:type "string"}} 20 | :required ["value"]} 21 | :implementation (fn [{:keys [value]}] 22 | {:content [{:type "text" 23 | :text (str "test-response:" value)}]})}) 24 | 25 | (def error-test-tool 26 | "Test tool that always returns an error" 27 | {:name "error-test-tool" 28 | :description "A test tool that always returns an error" 29 | :inputSchema {:type "object" 30 | :properties {"value" {:type "string"}} 31 | :required ["value"]} 32 | :implementation (fn [_] 33 | {:content [{:type "text" 34 | :text "test-error"}] 35 | :isError true})}) 36 | 37 | (def test-prompt 38 | {:name "test-prompt" 39 | :description "A test prompt for server testing" 40 | :messages [{:role "system" 41 | :content {:type "text" 42 | :text "Hello"}} 43 | {:role "user" 44 | :content {:type "text" 45 | :text "Please say {{reply}}"}}] 46 | :arguments [{:name "reply" 47 | :description "something" 48 | :required true}]}) 49 | 50 | 51 | #_{:clj-kondo/ignore [:uninitialized-var]} 52 | (def ^:private ^:dynamic *server*) 53 | 54 | (defn with-server 55 | "Test fixture for server lifecycle" 56 | [f] 57 | (let [server (mcp/create-server 58 | {:port 0 59 | :threads 2 60 | :queue-size 10 61 | :tools {"test-tool" test-tool 62 | "error-test-tool" error-test-tool} 63 | :prompts {"test-prompt" test-prompt}})] 64 | (try 65 | (binding [*server* server] 66 | (f)) 67 | (finally 68 | ((:stop server)))))) 69 | 70 | (use-fixtures :each with-server) 71 | 72 | (defn send-request 73 | "Send JSON-RPC request" 74 | [url request] 75 | (prn :send-request url request) 76 | (-> (hato/post url 77 | {:headers {"Content-Type" "application/json"} 78 | :body (json/write-str request)}) 79 | #_:body 80 | #_(json/read-str :key-fn keyword))) 81 | 82 | (defn make-request 83 | "Create JSON-RPC request" 84 | [method params id] 85 | {:jsonrpc "2.0" 86 | :method method 87 | :params params 88 | :id id}) 89 | 90 | (defn- poll [^BlockingQueue queue] 91 | (.poll queue 2 TimeUnit/SECONDS)) 92 | 93 | (defn- offer [^BlockingQueue queue value] 94 | (.offer queue value)) 95 | 96 | (defn wait-for-sse-events 97 | [reader queue done] 98 | (loop [resp {}] 99 | (when-not @done 100 | (when-let [line (try 101 | (.readLine reader) 102 | (catch java.io.IOException _))] 103 | (prn :read-line line) 104 | (cond 105 | (or (empty? line) 106 | (.startsWith line ":")) 107 | (do 108 | (prn :enqueue resp) 109 | (offer queue resp) 110 | (recur {})) 111 | :else 112 | (when-let [[k v] (str/split line #":" 2)] 113 | (let [v (str/trim v)] 114 | (recur 115 | (assoc resp (keyword k) 116 | (if (= "message" (:event resp)) 117 | (json/read-str v :key-fn keyword) 118 | v)))))))))) 119 | 120 | (defn step-plan 121 | [state] 122 | (let [{:keys [action data fn msg apply-fn]} (first (:plan state))] 123 | (condp = action 124 | :receive (let [msg (poll (:queue state))] 125 | (prn :receive msg) 126 | (if msg 127 | (do 128 | (is msg) 129 | (is (= data (select-keys msg (keys data)))) 130 | (prn :qpply-fn apply-fn) 131 | (cond-> state 132 | apply-fn (apply-fn msg) 133 | true (update :plan rest))) 134 | (assoc state :failed {:missing-response data}))) 135 | :send (do 136 | (prn :send msg) 137 | (let [url (str (:url state) (:uri state)) 138 | resp (send-request url (assoc msg :id (:id state)))] 139 | (prn :resp resp) 140 | (if (< (:status resp) 300) 141 | (-> state 142 | (update :plan rest) 143 | (update :id inc)) 144 | (assoc state :failed resp)))) 145 | :notify (do 146 | (prn :notify msg) 147 | (let [url (str (:url state) (:uri state)) 148 | resp (send-request url msg)] 149 | (prn :resp resp) 150 | (if (< (:status resp) 300) 151 | (-> state 152 | (update :plan rest)) 153 | (assoc state :failed resp)))) 154 | :clj (do 155 | (fn) ; Execute the provided function 156 | (update state :plan rest)) 157 | 158 | (assoc state :failed {:unknown-action action})))) 159 | 160 | (defn run-plan [state] 161 | (loop [state (assoc state :id 0)] 162 | (let [state' (step-plan state)] 163 | (prn :run-plan :state' state') 164 | (cond 165 | (:failed state') 166 | [state' :failed] 167 | (not (seq (:plan state'))) 168 | [state' :passed] 169 | (seq (:plan state')) 170 | (recur state'))))) 171 | 172 | (defn- update-state-apply-key 173 | [state-key data-key] 174 | (fn apply-key [state data] 175 | (prn :apply-key :data data) 176 | (prn state-key (get data data-key)) 177 | (assoc state state-key (get data data-key)))) 178 | 179 | (defn- update-state-apply-data 180 | [state-key] 181 | (fn apply-data [state data] 182 | (prn :apply-data :state state :data data) 183 | (prn state-key data) 184 | (assoc state state-key data))) 185 | 186 | (defn- json-request 187 | [method params & [id]] 188 | (cond-> 189 | {:jsonrpc "2.0" 190 | :method method 191 | :params params} 192 | id (assoc :id id))) 193 | 194 | (defn- json-result 195 | [result & [options id]] 196 | (cond-> (merge {:jsonrpc "2.0" 197 | :result result} 198 | options) 199 | id (assoc :id id))) 200 | 201 | (defn- initialisation-plan [] 202 | [{:action :receive 203 | :data {:event "endpoint"} 204 | :apply-fn (update-state-apply-key :uri :data)} 205 | {:action :send 206 | :msg (json-request 207 | "initialize" 208 | {:protocolVersion "2024-11-05" 209 | :capabilities {:roots 210 | {:listChanged true} 211 | :tools 212 | {:listChanged true}} 213 | :clientInfo {:name "mcp" 214 | :version "0.1.0"}})} 215 | {:action :receive 216 | :data {:event "message"}} 217 | {:action :notify 218 | :msg (json-request 219 | "notifications/initialized" 220 | {})}]) 221 | 222 | (defn port [] 223 | (:port @(:json-rpc-server *server*))) 224 | 225 | (deftest lifecycle-test 226 | (testing "server lifecycle with SSE" 227 | (let [port (port) 228 | url (format "http://localhost:%d" port) 229 | queue (LinkedBlockingQueue.) 230 | state {:url url 231 | :queue queue 232 | :failed false} 233 | response (hato/get (str url "/sse") 234 | {:headers {"Accept" "text/event-stream"} 235 | :as :stream})] 236 | (with-open [reader (io/reader (:body response))] 237 | (let [done (volatile! nil) 238 | f (future 239 | (try 240 | (wait-for-sse-events reader queue done) 241 | (catch Throwable e 242 | (prn :error e) 243 | (flush))))] 244 | (testing "initialisation" 245 | (let [state (assoc state :plan (initialisation-plan)) 246 | [state' result] (run-plan state)] 247 | (is (= :passed result)) 248 | (is (not (:failed state'))))) 249 | (future-cancel f)))))) 250 | 251 | (deftest tools-test 252 | (testing "A server with tools" 253 | (let [port (port) 254 | url (format "http://localhost:%d" port) 255 | queue (LinkedBlockingQueue.) 256 | state {:url url 257 | :queue queue 258 | :failed false} 259 | response (hato/get (str url "/sse") 260 | {:headers {"Accept" "text/event-stream"} 261 | :as :stream})] 262 | (with-open [reader (io/reader (:body response))] 263 | (let [done (volatile! nil) 264 | f (future 265 | (try 266 | (wait-for-sse-events reader queue done) 267 | (catch Throwable e 268 | (prn :error e) 269 | (flush))))] 270 | (testing "initialisation" 271 | (let [state (assoc state :plan (initialisation-plan)) 272 | [state' result] (run-plan state)] 273 | (is (= :passed result)) 274 | (testing "tool interactions" 275 | (let [state 276 | (assoc 277 | state' 278 | :plan 279 | [{:action :send 280 | :msg (json-request 281 | "tools/list" 282 | {} 283 | 0)} 284 | {:action :receive 285 | :data 286 | {:event "message" 287 | :data 288 | (json-result 289 | {:tools 290 | [{:name "test-tool", 291 | :description "A test tool for server testing", 292 | :inputSchema 293 | {:type "object", 294 | :properties {:value {:type "string"}}, 295 | :required ["value"]}} 296 | {:name "error-test-tool", 297 | :description "A test tool that always returns an error", 298 | :inputSchema 299 | {:type "object", 300 | :properties {:value {:type "string"}}, 301 | :required ["value"]}}]} 302 | {} 303 | 0)}}]) 304 | [state' result] (run-plan state) 305 | _ (testing "tools/list" 306 | (is (= :passed result) (pr-str state)) 307 | (is (not (:failed state')))) 308 | state (assoc 309 | state' 310 | :plan 311 | [{:action :send 312 | :msg (json-request 313 | "tools/call" 314 | {:name "test-tool" 315 | :arguments 316 | {:value "me"}} 317 | 0)} 318 | {:action :receive 319 | :data 320 | {:event "message" 321 | :data 322 | (json-result 323 | {:content 324 | [{:type "text" 325 | :text "test-response:me"}]} 326 | nil 327 | 0)}}]) 328 | [state' result] (testing "makes a successful tools/call" 329 | (run-plan state)) 330 | _ (testing "makes a successful tools/call" 331 | (is (= :passed result)) 332 | (is (not (:failed state')))) 333 | state (assoc 334 | state' 335 | :plan 336 | [{:action :send 337 | :msg (json-request 338 | "tools/call" 339 | {:name "error-test-tool" 340 | :arguments 341 | {:value "me"}} 342 | 0)} 343 | {:action :receive 344 | :data 345 | {:event "message" 346 | :data 347 | (json-result 348 | {:content 349 | [{:type "text" 350 | :text "test-error"}] 351 | :isError true} 352 | nil 353 | 0)}}]) 354 | [state' result] (testing "tools/call with an error" 355 | (run-plan state)) 356 | _ (testing "tools/call with an error" 357 | (is (= :passed result)) 358 | (is (not (:failed state')))) 359 | state (assoc 360 | state' 361 | :plan 362 | [{:action :send 363 | :msg (json-request 364 | "tools/call" 365 | {:name "unkown" 366 | :arguments 367 | {:code "(/ 1 0)"}} 368 | 0)} 369 | {:action :receive 370 | :data 371 | {:event "message" 372 | :data 373 | (json-result 374 | {:content 375 | [{:type "text" 376 | :text "Tool not found: unkown"}] 377 | :isError true} 378 | nil 379 | 0)}}]) 380 | [state' result] (run-plan state) 381 | _ (testing "tools/call with unknown tool" 382 | (is (= :passed result)) 383 | (is (not (:failed state'))))])))) 384 | (future-cancel f)))))) 385 | 386 | (deftest tool-change-notifications-test 387 | (testing "tool change notifications" 388 | (let [port (port) 389 | url (format "http://localhost:%d" port) 390 | queue (LinkedBlockingQueue.) 391 | state {:url url 392 | :queue queue 393 | :failed false} 394 | test-tool {:name "test-tool" 395 | :description "A test tool" 396 | :inputSchema {:type "object" 397 | :properties {"value" {:type "string"}} 398 | :required ["value"]} 399 | :implementation (fn [{:keys [value]}] 400 | {:content [{:type "text" 401 | :text (str "Got: " value)}]})} 402 | response (hato/get (str url "/sse") 403 | {:headers {"Accept" "text/event-stream"} 404 | :as :stream})] 405 | (with-open [reader (io/reader (:body response))] 406 | (let [done (volatile! nil) 407 | f (future 408 | (try 409 | (wait-for-sse-events reader queue done) 410 | (catch Throwable e 411 | (prn :error e) 412 | (flush))))] 413 | (testing "initialisation and tool changes" 414 | (let [state (assoc 415 | state 416 | :plan 417 | (into 418 | (initialisation-plan) 419 | [;; Add tool and check for notification 420 | {:action :clj 421 | :fn #(mcp/add-tool! *server* test-tool)} 422 | {:action :receive 423 | :data {:event "message" 424 | :data {:jsonrpc "2.0" 425 | :method "notifications/tools/list_changed"}}} 426 | ;; Remove tool and check for notification 427 | {:action :clj 428 | :fn #(mcp/remove-tool! *server* "test-tool")} 429 | {:action :receive 430 | :data {:event "message" 431 | :data {:jsonrpc "2.0" 432 | :method "notifications/tools/list_changed"}}}])) 433 | [state' result] (run-plan state)] 434 | (is (= :passed result)) 435 | (is (not (:failed state'))))) 436 | (future-cancel f)))))) 437 | 438 | (deftest tool-management-test 439 | (testing "tool management" 440 | (let [test-tool {:name "test-tool" 441 | :description "A test tool" 442 | :inputSchema {:type "object" 443 | :properties {"value" {:type "string"}} 444 | :required ["value"]} 445 | :implementation (fn [{:keys [value]}] 446 | {:content [{:type "text" 447 | :text (str "Got: " value)}]})} 448 | server (mcp/create-server {:port 0 :threads 2})] 449 | (try 450 | ;; Test adding a tool 451 | (mcp/add-tool! server test-tool) 452 | (is (= test-tool (get @(:tool-registry server) "test-tool"))) 453 | 454 | ;; Test updating a tool 455 | (let [updated-tool (assoc test-tool 456 | :description "Updated description")] 457 | (mcp/add-tool! server updated-tool) 458 | (is (= updated-tool (get @(:tool-registry server) "test-tool")))) 459 | 460 | ;; Test removing a tool 461 | (mcp/remove-tool! server "test-tool") 462 | (is (nil? (get @(:tool-registry server) "test-tool"))) 463 | 464 | ;; Test adding invalid tool 465 | (is (thrown? clojure.lang.ExceptionInfo 466 | (mcp/add-tool! server (dissoc test-tool :implementation)))) 467 | 468 | (finally 469 | ((:stop server))))))) 470 | 471 | (deftest custom-tools-test 472 | (testing "server with custom tools" 473 | (let [custom-tool {:name "echo" 474 | :description "Echo the input" 475 | :inputSchema {:type "object" 476 | :properties {"text" {:type "string"}} 477 | :required ["text"]} 478 | :implementation (fn [{:keys [text]}] 479 | {:content [{:type "text" 480 | :text text}]})} 481 | port (port) 482 | url (format "http://localhost:%d" port) 483 | queue (LinkedBlockingQueue.) 484 | state {:url url 485 | :queue queue 486 | :failed false}] 487 | ;; Add custom tool to server 488 | (mcp/add-tool! *server* custom-tool) 489 | 490 | (let [response (hato/get (str url "/sse") 491 | {:headers {"Accept" "text/event-stream"} 492 | :as :stream})] 493 | (with-open [reader (io/reader (:body response))] 494 | (let [done (volatile! nil) 495 | f (future 496 | (try 497 | (wait-for-sse-events reader queue done) 498 | (catch Throwable e 499 | (prn :error e) 500 | (flush))))] 501 | (testing "using custom tool" 502 | (let [state (assoc state :plan (initialisation-plan)) 503 | [state' result] (run-plan state)] 504 | (is (= :passed result)) 505 | (testing "tool interactions" 506 | (let [state (assoc 507 | state' 508 | :plan 509 | [{:action :send 510 | :msg (json-request 511 | "tools/call" 512 | {:name "echo" 513 | :arguments {:text "hello"}} 514 | 0)} 515 | {:action :receive 516 | :data 517 | {:event "message" 518 | :data (json-result 519 | {:content 520 | [{:type "text" 521 | :text "hello"}]} 522 | nil 523 | 0)}}]) 524 | [state' result] (run-plan state)] 525 | (is (= :passed result)))))) 526 | (future-cancel f))))))) 527 | 528 | (deftest resource-test 529 | (testing "server lifecycle with SSE" 530 | (let [port (port) 531 | url (format "http://localhost:%d" port) 532 | queue (LinkedBlockingQueue.) 533 | state {:url url 534 | :queue queue 535 | :failed false} 536 | response (hato/get (str url "/sse") 537 | {:headers {"Accept" "text/event-stream"} 538 | :as :stream})] 539 | (with-open [reader (io/reader (:body response))] 540 | (let [done (volatile! nil) 541 | f (future 542 | (try 543 | (wait-for-sse-events reader queue done) 544 | (catch Throwable e 545 | (prn :error e) 546 | (flush))))] 547 | (testing "initialisation" 548 | (let [state (assoc state :plan (initialisation-plan)) 549 | [state' result] (run-plan state)] 550 | (is (= :passed result)) 551 | (testing "resource interactions" 552 | (let [state (assoc 553 | state' 554 | :plan 555 | [{:action :send 556 | :msg (json-request 557 | "resources/list" {} 0)} 558 | {:action :receive 559 | :data 560 | {:event "message" 561 | :data (json-result 562 | {:resources []} 563 | nil 564 | 0)}}]) 565 | [state' result] (run-plan state) 566 | _ (testing "resources/list" 567 | (is (= :passed result)))])))) 568 | (future-cancel f)))))) 569 | 570 | (deftest prompt-test 571 | (testing "server lifecycle with SSE" 572 | (let [port (port) 573 | url (format "http://localhost:%d" port) 574 | queue (LinkedBlockingQueue.) 575 | state {:url url 576 | :queue queue 577 | :failed false} 578 | response (hato/get (str url "/sse") 579 | {:headers {"Accept" "text/event-stream"} 580 | :as :stream})] 581 | (with-open [reader (io/reader (:body response))] 582 | (let [done (volatile! nil) 583 | f (future 584 | (try 585 | (wait-for-sse-events reader queue done) 586 | (catch Throwable e 587 | (prn :error e) 588 | (flush))))] 589 | (testing "initialisation" 590 | (let [state (assoc state :plan (initialisation-plan)) 591 | [state' result] (run-plan state)] 592 | (is (= :passed result)) 593 | (testing "prompt interactions" 594 | (let [state 595 | (assoc 596 | state' 597 | :plan 598 | [{:action :send 599 | :msg (json-request 600 | "prompts/list" 601 | {} 602 | 0)} 603 | {:action :receive 604 | :data 605 | {:event "message" 606 | :data 607 | (json-result 608 | {:prompts 609 | [{:name "test-prompt", 610 | :description "A test prompt for server testing", 611 | :arguments 612 | [{:name "reply" 613 | :description "something" 614 | :required true}]}]} 615 | nil 616 | 0)}}]) 617 | [state' result] (run-plan state) 618 | _ (testing "prompts/list" 619 | (is (= :passed result)))])))) 620 | (future-cancel f)))))) 621 | 622 | #_(deftest error-handling-test 623 | (testing "error handling" 624 | (let [port (port) 625 | url (format "http://localhost:%d" port)] 626 | 627 | (testing "invalid protocol version" 628 | (let [response (send-request 629 | url 630 | (make-request "initialize" 631 | (assoc valid-client-info 632 | :protocolVersion "0.2") 633 | 1))] 634 | (is (= -32001 (get-in response [:error :code]))))) 635 | 636 | (testing "uninitialized ping" 637 | (let [response (send-request url (make-request "ping" {} 1))] 638 | (is (= -32002 (get-in response [:error :code])))))))) 639 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths [] 2 | :aliases 3 | {:dev 4 | {:extra-paths ["development/src" "components/json-rpc/test"] 5 | :extra-deps 6 | {poly/http {:local/root "components/http"} 7 | poly/http-server {:local/root "components/http-server"} 8 | poly/json-rpc {:local/root "components/json-rpc"} 9 | poly/log {:local/root "components/log"} 10 | poly/mcp-server {:local/root "components/mcp-server"} 11 | lambdaisland/kaocha {:mvn/version "1.87.1366"} 12 | lambdaisland/kaocha-cloverage {:mvn/version "1.1.89"} 13 | org.clojure/clojure {:mvn/version "1.12.0"}}} 14 | :test {:extra-paths ["components/http-server/test" 15 | "components/json-rpc/test" 16 | "components/mcp-server/test"] 17 | :extra-deps 18 | {hato/hato {:mvn/version "1.0.0"} 19 | org.clojure/test.check {:mvn/version "1.1.1"}} 20 | :exec-fn kaocha.runner/exec-fn 21 | :exec-args {} 22 | :jvm-opts ["-XX:-OmitStackTraceInFastThrow" 23 | "-Dclojure.main.report=stderr"] } 24 | :kaocha {:extra-paths ["components/json-rpc/test"] 25 | :extra-deps 26 | {lambdaisland/kaocha {:mvn/version "1.91.1392"} 27 | lambdaisland/kaocha-cloverage {:mvn/version "1.1.89"} 28 | org.clojure/test.check {:mvn/version "1.1.1"}} 29 | :exec-fn kaocha.runner/exec-fn 30 | :exec-args {} 31 | :jvm-opts ["-XX:-OmitStackTraceInFastThrow" 32 | "-Dclojure.main.report=stderr"] 33 | :main-opts ["-m" "kaocha.runner"]} 34 | } 35 | } 36 | -------------------------------------------------------------------------------- /design/namespaces.md: -------------------------------------------------------------------------------- 1 | All clojure code must use the `mcp-clj` top level namespace. 2 | -------------------------------------------------------------------------------- /design/project-scope.md: -------------------------------------------------------------------------------- 1 | # MCP-CLJ Project Scope 2 | 3 | ## Project Overview 4 | 5 | MCP-CLJ is a Clojure implementation of the Model-Channel Protocol (MCP) 6 | defined by Anthropic. The project provides both client and server 7 | components for MCP communication, with a specific focus on exposing 8 | Clojure REPL functionality. 9 | 10 | ## Core Components 11 | 12 | ### 1. MCP Protocol Implementation 13 | - Implementation of the MCP protocol specification as defined by Anthropic 14 | - Support for MCP message formats and communication patterns 15 | - Protocol version compatibility management 16 | 17 | ### 2. Client Component 18 | - MCP client implementation for connecting to MCP servers 19 | - Client-side message handling and protocol operations 20 | - Error handling and connection management 21 | 22 | ### 3. Server Component 23 | - MCP server implementation for accepting client connections 24 | - Server-side message handling and protocol operations 25 | - Connection management and client session handling 26 | 27 | ### 4. Clojure REPL Integration 28 | - REPL session management 29 | - Code evaluation capabilities 30 | - REPL state management 31 | - Output capturing and formatting 32 | 33 | ## Project Boundaries 34 | 35 | ### In Scope 36 | - MCP protocol implementation (client and server) 37 | - Basic Clojure REPL functionality 38 | - Core message handling and communication 39 | - Standard error handling and reporting 40 | - Basic session management 41 | 42 | ### Out of Scope 43 | - Advanced IDE features 44 | - Code analysis tools 45 | - Debugging facilities 46 | - Performance monitoring tools 47 | - Security features beyond basic protocol requirements 48 | 49 | ## Dependencies 50 | - Clojure 1.12.0 51 | - JSON-RPC component (local) 52 | - Testing frameworks (Kaocha) 53 | 54 | ## Constraints 55 | - Must maintain compatibility with Anthropic's MCP specification 56 | - Focus on simplicity and core functionality 57 | - Minimize external dependencies 58 | - Maintain clear separation between protocol and REPL concerns 59 | 60 | ## Success Criteria 61 | 1. Successful implementation of MCP protocol specification 62 | 2. Reliable client-server communication 63 | 3. Functional Clojure REPL integration 64 | 4. Comprehensive test coverage 65 | 5. Clear documentation of usage and features 66 | 67 | ## Future Considerations 68 | While out of current scope, the following areas may be considered for 69 | future development: 70 | - Enhanced REPL features 71 | - Additional development tools 72 | - Performance optimizations 73 | - Security enhancements 74 | - Extended protocol features 75 | 76 | This scope is subject to revision as requirements evolve or as new needs 77 | are identified. 78 | -------------------------------------------------------------------------------- /doc/adr/001-json-rpc-server.md: -------------------------------------------------------------------------------- 1 | # ADR 001: JSON-RPC Server Design 2 | 3 | ## Status 4 | Proposed 5 | 6 | ## Context 7 | The project requires a JSON-RPC server component that can: 8 | - Support the MCP protocol implementation 9 | - Handle extensible message dispatch 10 | - Be managed as a first-class server object 11 | - Support clean shutdown 12 | - Handle EDN/JSON conversion transparently 13 | 14 | ## Decision 15 | 16 | ### Server Interface 17 | 18 | The server will be implemented as a pure function that creates a server instance: 19 | 20 | ```clojure 21 | (create-server config) -> {:server server-object 22 | :stop (fn [] ...)} 23 | ``` 24 | 25 | Configuration parameters: 26 | - `:port` - Required. Port number to listen on 27 | - `:handlers` - Required. Map of method names to handler functions 28 | 29 | Handler function signature: 30 | ```clojure 31 | (handler-fn params) -> edn-response 32 | 33 | ;; Example handler returning EDN data: 34 | (defn example-handler [params] 35 | {:result {:status :ok 36 | :data [1 2 3] 37 | :meta {:timestamp #inst "2024"}}}) ;; EDN data structures 38 | ``` 39 | 40 | Server will: 41 | 1. Parse incoming JSON into EDN before passing to handler 42 | 2. Convert handler's EDN response to JSON before sending to client 43 | 3. Properly handle EDN-specific data types (e.g. keywords, dates, symbols) 44 | 45 | ### Core Functionality 46 | 47 | 1. Server Management 48 | - Server creation returns a map containing the server object and stop function 49 | - Stop function cleanly shuts down the server and releases resources 50 | - Server status can be queried through the server object 51 | 52 | 2. Request Handling 53 | - Validates incoming JSON-RPC 2.0 message format 54 | - Converts JSON request to EDN before dispatch 55 | - Dispatches requests to registered handlers 56 | - Converts EDN response to JSON 57 | - Returns properly formatted JSON-RPC 2.0 responses 58 | - Handles batch requests as per JSON-RPC 2.0 spec 59 | 60 | 3. Error Handling 61 | - Standard JSON-RPC 2.0 error responses 62 | - Invalid requests return -32600 error 63 | - Method not found returns -32601 error 64 | - Invalid params return -32602 error 65 | - Internal errors return -32603 error 66 | - Parse errors return -32700 error 67 | - JSON conversion errors return -32603 error 68 | 69 | ### Example Usage 70 | 71 | ```clojure 72 | ;; Create server with handlers returning EDN 73 | (def server (create-server 74 | {:port 8080 75 | :handlers {"echo" (fn [params] 76 | {:result params}) ; EDN map returned 77 | "get-config" (fn [params] 78 | {:result {:enabled? true 79 | :features [:a :b :c] 80 | :updated-at #inst "2024"}})}})) 81 | 82 | ;; Stop server when done 83 | ((:stop server)) 84 | ``` 85 | 86 | ## Consequences 87 | 88 | ### Positive 89 | - Clean separation of server lifecycle management 90 | - Extensible handler mechanism 91 | - First-class server objects 92 | - Standard JSON-RPC 2.0 compliance 93 | - Simple configuration 94 | - Native EDN support for handlers 95 | - Automatic JSON/EDN conversion 96 | 97 | ### Negative 98 | - Limited to TCP/IP transport 99 | - Synchronous handler execution model 100 | - Single port per server instance 101 | - Overhead from JSON/EDN conversions 102 | 103 | ### Neutral 104 | - Stateless request handling 105 | - No built-in authentication/authorization 106 | - No persistent connections 107 | - JSON serialization overhead for each request 108 | 109 | ## Related Documents 110 | - [JSON-RPC 2.0 Specification](https://www.jsonrpc.org/specification) 111 | - Project Scope Document 112 | 113 | ## Notes 114 | - This component focuses solely on JSON-RPC server functionality 115 | - Security features beyond basic protocol requirements are out of scope 116 | - Performance optimization is not a primary concern for initial implementation 117 | - Handlers work with native EDN data, server handles JSON conversion 118 | -------------------------------------------------------------------------------- /projects/server/deps.edn: -------------------------------------------------------------------------------- 1 | {:deps 2 | {poly/http {:local/root "../../components/http"} 3 | poly/http-server {:local/root "../../components/http-server"} 4 | poly/json-rpc {:local/root "../../components/json-rpc"} 5 | poly/log {:local/root "../../components/log"} 6 | poly/mcp-server {:local/root "../../components/mcp-server"}}} 7 | --------------------------------------------------------------------------------