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