|
13 | 13 | [jsonrpc.logger :as logger]
|
14 | 14 | [jsonrpc.producer :as producer]
|
15 | 15 | [lsp4clj.coercer :as coercer]
|
| 16 | + [lsp4clj.io-chan :as io-chan] |
16 | 17 | [lsp4clj.io-server :refer [stdio-server]]
|
17 | 18 | [lsp4clj.server :as lsp.server]
|
18 | 19 | [promesa.core :as p]
|
|
45 | 46 | [level & args]
|
46 | 47 | ;; NOTE: this does not do compile-time elision because the level isn't a constant.
|
47 | 48 | ;; We don't really care because we always log all levels.
|
48 |
| - (timbre/log! level :p args)) |
| 49 | + (logger/info (str level (apply str args))) |
| 50 | + #_(timbre/log! level :p args)) |
49 | 51 |
|
50 | 52 | (defn log! [level args fmeta]
|
51 | 53 | (timbre/log! level :p args {:?line (:line fmeta)
|
|
70 | 72 | ;; merges client-info capabilities and client protocol-version
|
71 | 73 | (swap! db* merge params)
|
72 | 74 | {:protocol-version "2024-11-05"
|
73 |
| - :capabilities {:logging {} |
74 |
| - :prompts {} |
75 |
| - :resources {} |
76 |
| - :tools {} |
77 |
| - :experimental {}} |
| 75 | + :capabilities {:prompts {} |
| 76 | + :tools {}} |
78 | 77 | :server-info {:name "docker-mcp-server"
|
79 | 78 | :version "0.0.1"}})
|
80 | 79 |
|
81 |
| -(defmethod lsp.server/receive-notification "initialized" [_ _ _] |
| 80 | +(defmethod lsp.server/receive-notification "notifications/initialized" [_ _ _] |
82 | 81 | (logger/info "Initialized!"))
|
83 | 82 |
|
84 | 83 | ; level is debug info notice warning error critical alert emergency
|
|
93 | 92 | :hasMore false}})
|
94 | 93 |
|
95 | 94 | (defn entry->prompt-listing [k v m]
|
96 |
| - {:description (-> v :metadata :description) |
97 |
| - :name (str k) |
98 |
| - :arguments []}) |
| 95 | + {:name (str k)}) |
99 | 96 |
|
100 |
| -(defmethod lsp.server/receive-request "prompts/list" [_ {:keys [db*]} _] |
| 97 | +(defmethod lsp.server/receive-request "prompts/list" [_ {:keys [db*]} params] |
101 | 98 | ;; TODO might contain a cursor
|
102 |
| - {:prompts (->> (:mcp.prompts/registry @db*) |
103 |
| - (mapcat (fn [[k v]] (map (partial entry->prompt-listing k v) (:messages v)))) |
104 |
| - (into []))}) |
| 99 | + (logger/info "prompts/list" params) |
| 100 | + (let [prompts |
| 101 | + {:prompts (->> (:mcp.prompts/registry @db*) |
| 102 | + (mapcat (fn [[k v]] (map (partial entry->prompt-listing k v) (:messages v)))) |
| 103 | + (into []))}] |
| 104 | + (logger/info prompts) |
| 105 | + prompts)) |
105 | 106 |
|
106 | 107 | (defmethod lsp.server/receive-request "prompts/get" [_ {:keys [db*]} {:keys [name]}]
|
107 | 108 | ;; TODO resolve arguments
|
| 109 | + (logger/info "prompts/get") |
108 | 110 | (let [{:keys [messages metadata]} (-> @db* :mcp.prompts/registry (get name))]
|
109 | 111 | {:description (:description metadata)
|
110 | 112 | :messages (->> messages
|
|
128 | 130 |
|
129 | 131 | (defmethod lsp.server/receive-request "tools/list" [_ {:keys [db*]} _]
|
130 | 132 | ;; TODO cursors
|
| 133 | + (logger/info "tools/list") |
131 | 134 | {:tools (->> (:mcp.prompts/registry @db*)
|
132 | 135 | (vals)
|
133 | 136 | (mapcat :functions)
|
|
137 | 140 | (into []))})
|
138 | 141 |
|
139 | 142 | (defmethod lsp.server/receive-request "tools/call" [_ {:keys [db*]} params]
|
140 |
| - (eventually |
141 |
| - (lsp.server/discarding-stdout |
142 |
| - (let [tools (->> @db* :mcp.prompts/registry vals (mapcat :functions)) |
143 |
| - tool-defaults {:functions tools |
144 |
| - :host-dir (-> @db* :host-dir)}] |
145 |
| - {:content |
146 |
| - (->> |
147 |
| - (tools/make-tool-calls |
148 |
| - 0 |
149 |
| - (partial tools/function-handler tool-defaults) |
150 |
| - [{:function (update params :arguments (fn [arguments] (json/generate-string arguments))) :id "1"}]) |
151 |
| - (async/reduce conj []) |
152 |
| - (async/<!!) |
153 |
| - (map :content) |
154 |
| - (apply str)) |
155 |
| - :is-error false})))) |
| 143 | + (logger/info "tools/call") |
| 144 | + (lsp.server/discarding-stdout |
| 145 | + (let [tools (->> @db* :mcp.prompts/registry vals (mapcat :functions)) |
| 146 | + tool-defaults {:functions tools |
| 147 | + :host-dir (-> @db* :host-dir)}] |
| 148 | + (logger/info "calling tools " tool-defaults) |
| 149 | + (logger/info "with params" params) |
| 150 | + (let [content (->> |
| 151 | + (tools/make-tool-calls |
| 152 | + 0 |
| 153 | + (partial tools/function-handler tool-defaults) |
| 154 | + [{:function (update params :arguments (fn [arguments] (json/generate-string arguments))) :id "1"}]) |
| 155 | + (async/reduce conj []) |
| 156 | + (async/<!!) |
| 157 | + (map :content) |
| 158 | + (apply str))] |
| 159 | + (logger/info "content " content) |
| 160 | + {:content [{:type "text" :text content}] |
| 161 | + :is-error false})))) |
156 | 162 |
|
157 | 163 | (defmethod lsp.server/receive-request "docker/prompts/register" [_ {:keys [db* id]} params]
|
158 | 164 | ;; supports only git refs
|
|
264 | 270 | log-path (logger/setup timbre-logger)
|
265 | 271 | db* db/db*
|
266 | 272 | log-ch (async/chan (async/sliding-buffer 20))
|
267 |
| - server (stdio-server {;:keyword-function identity |
268 |
| - :in (or (:in opts) System/in) |
269 |
| - :out System/out |
270 |
| - :log-ch log-ch |
271 |
| - :trace-ch log-ch |
272 |
| - :trace-level trace-level}) |
| 273 | + server (stdio-server |
| 274 | + (merge |
| 275 | + {;:keyword-function identity |
| 276 | + :in (or (:in opts) System/in) |
| 277 | + :out System/out |
| 278 | + :log-ch log-ch |
| 279 | + :trace-ch log-ch |
| 280 | + :trace-level trace-level} |
| 281 | + (when (:mcp opts) |
| 282 | + {:in-chan-factory io-chan/mcp-input-stream->input-chan |
| 283 | + :out-chan-factory io-chan/mcp-output-stream->output-chan}))) |
273 | 284 | producer (McpProducer. server db*)
|
274 | 285 | components {:db* db*
|
275 | 286 | :logger timbre-logger
|
276 | 287 | :producer producer
|
277 | 288 | :server server}]
|
278 | 289 | (swap! db* merge {:log-path log-path} (dissoc opts :in))
|
279 |
| - (logger/info "Starting server...") |
| 290 | + (when (:register opts) |
| 291 | + (try |
| 292 | + (db/add opts) |
| 293 | + (catch Throwable t |
| 294 | + (logger/error t)))) |
280 | 295 | (monitor-server-logs log-ch)
|
| 296 | + (logger/info "Starting server...") |
281 | 297 | [producer (lsp.server/start server components)])))
|
282 | 298 |
|
283 | 299 | (comment
|
|
0 commit comments