Model Context Protocol in OCaml
anil.recoil.org
1open Mcp
2open Mcp_sdk
3open Mcp_message
4
5(* Create a server *)
6let server = create_server
7 ~name:"OCaml MCP Structured API Demo"
8 ~version:"0.1.0" () |>
9 fun server ->
10 (* Set default capabilities *)
11 configure_server server ~with_tools:true ~with_resources:true ~with_prompts:true ()
12
13(* Helper for extracting string value from JSON *)
14let get_string_param json name =
15 match json with
16 | `Assoc fields ->
17 (match List.assoc_opt name fields with
18 | Some (`String value) -> value
19 | _ -> raise (Failure (Printf.sprintf "Missing or invalid parameter: %s" name)))
20 | _ -> raise (Failure "Expected JSON object")
21
22(* Register a ping tool that demonstrates the typed API *)
23let _ = add_tool server
24 ~name:"ping"
25 ~description:"A simple ping tool that demonstrates the structured API"
26 ~schema_properties:[
27 ("message", "string", "The message to echo back")
28 ]
29 ~schema_required:["message"]
30 (fun args ->
31 try
32 let message = get_string_param args "message" in
33 (* Create a typed tool response using the new API *)
34 let content = [
35 ToolsCall.ToolContent.Text (TextContent.{
36 text = Printf.sprintf "Pong: %s" message;
37 annotations = None
38 })
39 ] in
40 (* Convert to JSON for the response *)
41 ToolsCall.Response.yojson_of_t {
42 content;
43 is_error = false
44 }
45 with
46 | Failure msg ->
47 Log.error (Printf.sprintf "Error in ping tool: %s" msg);
48 ToolsCall.Response.yojson_of_t {
49 content = [
50 ToolsCall.ToolContent.Text (TextContent.{
51 text = Printf.sprintf "Error: %s" msg;
52 annotations = None
53 })
54 ];
55 is_error = true
56 }
57 )
58
59(* Register a timestamp resource that uses the typed API *)
60let _ = add_resource server
61 ~uri_template:"timestamp://{format}"
62 ~description:"Get the current timestamp in the specified format"
63 ~mime_type:"text/plain"
64 (fun params ->
65 let format =
66 match params with
67 | [format] -> format
68 | _ -> "iso" (* default format *)
69 in
70 let timestamp =
71 match format with
72 | "unix" -> string_of_float (Unix.time ())
73 | "iso" | _ ->
74 let tm = Unix.gmtime (Unix.time ()) in
75 Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
76 (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
77 tm.tm_hour tm.tm_min tm.tm_sec
78 in
79 timestamp
80 )
81
82(* Register a structured prompt that uses the typed API *)
83let _ = add_prompt server
84 ~name:"greet"
85 ~description:"A prompt to greet someone using the structured API"
86 ~arguments:[
87 ("name", Some "The name of the person to greet", true);
88 ("formal", Some "Whether to use formal greetings", false)
89 ]
90 (fun args ->
91 let name = try List.assoc "name" args with Not_found -> "friend" in
92 let formal = try List.assoc "formal" args = "true" with Not_found -> false in
93
94 let greeting =
95 if formal then
96 Printf.sprintf "Greetings, %s. It's a pleasure to make your acquaintance." name
97 else
98 Printf.sprintf "Hey %s! Nice to meet you!" name
99 in
100
101 [
102 PromptMessage.{
103 role = `User;
104 content = make_text_content "I'd like to meet someone new."
105 };
106 PromptMessage.{
107 role = `Assistant;
108 content = make_text_content greeting
109 };
110 PromptMessage.{
111 role = `User;
112 content = make_text_content "What should I say next?"
113 }
114 ]
115 )
116
117(* Process a resources/list request using the typed API *)
118let handle_resources_list_request request_id =
119 let resources = [
120 ResourcesList.Resource.{
121 uri = "timestamp://iso";
122 name = "ISO Timestamp";
123 description = Some "Current time in ISO format";
124 mime_type = Some "text/plain";
125 size = None;
126 };
127 ResourcesList.Resource.{
128 uri = "timestamp://unix";
129 name = "Unix Timestamp";
130 description = Some "Current time as Unix epoch";
131 mime_type = Some "text/plain";
132 size = None;
133 }
134 ] in
135
136 (* Create a typed response *)
137 ResourcesList.create_response ~id:request_id ~resources ()
138
139(* Process a tools/list request using the typed API *)
140let handle_tools_list_request request_id =
141 let tools = [
142 ToolsList.Tool.{
143 name = "ping";
144 description = Some "A simple ping tool that demonstrates the structured API";
145 input_schema = `Assoc [
146 ("type", `String "object");
147 ("properties", `Assoc [
148 ("message", `Assoc [
149 ("type", `String "string");
150 ("description", `String "The message to echo back")
151 ])
152 ]);
153 ("required", `List [`String "message"])
154 ];
155 annotations = None;
156 }
157 ] in
158
159 (* Create a typed response *)
160 ToolsList.create_response ~id:request_id ~tools ()
161
162(* Process a prompts/list request using the typed API *)
163let handle_prompts_list_request request_id =
164 let prompts = [
165 PromptsList.Prompt.{
166 name = "greet";
167 description = Some "A prompt to greet someone using the structured API";
168 arguments = [
169 PromptsList.PromptArgument.{
170 name = "name";
171 description = Some "The name of the person to greet";
172 required = true;
173 };
174 PromptsList.PromptArgument.{
175 name = "formal";
176 description = Some "Whether to use formal greetings";
177 required = false;
178 }
179 ];
180 }
181 ] in
182
183 (* Create a typed response *)
184 PromptsList.create_response ~id:request_id ~prompts ()
185
186(* Run the server *)
187let () =
188 (* Example of creating a structured message directly - not actually used in the server *)
189 let example_structured_request =
190 ToolsCall.create_request
191 ~name:"ping"
192 ~arguments:(`Assoc [("message", `String "hello")])
193 ~id:(`Int 12345)
194 ()
195 in
196
197 (* Log the example request for demonstration *)
198 let json_str = Yojson.Safe.to_string (JSONRPCMessage.yojson_of_t example_structured_request) in
199 Log.info (Printf.sprintf "Example structured request: %s" json_str);
200
201 (* Run the server with the default scheduler *)
202 Eio_main.run @@ fun env->
203 Mcp_server.run_server env server