···
1
+
(** Example MCP server using the Server_session API.
3
+
This example demonstrates how to create a simple MCP server that provides:
4
+
- A few example tools (add, echo)
5
+
- A simple resource (example://greeting)
8
+
Note: This is a template/demonstration. A real MCP server would typically:
9
+
1. Read JSON-RPC messages from stdin
10
+
2. Write JSON-RPC responses to stdout
11
+
3. Use proper error handling and logging
13
+
To use this as a real server, you would need to:
14
+
- Create a custom Transport that reads/writes to stdio
15
+
- Handle process lifecycle properly
16
+
- Add comprehensive error handling
21
+
(* Helper to find field in Jsont.Object *)
22
+
let find_field name fields =
23
+
List.find_map (fun ((n, _), value) ->
24
+
if n = name then Some value else None
27
+
(* Example tool: Add two numbers *)
28
+
let handle_add_tool ~name:_ ~arguments =
29
+
let open Messages.Tools in
30
+
match arguments with
31
+
| Some (Jsont.Object (fields, _)) ->
32
+
let a = match find_field "a" fields with
33
+
| Some (Jsont.Number (n, _)) -> n
36
+
let b = match find_field "b" fields with
37
+
| Some (Jsont.Number (n, _)) -> n
40
+
let result = a +. b in
42
+
Content.text (Printf.sprintf "Result: %.2f" result)
44
+
make_call_result ~content ()
47
+
~content:[Content.text "Invalid arguments"]
51
+
(* Example tool: Echo a message *)
52
+
let handle_echo_tool ~name:_ ~arguments =
53
+
let open Messages.Tools in
54
+
match arguments with
55
+
| Some (Jsont.Object (fields, _)) ->
56
+
(match find_field "message" fields with
57
+
| Some (Jsont.String (msg, _)) ->
58
+
let content = [Content.text msg] in
59
+
make_call_result ~content ()
62
+
~content:[Content.text "No message provided"]
67
+
~content:[Content.text "Invalid arguments"]
71
+
(* Tool dispatcher *)
72
+
let call_tool ~name ~arguments =
74
+
| "add" -> handle_add_tool ~name ~arguments
75
+
| "echo" -> handle_echo_tool ~name ~arguments
77
+
Messages.Tools.make_call_result
78
+
~content:[Content.text (Printf.sprintf "Unknown tool: %s" name)]
82
+
(* List available tools *)
83
+
let list_tools ~cursor:_ =
84
+
let open Messages.Tools in
85
+
let meta = Jsont.Meta.none in
89
+
~description:"Add two numbers together"
90
+
~input_schema:(Jsont.Object ([
91
+
(("type", meta), Jsont.String ("object", meta));
92
+
(("properties", meta), Jsont.Object ([
93
+
(("a", meta), Jsont.Object ([(("type", meta), Jsont.String ("number", meta))], meta));
94
+
(("b", meta), Jsont.Object ([(("type", meta), Jsont.String ("number", meta))], meta));
96
+
(("required", meta), Jsont.Array ([Jsont.String ("a", meta); Jsont.String ("b", meta)], meta));
101
+
~description:"Echo a message back"
102
+
~input_schema:(Jsont.Object ([
103
+
(("type", meta), Jsont.String ("object", meta));
104
+
(("properties", meta), Jsont.Object ([
105
+
(("message", meta), Jsont.Object ([(("type", meta), Jsont.String ("string", meta))], meta));
107
+
(("required", meta), Jsont.Array ([Jsont.String ("message", meta)], meta));
111
+
make_list_result ~tools ()
113
+
(* Example resource *)
114
+
let read_resource ~uri =
115
+
let open Messages.Resources in
117
+
| "example://greeting" ->
121
+
~text:"Hello from the MCP server!"
122
+
~mime_type:"text/plain"
125
+
make_read_result ~contents
127
+
failwith (Printf.sprintf "Unknown resource: %s" uri)
129
+
let list_resources ~cursor:_ =
130
+
let open Messages.Resources in
133
+
~uri:"example://greeting"
135
+
~description:"A simple greeting message"
136
+
~mime_type:"text/plain"
139
+
make_list_result ~resources ()
144
+
(* Main server function *)
145
+
let run_server env =
148
+
Switch.run @@ fun sw ->
149
+
(* Create stdio transport for the server *)
150
+
(* Note: For a real server, you would typically use a transport that
151
+
reads from stdin and writes to stdout. Here we create a simple
152
+
in-process transport for demonstration. *)
154
+
Transport_stdio.command = "cat"; (* Echo back for demo *)
157
+
max_buffer_size = None;
159
+
let transport = Transport_stdio.create
161
+
~process_mgr:(Eio.Stdenv.process_mgr env)
165
+
(* Configure server *)
167
+
Server_session.server_info = Capabilities.Implementation.make
168
+
~name:"example-mcp-server"
170
+
server_capabilities = Capabilities.Server.make
171
+
~tools:(Capabilities.Tools.make ())
172
+
~resources:(Capabilities.Resources.make ())
175
+
instructions = Some "Example MCP server with basic tools and resources";
178
+
(* Set up handlers *)
180
+
Server_session.list_resources = Some list_resources;
181
+
list_resource_templates = None;
182
+
read_resource = Some read_resource;
183
+
subscribe_resource = None;
184
+
unsubscribe_resource = None;
185
+
list_tools = Some list_tools;
186
+
call_tool = Some call_tool;
187
+
list_prompts = None;
193
+
(* Create and run server *)
194
+
let server = Server_session.create
201
+
(* Log server startup *)
202
+
let client_info = Server_session.client_info server in
203
+
Eio.traceln "MCP server started, connected to client: %s v%s"
204
+
client_info.Capabilities.Implementation.name
205
+
client_info.Capabilities.Implementation.version;
207
+
(* The server runs in the background via the Session's receive loop *)
208
+
(* The switch will keep the server alive until it's explicitly closed or an error occurs *)
209
+
(* For this example, we just let it run until the process is terminated *)
211
+
(* Note: In a real server, you would wait for some termination signal or condition *)
214
+
Eio_main.run @@ fun env ->
219
+
Printf.eprintf "Server error: %s\n%!" (Printexc.to_string exn);
anil.recoil.org