this repo has no description
Extend Mcp_sdk with Tool, Resource and Prompt conversion functions
- Add translator functions to convert between SDK and RPC types
- Use these functions in the Mcp_server for all RPC handlers
- Implement proper content type conversion for tool responses
🤖 Generated with [Claude Code](https://claude.ai/code)
Co-Authored-By: Claude <noreply@anthropic.com>
+196
-11
+121
lib/mcp_sdk.ml
+121
lib/mcp_sdk.ml
···
82
82
in
83
83
`Assoc assoc
84
84
85
+
(* Convert to Mcp_rpc.ToolsList.Tool.t *)
86
+
let to_rpc_tool_list_tool (tool:t) =
87
+
Mcp_rpc.ToolsList.Tool.{
88
+
name = tool.name;
89
+
description = tool.description;
90
+
input_schema = tool.input_schema;
91
+
annotations = None; (* Could be extended to support annotations *)
92
+
}
93
+
94
+
(* Convert a list of Tool.t to the format needed for tools/list response *)
95
+
let to_rpc_tools_list tools =
96
+
List.map to_rpc_tool_list_tool tools
97
+
98
+
(* Convert Mcp_rpc.ToolsCall response content to Mcp.content list *)
99
+
let rpc_content_to_mcp_content content =
100
+
List.map (function
101
+
| Mcp_rpc.ToolsCall.ToolContent.Text t ->
102
+
Mcp.Text { TextContent.text = t.text; annotations = None }
103
+
| Mcp_rpc.ToolsCall.ToolContent.Image i ->
104
+
Mcp.Image {
105
+
ImageContent.mime_type = i.mime_type;
106
+
data = i.data;
107
+
annotations = None
108
+
}
109
+
| Mcp_rpc.ToolsCall.ToolContent.Audio a ->
110
+
Mcp.Audio {
111
+
AudioContent.mime_type = a.mime_type;
112
+
data = a.data;
113
+
annotations = None
114
+
}
115
+
| Mcp_rpc.ToolsCall.ToolContent.Resource r ->
116
+
(* Create a simple text resource from the embedded resource *)
117
+
let uri = match r with
118
+
| { EmbeddedResource.resource = `Text tr; _ } -> tr.uri
119
+
| { EmbeddedResource.resource = `Blob br; _ } -> br.uri
120
+
in
121
+
let text_content = match r with
122
+
| { EmbeddedResource.resource = `Text tr; _ } -> tr.text
123
+
| { EmbeddedResource.resource = `Blob br; _ } -> "Binary content"
124
+
in
125
+
let mime_type = match r with
126
+
| { EmbeddedResource.resource = `Text tr; _ } -> tr.mime_type
127
+
| { EmbeddedResource.resource = `Blob br; _ } -> br.mime_type
128
+
in
129
+
let text_resource = {
130
+
TextResourceContents.uri;
131
+
text = text_content;
132
+
mime_type
133
+
} in
134
+
Mcp.Resource {
135
+
EmbeddedResource.resource = `Text text_resource;
136
+
annotations = None
137
+
}
138
+
) content
139
+
140
+
(* Convert Mcp.content list to Mcp_rpc.ToolsCall.ToolContent.t list *)
141
+
let mcp_content_to_rpc_content content =
142
+
List.map (function
143
+
| Mcp.Text t ->
144
+
Mcp_rpc.ToolsCall.ToolContent.Text t
145
+
| Mcp.Image img ->
146
+
Mcp_rpc.ToolsCall.ToolContent.Image img
147
+
| Mcp.Audio aud ->
148
+
Mcp_rpc.ToolsCall.ToolContent.Audio aud
149
+
| Mcp.Resource res ->
150
+
let resource_data = match res.resource with
151
+
| `Text txt -> `Text txt
152
+
| `Blob blob -> `Blob blob
153
+
in
154
+
let resource = {
155
+
EmbeddedResource.resource = resource_data;
156
+
annotations = res.annotations
157
+
} in
158
+
Mcp_rpc.ToolsCall.ToolContent.Resource resource
159
+
) content
160
+
85
161
(* Create a tool result with content *)
86
162
let create_tool_result content ~is_error =
87
163
`Assoc [
···
134
210
| None -> assoc
135
211
in
136
212
`Assoc assoc
213
+
214
+
(* Convert to Mcp_rpc.ResourcesList.Resource.t *)
215
+
let to_rpc_resource_list_resource (resource:t) =
216
+
Mcp_rpc.ResourcesList.Resource.{
217
+
uri = resource.uri_template;
218
+
name = resource.uri_template; (* Use uri as name by default *)
219
+
description = resource.description;
220
+
mime_type = resource.mime_type;
221
+
size = None; (* Size can be added when we have actual resource content *)
222
+
}
223
+
224
+
(* Convert a list of Resource.t to the format needed for resources/list response *)
225
+
let to_rpc_resources_list resources =
226
+
List.map to_rpc_resource_list_resource resources
137
227
end
138
228
139
229
(* Prompts for the MCP server *)
···
194
284
assoc
195
285
in
196
286
`Assoc assoc
287
+
288
+
(* Convert argument to Mcp_rpc.PromptsList.PromptArgument.t *)
289
+
let argument_to_rpc_prompt_argument (arg:argument) =
290
+
Mcp_rpc.PromptsList.PromptArgument.{
291
+
name = arg.name;
292
+
description = arg.description;
293
+
required = arg.required;
294
+
}
295
+
296
+
(* Convert to Mcp_rpc.PromptsList.Prompt.t *)
297
+
let to_rpc_prompt_list_prompt (prompt:t) =
298
+
Mcp_rpc.PromptsList.Prompt.{
299
+
name = prompt.name;
300
+
description = prompt.description;
301
+
arguments = List.map argument_to_rpc_prompt_argument prompt.arguments;
302
+
}
303
+
304
+
(* Convert a list of Prompt.t to the format needed for prompts/list response *)
305
+
let to_rpc_prompts_list prompts =
306
+
List.map to_rpc_prompt_list_prompt prompts
307
+
308
+
(* Convert message to Mcp_rpc.PromptMessage.t *)
309
+
let message_to_rpc_prompt_message msg =
310
+
{
311
+
PromptMessage.role = msg.role;
312
+
PromptMessage.content = msg.content;
313
+
}
314
+
315
+
(* Convert a list of messages to the format needed for prompts/get response *)
316
+
let messages_to_rpc_prompt_messages messages =
317
+
List.map message_to_rpc_prompt_message messages
197
318
end
198
319
199
320
let make_tool_schema properties required =
+33
lib/mcp_sdk.mli
+33
lib/mcp_sdk.mli
···
50
50
val create : name:string -> ?description:string -> input_schema:Json.t -> handler:handler -> unit -> t
51
51
val to_json : t -> Json.t
52
52
53
+
(** Convert to Mcp_rpc.ToolsList.Tool.t *)
54
+
val to_rpc_tool_list_tool : t -> Mcp_rpc.ToolsList.Tool.t
55
+
56
+
(** Convert a list of Tool.t to the format needed for tools/list response *)
57
+
val to_rpc_tools_list : t list -> Mcp_rpc.ToolsList.Tool.t list
58
+
59
+
(** Convert Mcp_rpc.ToolsCall response content to Mcp.content list *)
60
+
val rpc_content_to_mcp_content : Mcp_rpc.ToolsCall.ToolContent.t list -> Mcp.content list
61
+
62
+
(** Convert Mcp.content list to Mcp_rpc.ToolsCall.ToolContent.t list *)
63
+
val mcp_content_to_rpc_content : Mcp.content list -> Mcp_rpc.ToolsCall.ToolContent.t list
64
+
53
65
(** Create a tool result with content *)
54
66
val create_tool_result : Mcp.content list -> is_error:bool -> Json.t
55
67
···
79
91
80
92
val create : uri_template:string -> ?description:string -> ?mime_type:string -> handler:handler -> unit -> t
81
93
val to_json : t -> Json.t
94
+
95
+
(** Convert to Mcp_rpc.ResourcesList.Resource.t *)
96
+
val to_rpc_resource_list_resource : t -> Mcp_rpc.ResourcesList.Resource.t
97
+
98
+
(** Convert a list of Resource.t to the format needed for resources/list response *)
99
+
val to_rpc_resources_list : t list -> Mcp_rpc.ResourcesList.Resource.t list
82
100
end
83
101
84
102
(** Prompts for the MCP server *)
···
106
124
val create : name:string -> ?description:string -> ?arguments:argument list -> handler:handler -> unit -> t
107
125
val create_argument : name:string -> ?description:string -> ?required:bool -> unit -> argument
108
126
val to_json : t -> Json.t
127
+
128
+
(** Convert argument to Mcp_rpc.PromptsList.PromptArgument.t *)
129
+
val argument_to_rpc_prompt_argument : argument -> Mcp_rpc.PromptsList.PromptArgument.t
130
+
131
+
(** Convert to Mcp_rpc.PromptsList.Prompt.t *)
132
+
val to_rpc_prompt_list_prompt : t -> Mcp_rpc.PromptsList.Prompt.t
133
+
134
+
(** Convert a list of Prompt.t to the format needed for prompts/list response *)
135
+
val to_rpc_prompts_list : t list -> Mcp_rpc.PromptsList.Prompt.t list
136
+
137
+
(** Convert message to Mcp_rpc.PromptMessage.t *)
138
+
val message_to_rpc_prompt_message : message -> PromptMessage.t
139
+
140
+
(** Convert a list of messages to the format needed for prompts/get response *)
141
+
val messages_to_rpc_prompt_messages : message list -> PromptMessage.t list
109
142
end
110
143
111
144
(** Main server type *)
+42
-11
lib/mcp_server.ml
+42
-11
lib/mcp_server.ml
···
33
33
(* Process tools/list request *)
34
34
let handle_tools_list server (req:JSONRPCMessage.request) =
35
35
Log.debug "Processing tools/list request";
36
-
let tool_list = List.map Tool.to_json (tools server) in
37
-
let result = `Assoc [("tools", `List tool_list)] in
38
-
Some (create_response ~id:req.id ~result)
36
+
let tools_list = Tool.to_rpc_tools_list (tools server) in
37
+
let response = Mcp_rpc.ToolsList.create_response ~id:req.id ~tools:tools_list () in
38
+
Some response
39
39
40
40
(* Process prompts/list request *)
41
41
let handle_prompts_list server (req:JSONRPCMessage.request) =
42
42
Log.debug "Processing prompts/list request";
43
-
let prompt_list = List.map Prompt.to_json (prompts server) in
44
-
let result = `Assoc [("prompts", `List prompt_list)] in
45
-
Some (create_response ~id:req.id ~result)
43
+
let prompts_list = Prompt.to_rpc_prompts_list (prompts server) in
44
+
let response = Mcp_rpc.PromptsList.create_response ~id:req.id ~prompts:prompts_list () in
45
+
Some response
46
46
47
47
(* Process resources/list request *)
48
48
let handle_resources_list server (req:JSONRPCMessage.request) =
49
49
Log.debug "Processing resources/list request";
50
-
let resource_list = List.map Resource.to_json (resources server) in
51
-
let result = `Assoc [("resources", `List resource_list)] in
52
-
Some (create_response ~id:req.id ~result)
50
+
let resources_list = Resource.to_rpc_resources_list (resources server) in
51
+
let response = Mcp_rpc.ResourcesList.create_response ~id:req.id ~resources:resources_list () in
52
+
Some response
53
53
54
54
(* Extract the tool name from params *)
55
55
let extract_tool_name params =
···
97
97
| Not_found -> Tool.handle_unknown_tool_error name
98
98
| exn -> Tool.handle_execution_exception exn
99
99
100
+
(* Convert JSON tool result to RPC content format *)
101
+
let json_to_rpc_content json =
102
+
match json with
103
+
| `Assoc fields ->
104
+
(match List.assoc_opt "content" fields, List.assoc_opt "isError" fields with
105
+
| Some (`List content_items), Some (`Bool is_error) ->
106
+
let mcp_content = List.map Mcp.content_of_yojson content_items in
107
+
let rpc_content = Tool.mcp_content_to_rpc_content mcp_content in
108
+
(rpc_content, is_error)
109
+
| _ ->
110
+
(* Fallback for compatibility with older formats *)
111
+
let text = Yojson.Safe.to_string json in
112
+
let text_content = { TextContent.text = text; annotations = None } in
113
+
([Mcp_rpc.ToolsCall.ToolContent.Text text_content], false))
114
+
| _ ->
115
+
(* Simple fallback for non-object results *)
116
+
let text = Yojson.Safe.to_string json in
117
+
let text_content = { TextContent.text = text; annotations = None } in
118
+
([Mcp_rpc.ToolsCall.ToolContent.Text text_content], false)
119
+
100
120
(* Process tools/call request *)
101
121
let handle_tools_call server req =
102
122
Log.debug "Processing tools/call request";
···
115
135
in
116
136
117
137
(* Execute the tool *)
118
-
let result = execute_tool server ctx name args in
138
+
let result_json = execute_tool server ctx name args in
119
139
120
-
Some (create_response ~id:req.id ~result)
140
+
(* Convert JSON result to RPC format *)
141
+
let content, is_error = json_to_rpc_content result_json in
142
+
143
+
(* Create the RPC response *)
144
+
let response = Mcp_rpc.ToolsCall.create_response
145
+
~id:req.id
146
+
~content
147
+
~is_error
148
+
()
149
+
in
150
+
151
+
Some response
121
152
| None ->
122
153
Some (create_jsonrpc_error req.id InvalidParams "Missing tool name parameter" ()))
123
154
| _ ->