MCP tested in Claude

deps-lock.json

@@ -26,9 +26,9 @@
     {
       "lib": "io.github.slimslenderslacks/lsp4clj",
       "url": "https://github.com/slimslenderslacks/lsp4clj.git",
-      "rev": "995abcdbfebfa7ef6550625fe1ef3ca2c7683292",
+      "rev": "04390f9b1dcf0946dff335b48951617bc6bf6a9d",
       "git-dir": "https/github.com/slimslenderslacks/lsp4clj",
-      "hash": "sha256-6RQ95oLS+ZX36x88yQY8v7QOhVtkqYVtMFMkW/ENlnM="
+      "hash": "sha256-LtBVHKhOsn6L8arX0AWuNnsz5YWT1dypmZFxosJ6rzQ="
     }
   ],
   "mvn-deps": [

deps.edn

@@ -13,7 +13,7 @@
         org.clojure/core.async {:mvn/version "1.6.681"}
         org.babashka/http-client {:mvn/version "0.4.12"}
         com.taoensso/timbre {:mvn/version "5.2.1"}
-        io.github.slimslenderslacks/lsp4clj {:git/sha "995abcdbfebfa7ef6550625fe1ef3ca2c7683292"}
+        io.github.slimslenderslacks/lsp4clj {:git/sha "04390f9b1dcf0946dff335b48951617bc6bf6a9d"}
         funcool/promesa {:mvn/version "9.0.470"}}
  :aliases {:main {:main-opts ["-m" "docker.main"]}
            :build {:ns-default build

src/docker/main.clj

@@ -66,6 +66,8 @@
                [nil "--nostream" "disable streaming responses"
                 :id :stream
                 :assoc-fn (fn [m k _] (assoc m k false))]
+               [nil "--register ref" "register a prompt REF"]
+               [nil "--mcp" "use the mcp jsonrpc protocol"]
                [nil "--debug" "add debug logging"]
                [nil "--help" "print option summary"]])
 
@@ -171,11 +173,6 @@
                  (constantly
                   (fn [method params]
                     (jsonrpc.producer/publish-docker-notify producer method params))))
-                (when (:prompts opts)
-                  (try
-                    (db/add opts)
-                    (catch Throwable t
-                      (logger/error t))))
                 (let [finished @server-promise]
                   {:result-code (if (= :done finished) 0 1)})))
     (fn []

src/jsonrpc.clj

@@ -163,6 +163,7 @@
           (when-let [line (read-line)]
             (println :mcp line)
             (recur))))))
+  (write-message (:in mcp) (request "initialize" {} (constantly 1)))
   (write-message (:in mcp) (request "ping" {} (constantly 1)))
   (-> @mcp :err)
   (-> @mcp :out slurp)

src/jsonrpc/db.clj

@@ -6,15 +6,19 @@
 
 (def db* (atom {}))
 
-(defn get-prompt-data [{:keys [prompts] :as opts}]
-  (let [f (if (string? prompts) (git/prompt-file prompts) prompts)
+(defn get-prompt-data [{:keys [register] :as opts}]
+  (let [f (git/prompt-file register)
         {:keys [messages metadata functions] :as entry} (prompts/get-prompts (assoc opts :prompts f))]
     entry))
 
 (defn add [opts]
-  (logger/info "adding prompts" (:prompts opts))
-  (swap! db* update-in [:mcp.prompts/registry] (fnil assoc {}) (:prompts opts) (get-prompt-data opts)))
+  (logger/info "adding prompts" (:register opts))
+  (swap! db* update-in [:mcp.prompts/registry] 
+         (fnil assoc {}) 
+         #_(:register opts) 
+         "explain_dockerfile"
+         (get-prompt-data opts)))
 
 (comment
-  (add {:prompts "github:docker/labs-ai-tools-for-devs?path=prompts/examples/explain_dockerfile.md&ref=slim/server"}))
+  (add {:register "github:docker/labs-ai-tools-for-devs?path=prompts/examples/explain_dockerfile.md&ref=slim/server"}))
 

src/jsonrpc/server.clj

@@ -13,6 +13,7 @@
    [jsonrpc.logger :as logger]
    [jsonrpc.producer :as producer]
    [lsp4clj.coercer :as coercer]
+   [lsp4clj.io-chan :as io-chan]
    [lsp4clj.io-server :refer [stdio-server]]
    [lsp4clj.server :as lsp.server]
    [promesa.core :as p]
@@ -45,7 +46,8 @@
   [level & args]
   ;; NOTE: this does not do compile-time elision because the level isn't a constant.
   ;; We don't really care because we always log all levels.
-  (timbre/log! level :p args))
+  (logger/info (str level (apply str args)))
+  #_(timbre/log! level :p args))
 
 (defn log! [level args fmeta]
   (timbre/log! level :p args {:?line (:line fmeta)
@@ -70,15 +72,12 @@
   ;; merges client-info capabilities and client protocol-version
   (swap! db* merge params)
   {:protocol-version "2024-11-05"
-   :capabilities {:logging {}
-                  :prompts {}
-                  :resources {}
-                  :tools {}
-                  :experimental {}}
+   :capabilities {:prompts {}
+                  :tools {}}
    :server-info {:name "docker-mcp-server"
                  :version "0.0.1"}})
 
-(defmethod lsp.server/receive-notification "initialized" [_ _ _]
+(defmethod lsp.server/receive-notification "notifications/initialized" [_ _ _]
   (logger/info "Initialized!"))
 
 ; level is debug info notice warning error critical alert emergency
@@ -93,18 +92,21 @@
                 :hasMore false}})
 
 (defn entry->prompt-listing [k v m]
-  {:description (-> v :metadata :description)
-   :name (str k)
-   :arguments []})
+  {:name (str k)})
 
