|
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