this repo has no description
add MCP capitalize server implementation
Implements a simple MCP server that exposes a 'capitalize' tool which converts text to uppercase.
Includes comprehensive debugging and fixes protocol compatibility issues for Claude Desktop.
🤖 Generated with [Claude Code](https://claude.ai/code)
Co-Authored-By: Claude <noreply@anthropic.com>
+368
+365
bin/server.ml
+365
bin/server.ml
···
1
+
open Mcp
2
+
open Jsonrpc
3
+
4
+
(* Logging utilities *)
5
+
let log_debug msg =
6
+
Printf.eprintf "[DEBUG] %s\n" msg;
7
+
flush stderr
8
+
9
+
let log_error msg =
10
+
Printf.eprintf "[ERROR] %s\n" msg;
11
+
flush stderr
12
+
13
+
(* Server state *)
14
+
let protocol_version = "2024-11-05"
15
+
let server_info = Implementation.{ name = "ocaml-mcp-capitalizer"; version = "0.1.0" }
16
+
let server_capabilities = `Assoc [
17
+
(* We support tools *)
18
+
("tools", `Assoc [
19
+
("listChanged", `Bool true)
20
+
]);
21
+
(* We don't support resources - make this explicit *)
22
+
("resources", `Assoc [
23
+
("listChanged", `Bool false);
24
+
("subscribe", `Bool false)
25
+
]);
26
+
(* We don't support prompts - make this explicit *)
27
+
("prompts", `Assoc [
28
+
("listChanged", `Bool false)
29
+
])
30
+
]
31
+
32
+
(* Tool implementation *)
33
+
module CapitalizeTool = struct
34
+
let name = "capitalize"
35
+
let description = "Capitalizes the provided text"
36
+
let input_schema = `Assoc [
37
+
("type", `String "object");
38
+
("properties", `Assoc [
39
+
("text", `Assoc [
40
+
("type", `String "string");
41
+
("description", `String "The text to capitalize")
42
+
])
43
+
]);
44
+
("required", `List [`String "text"])
45
+
]
46
+
47
+
let call json =
48
+
match json with
49
+
| `Assoc fields ->
50
+
(match List.assoc_opt "text" fields with
51
+
| Some (`String text) ->
52
+
let capitalized_text = String.uppercase_ascii text in
53
+
let content = TextContent.{
54
+
text = capitalized_text;
55
+
annotations = None
56
+
} in
57
+
`Assoc [
58
+
("content", `List [TextContent.yojson_of_t content]);
59
+
("isError", `Bool false)
60
+
]
61
+
| _ ->
62
+
let error_content = TextContent.{
63
+
text = "Missing or invalid 'text' parameter";
64
+
annotations = None
65
+
} in
66
+
`Assoc [
67
+
("content", `List [TextContent.yojson_of_t error_content]);
68
+
("isError", `Bool true)
69
+
])
70
+
| _ ->
71
+
let error_content = TextContent.{
72
+
text = "Invalid arguments format";
73
+
annotations = None
74
+
} in
75
+
`Assoc [
76
+
("content", `List [TextContent.yojson_of_t error_content]);
77
+
("isError", `Bool true)
78
+
]
79
+
end
80
+
81
+
(* Handle tool listing *)
82
+
let list_tools () =
83
+
let tool = `Assoc [
84
+
("name", `String CapitalizeTool.name);
85
+
("description", `String CapitalizeTool.description);
86
+
("inputSchema", CapitalizeTool.input_schema)
87
+
] in
88
+
`Assoc [
89
+
("tools", `List [tool])
90
+
]
91
+
92
+
(* Handle tool calls *)
93
+
let call_tool name args =
94
+
if name = CapitalizeTool.name then
95
+
CapitalizeTool.call args
96
+
else
97
+
let error_content = TextContent.{
98
+
text = Printf.sprintf "Unknown tool: %s" name;
99
+
annotations = None
100
+
} in
101
+
`Assoc [
102
+
("content", `List [TextContent.yojson_of_t error_content]);
103
+
("isError", `Bool true)
104
+
]
105
+
106
+
(* Handle initialization *)
107
+
let handle_initialize id json =
108
+
try
109
+
log_debug (Printf.sprintf "Processing initialize request with id: %s"
110
+
(match id with
111
+
| `Int i -> string_of_int i
112
+
| `String s -> s));
113
+
114
+
log_debug (Printf.sprintf "Initialize params: %s"
115
+
(match json with
116
+
| Some j -> Yojson.Safe.to_string j
117
+
| None -> "null"));
118
+
119
+
let _ = match json with
120
+
| Some params ->
121
+
log_debug "Parsing initialize request params...";
122
+
let req = Initialize.Request.t_of_yojson params in
123
+
log_debug (Printf.sprintf "Client info: %s v%s" req.client_info.name req.client_info.version);
124
+
log_debug (Printf.sprintf "Client protocol version: %s" req.protocol_version);
125
+
126
+
(* Check protocol version compatibility *)
127
+
if req.protocol_version <> protocol_version then
128
+
log_debug (Printf.sprintf "Protocol version mismatch: client=%s server=%s - will use server version"
129
+
req.protocol_version protocol_version);
130
+
131
+
req
132
+
| None ->
133
+
log_error "Missing params for initialize request";
134
+
raise (Json.Of_json ("Missing params for initialize request", `Null))
135
+
in
136
+
137
+
log_debug "Creating initialize response...";
138
+
let result = Initialize.Result.create
139
+
~capabilities:server_capabilities
140
+
~server_info
141
+
~protocol_version
142
+
~instructions:"This server provides a tool to capitalize text."
143
+
()
144
+
in
145
+
146
+
log_debug "Serializing initialize response...";
147
+
let response = create_response ~id ~result:(Initialize.Result.yojson_of_t result) in
148
+
log_debug "Initialize response created successfully";
149
+
response
150
+
with
151
+
| Json.Of_json (msg, _) ->
152
+
log_error (Printf.sprintf "JSON error in initialize: %s" msg);
153
+
create_error ~id ~code:(-32602) ~message:("Invalid params: " ^ msg) ()
154
+
| exc ->
155
+
log_error (Printf.sprintf "Exception in initialize: %s" (Printexc.to_string exc));
156
+
log_error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()));
157
+
create_error ~id ~code:(-32603) ~message:("Internal error: " ^ (Printexc.to_string exc)) ()
158
+
159
+
(* Handle tools/list *)
160
+
let handle_list_tools id =
161
+
log_debug "Processing tools/list request";
162
+
let result = list_tools () in
163
+
log_debug (Printf.sprintf "Tools list result: %s" (Yojson.Safe.to_string result));
164
+
create_response ~id ~result
165
+
166
+
(* Handle tools/call *)
167
+
let handle_call_tool id json =
168
+
try
169
+
log_debug (Printf.sprintf "Processing tool call request with id: %s"
170
+
(match id with
171
+
| `Int i -> string_of_int i
172
+
| `String s -> s));
173
+
174
+
log_debug (Printf.sprintf "Tool call params: %s"
175
+
(match json with
176
+
| Some j -> Yojson.Safe.to_string j
177
+
| None -> "null"));
178
+
179
+
match json with
180
+
| Some (`Assoc params) ->
181
+
let name = match List.assoc_opt "name" params with
182
+
| Some (`String name) ->
183
+
log_debug (Printf.sprintf "Tool name: %s" name);
184
+
name
185
+
| _ ->
186
+
log_error "Missing or invalid 'name' parameter in tool call";
187
+
raise (Json.Of_json ("Missing or invalid 'name' parameter", `Assoc params))
188
+
in
189
+
let args = match List.assoc_opt "arguments" params with
190
+
| Some (args) ->
191
+
log_debug (Printf.sprintf "Tool arguments: %s" (Yojson.Safe.to_string args));
192
+
args
193
+
| _ ->
194
+
log_debug "No arguments provided for tool call, using empty object";
195
+
`Assoc [] (* Empty arguments is valid *)
196
+
in
197
+
log_debug (Printf.sprintf "Calling tool: %s" name);
198
+
let result = call_tool name args in
199
+
log_debug (Printf.sprintf "Tool call result: %s" (Yojson.Safe.to_string result));
200
+
create_response ~id ~result
201
+
| _ ->
202
+
log_error "Invalid params format for tools/call";
203
+
create_error ~id ~code:(-32602) ~message:"Invalid params for tools/call" ()
204
+
with
205
+
| Json.Of_json (msg, _) ->
206
+
log_error (Printf.sprintf "JSON error in tool call: %s" msg);
207
+
create_error ~id ~code:(-32602) ~message:("Invalid params: " ^ msg) ()
208
+
| exc ->
209
+
log_error (Printf.sprintf "Exception in tool call: %s" (Printexc.to_string exc));
210
+
log_error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()));
211
+
create_error ~id ~code:(-32603) ~message:("Internal error: " ^ (Printexc.to_string exc)) ()
212
+
213
+
(* Handle ping *)
214
+
let handle_ping id =
215
+
create_response ~id ~result:(`Assoc [])
216
+
217
+
(* Process a single message *)
218
+
let process_message message =
219
+
try
220
+
log_debug "Parsing message as JSONRPC message...";
221
+
match JSONRPCMessage.t_of_yojson message with
222
+
| JSONRPCMessage.Request req ->
223
+
log_debug (Printf.sprintf "Received request with method: %s" req.method_);
224
+
(match req.method_ with
225
+
| "initialize" ->
226
+
log_debug "Processing initialize request";
227
+
Some (handle_initialize req.id req.params)
228
+
| "tools/list" ->
229
+
log_debug "Processing tools/list request";
230
+
Some (handle_list_tools req.id)
231
+
| "tools/call" ->
232
+
log_debug "Processing tools/call request";
233
+
Some (handle_call_tool req.id req.params)
234
+
| "ping" ->
235
+
log_debug "Processing ping request";
236
+
Some (handle_ping req.id)
237
+
| _ ->
238
+
log_error (Printf.sprintf "Unknown method received: %s" req.method_);
239
+
Some (create_error ~id:req.id ~code:(-32601) ~message:("Method not found: " ^ req.method_) ()))
240
+
| JSONRPCMessage.Notification notif ->
241
+
log_debug (Printf.sprintf "Received notification with method: %s" notif.method_);
242
+
(match notif.method_ with
243
+
| "notifications/initialized" ->
244
+
log_debug "Client initialization complete - Server is now ready to receive requests";
245
+
log_debug (Printf.sprintf "Notification params: %s"
246
+
(match notif.params with
247
+
| Some p -> Yojson.Safe.to_string p
248
+
| None -> "null"));
249
+
None
250
+
| _ ->
251
+
log_debug (Printf.sprintf "Ignoring notification: %s" notif.method_);
252
+
None)
253
+
| JSONRPCMessage.Response _ ->
254
+
log_error "Unexpected response message received";
255
+
None
256
+
| JSONRPCMessage.Error _ ->
257
+
log_error "Unexpected error message received";
258
+
None
259
+
with
260
+
| exc ->
261
+
log_error (Printf.sprintf "Exception during message processing: %s" (Printexc.to_string exc));
262
+
log_error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()));
263
+
log_error (Printf.sprintf "Message was: %s" (Yojson.Safe.to_string message));
264
+
None
265
+
266
+
(* Main loop *)
267
+
let rec read_message () =
268
+
try
269
+
log_debug "Attempting to read line from stdin...";
270
+
let line = read_line () in
271
+
if line = "" then (
272
+
log_debug "Empty line received, ignoring";
273
+
None
274
+
) else (
275
+
log_debug (Printf.sprintf "Raw input: %s" line);
276
+
try
277
+
let json = Yojson.Safe.from_string line in
278
+
log_debug "Successfully parsed JSON";
279
+
Some json
280
+
with
281
+
| Yojson.Json_error msg ->
282
+
log_error (Printf.sprintf "Error parsing JSON: %s" msg);
283
+
log_error (Printf.sprintf "Input was: %s" line);
284
+
read_message ()
285
+
)
286
+
with
287
+
| End_of_file ->
288
+
log_debug "End of file received on stdin";
289
+
None
290
+
| Sys_error msg ->
291
+
log_error (Printf.sprintf "System error while reading: %s" msg);
292
+
None
293
+
| exc ->
294
+
log_error (Printf.sprintf "Exception while reading: %s" (Printexc.to_string exc));
295
+
None
296
+
297
+
let () =
298
+
try
299
+
(* Enable exception backtraces *)
300
+
Printexc.record_backtrace true;
301
+
302
+
(* Enable line buffering for stdout *)
303
+
set_binary_mode_out stdout false;
304
+
305
+
log_debug "MCP Capitalizer server started";
306
+
log_debug (Printf.sprintf "Protocol version: %s" protocol_version);
307
+
log_debug (Printf.sprintf "Server info: %s v%s" server_info.name server_info.version);
308
+
309
+
(* Print environment info for debugging *)
310
+
log_debug "Environment variables:";
311
+
Unix.environment()
312
+
|> Array.iter (fun s ->
313
+
try
314
+
let i = String.index s '=' in
315
+
let name = String.sub s 0 i in
316
+
if String.length name > 0 then
317
+
log_debug (Printf.sprintf " %s" s)
318
+
with Not_found -> ()
319
+
);
320
+
321
+
let rec server_loop count =
322
+
log_debug (Printf.sprintf "Waiting for message #%d..." count);
323
+
match read_message () with
324
+
| Some json ->
325
+
log_debug (Printf.sprintf "Received message: %s" (Yojson.Safe.to_string json));
326
+
(match process_message json with
327
+
| Some response ->
328
+
let response_json = JSONRPCMessage.yojson_of_t response in
329
+
let response_str = Yojson.Safe.to_string response_json in
330
+
log_debug (Printf.sprintf "Sending response: %s" response_str);
331
+
(* Make sure we emit properly formatted JSON on a single line with a newline at the end *)
332
+
Printf.printf "%s\n" response_str;
333
+
flush stdout;
334
+
(* Give the client a moment to process the response *)
335
+
Unix.sleepf 0.01;
336
+
server_loop (count + 1)
337
+
| None ->
338
+
log_debug "No response needed for this message";
339
+
server_loop (count + 1))
340
+
| None ->
341
+
log_debug "End of input stream, terminating server";
342
+
()
343
+
in
344
+
345
+
log_debug "Starting server loop...";
346
+
log_debug "Waiting for the initialize request...";
347
+
348
+
(* Set up signal handler to gracefully exit *)
349
+
Sys.(set_signal sigint (Signal_handle (fun _ ->
350
+
log_debug "Received interrupt signal, exiting...";
351
+
exit 0
352
+
)));
353
+
354
+
server_loop 1;
355
+
log_debug "Server terminated normally";
356
+
with
357
+
| End_of_file ->
358
+
log_error "Unexpected end of file";
359
+
| Sys_error msg ->
360
+
log_error (Printf.sprintf "System error: %s" msg);
361
+
| Unix.Unix_error(err, func, arg) ->
362
+
log_error (Printf.sprintf "Unix error in %s(%s): %s" func arg (Unix.error_message err));
363
+
| exc ->
364
+
log_error (Printf.sprintf "Unhandled exception: %s" (Printexc.to_string exc));
365
+
log_error (Printf.sprintf "Backtrace: %s" (Printexc.get_backtrace()))