-(defmethod lsp.server/receive-request "prompts/list" [_ {:keys [db*]} _]
+(defmethod lsp.server/receive-request "prompts/list" [_ {:keys [db*]} params]
   ;; TODO might contain a cursor
-  {:prompts (->> (:mcp.prompts/registry @db*)
-                 (mapcat (fn [[k v]] (map (partial entry->prompt-listing k v) (:messages v))))
-                 (into []))})
+  (logger/info "prompts/list" params)
+  (let [prompts
+        {:prompts (->> (:mcp.prompts/registry @db*)
+                       (mapcat (fn [[k v]] (map (partial entry->prompt-listing k v) (:messages v))))
+                       (into []))}]
+    (logger/info prompts)
+    prompts))
 
 (defmethod lsp.server/receive-request "prompts/get" [_ {:keys [db*]} {:keys [name]}]
   ;; TODO resolve arguments
+  (logger/info "prompts/get")
   (let [{:keys [messages metadata]} (-> @db* :mcp.prompts/registry (get name))]
     {:description (:description metadata)
      :messages (->> messages
@@ -128,6 +130,7 @@
 
 (defmethod lsp.server/receive-request "tools/list" [_ {:keys [db*]} _]
   ;; TODO cursors
+  (logger/info "tools/list")
   {:tools (->> (:mcp.prompts/registry @db*)
                (vals)
                (mapcat :functions)
@@ -137,22 +140,25 @@
                (into []))})
 
 (defmethod lsp.server/receive-request "tools/call" [_ {:keys [db*]} params]
-  (eventually
-   (lsp.server/discarding-stdout
-    (let [tools (->> @db* :mcp.prompts/registry vals (mapcat :functions))
-          tool-defaults {:functions tools
-                         :host-dir (-> @db* :host-dir)}]
-      {:content
-       (->>
-        (tools/make-tool-calls 
-          0 
-          (partial tools/function-handler tool-defaults) 
-          [{:function (update params :arguments (fn [arguments] (json/generate-string arguments))) :id "1"}])
-        (async/reduce conj [])
-        (async/<!!)
-        (map :content)
-        (apply str))
-       :is-error false}))))
+  (logger/info "tools/call")
+  (lsp.server/discarding-stdout
+   (let [tools (->> @db* :mcp.prompts/registry vals (mapcat :functions))
+         tool-defaults {:functions tools
+                        :host-dir (-> @db* :host-dir)}]
+     (logger/info "calling tools " tool-defaults)
+     (logger/info "with params" params)
+     (let [content (->>
+                    (tools/make-tool-calls
+                     0
+                     (partial tools/function-handler tool-defaults)
+                     [{:function (update params :arguments (fn [arguments] (json/generate-string arguments))) :id "1"}])
+                    (async/reduce conj [])
+                    (async/<!!)
+                    (map :content)
+                    (apply str))]
+       (logger/info "content " content)
+       {:content [{:type "text" :text content}]
+        :is-error false}))))
 
 (defmethod lsp.server/receive-request "docker/prompts/register" [_ {:keys [db* id]} params]
   ;; supports only git refs
@@ -264,20 +270,30 @@
          log-path (logger/setup timbre-logger)
          db* db/db*
          log-ch (async/chan (async/sliding-buffer 20))
-         server (stdio-server {;:keyword-function identity
-                               :in (or (:in opts) System/in)
-                               :out System/out
-                               :log-ch log-ch
-                               :trace-ch log-ch
-                               :trace-level trace-level})
+         server (stdio-server
+                 (merge
+                  {;:keyword-function identity
+                   :in (or (:in opts) System/in)
+                   :out System/out
+                   :log-ch log-ch
+                   :trace-ch log-ch
+                   :trace-level trace-level}
+                  (when (:mcp opts)
+                    {:in-chan-factory io-chan/mcp-input-stream->input-chan
+                     :out-chan-factory io-chan/mcp-output-stream->output-chan})))
          producer (McpProducer. server db*)
          components {:db* db*
                      :logger timbre-logger
                      :producer producer
                      :server server}]
      (swap! db* merge {:log-path log-path} (dissoc opts :in))
-     (logger/info "Starting server...")
+     (when (:register opts)
+       (try
+         (db/add opts)
+         (catch Throwable t
+           (logger/error t))))
      (monitor-server-logs log-ch)
+     (logger/info "Starting server...")
      [producer (lsp.server/start server components)])))
 
 (comment