this repo has no description
more
+614
-41
+161
-2
claudeio/lib/options.ml
+161
-2
claudeio/lib/options.ml
···
3
3
4
4
type setting_source = User | Project | Local
5
5
6
+
type mcp_stdio_config = {
7
+
command : string;
8
+
args : string list;
9
+
env : (string * string) list option;
10
+
}
11
+
12
+
type mcp_sse_config = {
13
+
url : string;
14
+
headers : (string * string) list option;
15
+
}
16
+
17
+
type mcp_http_config = {
18
+
url : string;
19
+
headers : (string * string) list option;
20
+
}
21
+
22
+
type mcp_server_config =
23
+
| Stdio of mcp_stdio_config
24
+
| SSE of mcp_sse_config
25
+
| HTTP of mcp_http_config
26
+
6
27
module Unknown = struct
7
28
type t = Jsont.json
8
29
let empty = Jsont.Object ([], Jsont.Meta.none)
···
36
57
max_buffer_size : int option;
37
58
user : string option;
38
59
output_format : Structured_output.t option;
60
+
mcp_servers : (string * mcp_server_config) list;
39
61
unknown : Unknown.t;
40
62
}
41
63
···
65
87
max_buffer_size = None;
66
88
user = None;
67
89
output_format = None;
90
+
mcp_servers = [];
68
91
unknown = Unknown.empty;
69
92
}
70
93
···
94
117
?max_buffer_size
95
118
?user
96
119
?output_format
120
+
?(mcp_servers = [])
97
121
?(unknown = Unknown.empty)
98
122
() =
99
123
{ allowed_tools; disallowed_tools; max_thinking_tokens;
···
103
127
permission_prompt_tool_name; settings; add_dirs;
104
128
extra_args; debug_stderr; hooks;
105
129
max_budget_usd; fallback_model; setting_sources;
106
-
max_buffer_size; user; output_format; unknown }
130
+
max_buffer_size; user; output_format; mcp_servers; unknown }
107
131
108
132
let allowed_tools t = t.allowed_tools
109
133
let disallowed_tools t = t.disallowed_tools
···
130
154
let max_buffer_size t = t.max_buffer_size
131
155
let user t = t.user
132
156
let output_format t = t.output_format
157
+
let mcp_servers t = t.mcp_servers
133
158
let unknown t = t.unknown
134
159
135
160
let with_allowed_tools tools t = { t with allowed_tools = tools }
···
161
186
let with_user user t = { t with user = Some user }
162
187
let with_output_format format t = { t with output_format = Some format }
163
188
189
+
let with_mcp_server ~name ~config t =
190
+
let servers = List.filter (fun (n, _) -> n <> name) t.mcp_servers in
191
+
{ t with mcp_servers = (name, config) :: servers }
192
+
193
+
let with_mcp_servers servers t = { t with mcp_servers = servers }
194
+
195
+
let with_mcp_stdio ~name ~command ?(args = []) ?env () t =
196
+
let config = Stdio { command; args; env } in
197
+
with_mcp_server ~name ~config t
198
+
164
199
(* Helper codec for Model.t *)
165
200
let model_jsont : Model.t Jsont.t =
166
201
Jsont.map ~kind:"Model"
···
187
222
Jsont.Json.object' mems)
188
223
Jsont.json
189
224
225
+
(* Helper codec for headers - list of string pairs encoded as object *)
226
+
let headers_jsont : (string * string) list Jsont.t =
227
+
Jsont.map ~kind:"Headers"
228
+
~dec:(fun obj ->
229
+
match obj with
230
+
| Jsont.Object (members, _) ->
231
+
List.map (fun ((name, _), value) ->
232
+
match value with
233
+
| Jsont.String (s, _) -> (name, s)
234
+
| _ -> (name, "")
235
+
) members
236
+
| _ -> [])
237
+
~enc:(fun pairs ->
238
+
let mems = List.map (fun (k, v) ->
239
+
Jsont.Json.mem (Jsont.Json.name k) (Jsont.Json.string v)
240
+
) pairs in
241
+
Jsont.Json.object' mems)
242
+
Jsont.json
243
+
244
+
(* MCP server config codecs *)
245
+
let mcp_stdio_config_jsont : mcp_stdio_config Jsont.t =
246
+
let make command args env : mcp_stdio_config = { command; args; env } in
247
+
Jsont.Object.map ~kind:"McpStdioConfig" make
248
+
|> Jsont.Object.mem "command" Jsont.string ~enc:(fun (c : mcp_stdio_config) -> c.command) ~dec_absent:""
249
+
|> Jsont.Object.mem "args" (Jsont.list Jsont.string) ~enc:(fun (c : mcp_stdio_config) -> c.args) ~dec_absent:[]
250
+
|> Jsont.Object.opt_mem "env" env_jsont ~enc:(fun (c : mcp_stdio_config) -> c.env)
251
+
|> Jsont.Object.finish
252
+
253
+
let mcp_sse_config_jsont : mcp_sse_config Jsont.t =
254
+
let make url headers : mcp_sse_config = { url; headers } in
255
+
Jsont.Object.map ~kind:"McpSseConfig" make
256
+
|> Jsont.Object.mem "url" Jsont.string ~enc:(fun (c : mcp_sse_config) -> c.url) ~dec_absent:""
257
+
|> Jsont.Object.opt_mem "headers" headers_jsont ~enc:(fun (c : mcp_sse_config) -> c.headers)
258
+
|> Jsont.Object.finish
259
+
260
+
let mcp_http_config_jsont : mcp_http_config Jsont.t =
261
+
let make url headers : mcp_http_config = { url; headers } in
262
+
Jsont.Object.map ~kind:"McpHttpConfig" make
263
+
|> Jsont.Object.mem "url" Jsont.string ~enc:(fun (c : mcp_http_config) -> c.url) ~dec_absent:""
264
+
|> Jsont.Object.opt_mem "headers" headers_jsont ~enc:(fun (c : mcp_http_config) -> c.headers)
265
+
|> Jsont.Object.finish
266
+
267
+
let mcp_server_config_jsont : mcp_server_config Jsont.t =
268
+
Jsont.map ~kind:"McpServerConfig"
269
+
~dec:(fun obj ->
270
+
match obj with
271
+
| Jsont.Object (members, _) ->
272
+
(* Look for type field to determine variant *)
273
+
let type_field = List.find_map (fun ((name, _), value) ->
274
+
if name = "type" then
275
+
match value with
276
+
| Jsont.String (s, _) -> Some s
277
+
| _ -> None
278
+
else None
279
+
) members in
280
+
(match type_field with
281
+
| Some "stdio" ->
282
+
let config = Jsont.Json.decode mcp_stdio_config_jsont obj in
283
+
(match config with
284
+
| Ok cfg -> Stdio cfg
285
+
| Error _ -> Stdio { command = ""; args = []; env = None })
286
+
| Some "sse" ->
287
+
let config = Jsont.Json.decode mcp_sse_config_jsont obj in
288
+
(match config with
289
+
| Ok cfg -> SSE cfg
290
+
| Error _ -> SSE { url = ""; headers = None })
291
+
| Some "http" ->
292
+
let config = Jsont.Json.decode mcp_http_config_jsont obj in
293
+
(match config with
294
+
| Ok cfg -> HTTP cfg
295
+
| Error _ -> HTTP { url = ""; headers = None })
296
+
| _ -> Stdio { command = ""; args = []; env = None })
297
+
| _ -> Stdio { command = ""; args = []; env = None })
298
+
~enc:(fun config ->
299
+
match config with
300
+
| Stdio cfg ->
301
+
let obj = Jsont.Json.encode mcp_stdio_config_jsont cfg in
302
+
(match obj with
303
+
| Ok (Jsont.Object (members, meta)) ->
304
+
let type_mem = Jsont.Json.mem (Jsont.Json.name "type") (Jsont.Json.string "stdio") in
305
+
Jsont.Object (type_mem :: members, meta)
306
+
| Ok json -> json
307
+
| Error _ -> Jsont.Object ([], Jsont.Meta.none))
308
+
| SSE cfg ->
309
+
let obj = Jsont.Json.encode mcp_sse_config_jsont cfg in
310
+
(match obj with
311
+
| Ok (Jsont.Object (members, meta)) ->
312
+
let type_mem = Jsont.Json.mem (Jsont.Json.name "type") (Jsont.Json.string "sse") in
313
+
Jsont.Object (type_mem :: members, meta)
314
+
| Ok json -> json
315
+
| Error _ -> Jsont.Object ([], Jsont.Meta.none))
316
+
| HTTP cfg ->
317
+
let obj = Jsont.Json.encode mcp_http_config_jsont cfg in
318
+
(match obj with
319
+
| Ok (Jsont.Object (members, meta)) ->
320
+
let type_mem = Jsont.Json.mem (Jsont.Json.name "type") (Jsont.Json.string "http") in
321
+
Jsont.Object (type_mem :: members, meta)
322
+
| Ok json -> json
323
+
| Error _ -> Jsont.Object ([], Jsont.Meta.none)))
324
+
Jsont.json
325
+
326
+
(* Codec for MCP servers map - encoded as object with server names as keys *)
327
+
let mcp_servers_jsont : (string * mcp_server_config) list Jsont.t =
328
+
Jsont.map ~kind:"McpServers"
329
+
~dec:(fun obj ->
330
+
match obj with
331
+
| Jsont.Object (members, _) ->
332
+
List.filter_map (fun ((name, _), value) ->
333
+
match Jsont.Json.decode mcp_server_config_jsont value with
334
+
| Ok cfg -> Some (name, cfg)
335
+
| Error _ -> None
336
+
) members
337
+
| _ -> [])
338
+
~enc:(fun servers ->
339
+
let mems = List.map (fun (name, cfg) ->
340
+
match Jsont.Json.encode mcp_server_config_jsont cfg with
341
+
| Ok json -> Jsont.Json.mem (Jsont.Json.name name) json
342
+
| Error _ -> Jsont.Json.mem (Jsont.Json.name name) (Jsont.Object ([], Jsont.Meta.none))
343
+
) servers in
344
+
Jsont.Json.object' mems)
345
+
Jsont.json
346
+
190
347
let jsont : t Jsont.t =
191
348
let make allowed_tools disallowed_tools max_thinking_tokens
192
349
system_prompt append_system_prompt permission_mode
193
-
model env unknown =
350
+
model env mcp_servers unknown =
194
351
{ allowed_tools; disallowed_tools; max_thinking_tokens;
195
352
system_prompt; append_system_prompt; permission_mode;
196
353
permission_callback = Some Permissions.default_allow_callback;
···
210
367
max_buffer_size = None;
211
368
user = None;
212
369
output_format = None;
370
+
mcp_servers;
213
371
unknown }
214
372
in
215
373
Jsont.Object.map ~kind:"Options" make
···
221
379
|> Jsont.Object.opt_mem "permission_mode" Permissions.Mode.jsont ~enc:permission_mode
222
380
|> Jsont.Object.opt_mem "model" model_jsont ~enc:model
223
381
|> Jsont.Object.mem "env" env_jsont ~enc:env ~dec_absent:[]
382
+
|> Jsont.Object.mem "mcp_servers" mcp_servers_jsont ~enc:mcp_servers ~dec_absent:[]
224
383
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown
225
384
|> Jsont.Object.finish
226
385
+76
-2
claudeio/lib/options.mli
+76
-2
claudeio/lib/options.mli
···
110
110
- [Project]: Load project-level settings from .claude/ in project root
111
111
- [Local]: Load local settings from current directory *)
112
112
113
+
(** {2 MCP Server Configuration}
114
+
115
+
MCP (Model Context Protocol) servers provide tools and resources.
116
+
117
+
Example:
118
+
{[
119
+
let options = Options.default
120
+
|> Options.with_mcp_stdio
121
+
~name:"filesystem"
122
+
~command:"mcp-server-filesystem"
123
+
~args:["/workspace"]
124
+
()
125
+
|> Options.with_allowed_tools [
126
+
"mcp__filesystem__read_file";
127
+
"mcp__filesystem__write_file";
128
+
]
129
+
]}
130
+
131
+
Tool Naming: MCP tools are named [mcp__<server>__<tool>] *)
132
+
133
+
type mcp_stdio_config = {
134
+
command : string;
135
+
args : string list;
136
+
env : (string * string) list option;
137
+
}
138
+
(** Stdio-based MCP server (external process) *)
139
+
140
+
type mcp_sse_config = {
141
+
url : string;
142
+
headers : (string * string) list option;
143
+
}
144
+
(** Server-Sent Events MCP server *)
145
+
146
+
type mcp_http_config = {
147
+
url : string;
148
+
headers : (string * string) list option;
149
+
}
150
+
(** HTTP-based MCP server *)
151
+
152
+
type mcp_server_config =
153
+
| Stdio of mcp_stdio_config
154
+
| SSE of mcp_sse_config
155
+
| HTTP of mcp_http_config
156
+
(** MCP server configuration variants *)
157
+
113
158
type t
114
159
(** The type of configuration options. *)
115
160
···
146
191
?max_buffer_size:int ->
147
192
?user:string ->
148
193
?output_format:Structured_output.t ->
194
+
?mcp_servers:(string * mcp_server_config) list ->
149
195
?unknown:Jsont.json ->
150
196
unit -> t
151
197
(** [create ?allowed_tools ?disallowed_tools ?max_thinking_tokens ?system_prompt
152
198
?append_system_prompt ?permission_mode ?permission_callback ?model ?cwd ?env
153
199
?continue_conversation ?resume ?max_turns ?permission_prompt_tool_name ?settings
154
200
?add_dirs ?extra_args ?debug_stderr ?hooks ?max_budget_usd ?fallback_model
155
-
?setting_sources ?max_buffer_size ?user ()]
201
+
?setting_sources ?max_buffer_size ?user ?mcp_servers ()]
156
202
creates a new configuration.
157
203
@param allowed_tools List of explicitly allowed tool names
158
204
@param disallowed_tools List of explicitly disallowed tool names
···
178
224
@param setting_sources Control which settings load (user/project/local)
179
225
@param max_buffer_size Control for stdout buffer size in bytes
180
226
@param user Unix user for subprocess execution
181
-
@param output_format Optional structured output format specification *)
227
+
@param output_format Optional structured output format specification
228
+
@param mcp_servers MCP server configurations (name -> config mapping) *)
182
229
183
230
(** {1 Accessors} *)
184
231
···
256
303
257
304
val output_format : t -> Structured_output.t option
258
305
(** [output_format t] returns the optional structured output format. *)
306
+
307
+
val mcp_servers : t -> (string * mcp_server_config) list
308
+
(** [mcp_servers t] returns the MCP server configurations.
309
+
Tools from MCP servers are named: mcp__<server_name>__<tool_name> *)
259
310
260
311
val unknown : t -> Jsont.json
261
312
(** [unknown t] returns any unknown JSON fields that were preserved during decoding. *)
···
350
401
351
402
val with_output_format : Structured_output.t -> t -> t
352
403
(** [with_output_format format t] sets the structured output format. *)
404
+
405
+
val with_mcp_server :
406
+
name:string ->
407
+
config:mcp_server_config ->
408
+
t -> t
409
+
(** [with_mcp_server ~name ~config t] adds an MCP server configuration.
410
+
If a server with the same name exists, it will be replaced. *)
411
+
412
+
val with_mcp_servers :
413
+
(string * mcp_server_config) list ->
414
+
t -> t
415
+
(** [with_mcp_servers servers t] sets MCP servers (replaces existing).
416
+
Each element is a pair of (server_name, server_config). *)
417
+
418
+
val with_mcp_stdio :
419
+
name:string ->
420
+
command:string ->
421
+
?args:string list ->
422
+
?env:(string * string) list ->
423
+
unit ->
424
+
t -> t
425
+
(** [with_mcp_stdio ~name ~command ?args ?env () t] is a convenience
426
+
function to add a stdio-based MCP server. *)
353
427
354
428
(** {1 Serialization} *)
355
429
+56
-27
claudeio/lib/sdk_control.ml
+56
-27
claudeio/lib/sdk_control.ml
···
1
1
let src = Logs.Src.create "claude.sdk_control" ~doc:"Claude SDK control protocol"
2
2
module Log = (val Logs.src_log src : Logs.LOG)
3
3
4
+
(** MCP Message Routing *)
5
+
module Mcp_message = struct
6
+
module Unknown = struct
7
+
type t = Jsont.json
8
+
let empty = Jsont.Object ([], Jsont.Meta.none)
9
+
let is_empty = function Jsont.Object ([], _) -> true | _ -> false
10
+
let jsont = Jsont.json
11
+
end
12
+
13
+
type request = {
14
+
server_name : string;
15
+
message : Jsont.json;
16
+
unknown : Unknown.t;
17
+
}
18
+
19
+
type response = {
20
+
mcp_response : Jsont.json;
21
+
unknown : Unknown.t;
22
+
}
23
+
24
+
let make_request ~server_name ~message ?(unknown = Unknown.empty) () =
25
+
{ server_name; message; unknown }
26
+
27
+
let make_response ~mcp_response ?(unknown = Unknown.empty) () =
28
+
{ mcp_response; unknown }
29
+
30
+
let request_jsont : request Jsont.t =
31
+
let make server_name message (unknown : Unknown.t) : request =
32
+
{ server_name; message; unknown }
33
+
in
34
+
Jsont.Object.map ~kind:"McpMessageRequest" make
35
+
|> Jsont.Object.mem "server_name" Jsont.string ~enc:(fun (r : request) -> r.server_name)
36
+
|> Jsont.Object.mem "message" Jsont.json ~enc:(fun (r : request) -> r.message)
37
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : request) -> r.unknown)
38
+
|> Jsont.Object.finish
39
+
40
+
let response_jsont : response Jsont.t =
41
+
let make mcp_response (unknown : Unknown.t) : response =
42
+
{ mcp_response; unknown }
43
+
in
44
+
Jsont.Object.map ~kind:"McpMessageResponse" make
45
+
|> Jsont.Object.mem "mcp_response" Jsont.json ~enc:(fun (r : response) -> r.mcp_response)
46
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : response) -> r.unknown)
47
+
|> Jsont.Object.finish
48
+
49
+
let pp_request fmt req =
50
+
Fmt.pf fmt "@[<2>McpMessage.Request@ { server = %S }@]" req.server_name
51
+
52
+
let pp_response fmt _resp =
53
+
Fmt.pf fmt "@[<2>McpMessage.Response@ { mcp_response = <json> }@]"
54
+
end
55
+
4
56
module Request = struct
5
57
module Unknown = struct
6
58
type t = Jsont.json
···
43
95
unknown : Unknown.t;
44
96
}
45
97
46
-
type mcp_message = {
47
-
subtype : [`Mcp_message];
48
-
server_name : string;
49
-
message : Jsont.json;
50
-
unknown : Unknown.t;
51
-
}
52
-
53
98
type set_model = {
54
99
subtype : [`Set_model];
55
100
model : string;
···
67
112
| Initialize of initialize
68
113
| Set_permission_mode of set_permission_mode
69
114
| Hook_callback of hook_callback
70
-
| Mcp_message of mcp_message
115
+
| Mcp_message of Mcp_message.request
71
116
| Set_model of set_model
72
117
| Get_server_info of get_server_info
73
118
···
100
145
}
101
146
102
147
let mcp_message ~server_name ~message ?(unknown = Unknown.empty) () =
103
-
Mcp_message {
104
-
subtype = `Mcp_message;
105
-
server_name;
106
-
message;
107
-
unknown;
108
-
}
148
+
Mcp_message (Mcp_message.make_request ~server_name ~message ~unknown ())
109
149
110
150
let set_model ~model ?(unknown = Unknown.empty) () =
111
151
Set_model { subtype = `Set_model; model; unknown }
···
165
205
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : hook_callback) -> r.unknown)
166
206
|> Jsont.Object.finish
167
207
168
-
let mcp_message_jsont : mcp_message Jsont.t =
169
-
let make server_name message (unknown : Unknown.t) : mcp_message =
170
-
{ subtype = `Mcp_message; server_name; message; unknown }
171
-
in
172
-
Jsont.Object.map ~kind:"McpMessage" make
173
-
|> Jsont.Object.mem "server_name" Jsont.string ~enc:(fun (r : mcp_message) -> r.server_name)
174
-
|> Jsont.Object.mem "message" Jsont.json ~enc:(fun (r : mcp_message) -> r.message)
175
-
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : mcp_message) -> r.unknown)
176
-
|> Jsont.Object.finish
177
-
178
208
let set_model_jsont : set_model Jsont.t =
179
209
let make model (unknown : Unknown.t) : set_model = { subtype = `Set_model; model; unknown } in
180
210
Jsont.Object.map ~kind:"SetModel" make
···
195
225
let case_initialize = Jsont.Object.Case.map "initialize" initialize_jsont ~dec:(fun v -> Initialize v) in
196
226
let case_set_permission_mode = Jsont.Object.Case.map "set_permission_mode" set_permission_mode_jsont ~dec:(fun v -> Set_permission_mode v) in
197
227
let case_hook_callback = Jsont.Object.Case.map "hook_callback" hook_callback_jsont ~dec:(fun v -> Hook_callback v) in
198
-
let case_mcp_message = Jsont.Object.Case.map "mcp_message" mcp_message_jsont ~dec:(fun v -> Mcp_message v) in
228
+
let case_mcp_message = Jsont.Object.Case.map "mcp_message" Mcp_message.request_jsont ~dec:(fun v -> Mcp_message v) in
199
229
let case_set_model = Jsont.Object.Case.map "set_model" set_model_jsont ~dec:(fun v -> Set_model v) in
200
230
let case_get_server_info = Jsont.Object.Case.map "get_server_info" get_server_info_jsont ~dec:(fun v -> Get_server_info v) in
201
231
···
242
272
Fmt.pf fmt "@[<2>HookCallback@ { id = %S;@ tool_use_id = %a }@]"
243
273
h.callback_id Fmt.(option string) h.tool_use_id
244
274
| Mcp_message m ->
245
-
Fmt.pf fmt "@[<2>McpMessage@ { server = %S }@]"
246
-
m.server_name
275
+
Mcp_message.pp_request fmt m
247
276
| Set_model s ->
248
277
Fmt.pf fmt "@[<2>SetModel@ { model = %S }@]" s.model
249
278
| Get_server_info _ ->
+73
-9
claudeio/lib/sdk_control.mli
+73
-9
claudeio/lib/sdk_control.mli
···
54
54
(** The log source for SDK control operations *)
55
55
val src : Logs.Src.t
56
56
57
+
(** {1 Control Subtypes}
58
+
59
+
These modules define the individual request/response subtypes for
60
+
the SDK control protocol. Each subtype represents a specific control
61
+
operation with its own request and response structure. *)
62
+
63
+
(** {2 MCP Message Routing}
64
+
65
+
The [Mcp_message] subtype routes JSONRPC messages to in-process MCP servers.
66
+
This is used when the SDK manages MCP servers directly (SDK MCP servers).
67
+
68
+
External MCP servers (stdio, HTTP, SSE) are handled by the CLI directly
69
+
and don't use this control message.
70
+
71
+
Example:
72
+
{[
73
+
let req = Mcp_message.make_request
74
+
~server_name:"calculator"
75
+
~message:(* JSONRPC tools/list request *)
76
+
77
+
(* CLI routes to SDK MCP server and returns response *)
78
+
let resp = (* receive Mcp_message response *)
79
+
let jsonrpc_response = resp.mcp_response
80
+
]} *)
81
+
module Mcp_message : sig
82
+
module Unknown : sig
83
+
type t = Jsont.json
84
+
val empty : t
85
+
val is_empty : t -> bool
86
+
val jsont : t Jsont.t
87
+
end
88
+
89
+
type request = {
90
+
server_name : string;
91
+
(** Name of the SDK MCP server to route the message to *)
92
+
93
+
message : Jsont.json;
94
+
(** JSONRPC message to send to the MCP server *)
95
+
96
+
unknown : Unknown.t;
97
+
(** Unknown fields for forward compatibility *)
98
+
}
99
+
(** Request to route JSONRPC message to an in-process MCP server. *)
100
+
101
+
type response = {
102
+
mcp_response : Jsont.json;
103
+
(** JSONRPC response from the MCP server *)
104
+
105
+
unknown : Unknown.t;
106
+
(** Unknown fields for forward compatibility *)
107
+
}
108
+
(** Response containing JSONRPC response from MCP server. *)
109
+
110
+
val request_jsont : request Jsont.t
111
+
(** [request_jsont] is the jsont codec for MCP message requests. *)
112
+
113
+
val response_jsont : response Jsont.t
114
+
(** [response_jsont] is the jsont codec for MCP message responses. *)
115
+
116
+
val make_request : server_name:string -> message:Jsont.json -> ?unknown:Unknown.t -> unit -> request
117
+
(** [make_request ~server_name ~message ?unknown ()] creates an MCP message request. *)
118
+
119
+
val make_response : mcp_response:Jsont.json -> ?unknown:Unknown.t -> unit -> response
120
+
(** [make_response ~mcp_response ?unknown ()] creates an MCP message response. *)
121
+
122
+
val pp_request : Format.formatter -> request -> unit
123
+
(** [pp_request fmt req] pretty-prints an MCP message request. *)
124
+
125
+
val pp_response : Format.formatter -> response -> unit
126
+
(** [pp_response fmt resp] pretty-prints an MCP message response. *)
127
+
end
128
+
57
129
(** {1 Request Types} *)
58
130
59
131
module Request : sig
···
105
177
}
106
178
(** Hook callback request. *)
107
179
108
-
type mcp_message = {
109
-
subtype : [`Mcp_message];
110
-
server_name : string;
111
-
message : Jsont.json;
112
-
unknown : Unknown.t;
113
-
}
114
-
(** MCP server message request. *)
115
-
116
180
type set_model = {
117
181
subtype : [`Set_model];
118
182
model : string;
···
132
196
| Initialize of initialize
133
197
| Set_permission_mode of set_permission_mode
134
198
| Hook_callback of hook_callback
135
-
| Mcp_message of mcp_message
199
+
| Mcp_message of Mcp_message.request
136
200
| Set_model of set_model
137
201
| Get_server_info of get_server_info
138
202
(** The type of SDK control requests. *)
+82
claudeio/lib/transport.ml
+82
claudeio/lib/transport.ml
···
22
22
| Options.Project -> "project"
23
23
| Options.Local -> "local"
24
24
25
+
(* Helper functions for JSON construction *)
26
+
let json_string s = Jsont.String (s, Jsont.Meta.none)
27
+
28
+
let json_array items =
29
+
Jsont.Array (items, Jsont.Meta.none)
30
+
31
+
let json_object members =
32
+
Jsont.Object (
33
+
List.map (fun (k, v) -> ((k, Jsont.Meta.none), v)) members,
34
+
Jsont.Meta.none
35
+
)
36
+
37
+
(* Serialize MCP server configuration to JSON string *)
38
+
let serialize_mcp_config (servers : (string * Options.mcp_server_config) list) : string =
39
+
(* Serialize environment variables as JSON object *)
40
+
let serialize_env env_vars =
41
+
json_object (List.map (fun (k, v) -> (k, json_string v)) env_vars)
42
+
in
43
+
44
+
(* Serialize headers as JSON object *)
45
+
let serialize_headers headers =
46
+
json_object (List.map (fun (k, v) -> (k, json_string v)) headers)
47
+
in
48
+
49
+
(* Convert each server config to JSON *)
50
+
let server_jsons = List.map (fun (name, config) ->
51
+
let config_json = match config with
52
+
| Options.Stdio { command; args; env } ->
53
+
let members = [
54
+
("command", json_string command);
55
+
("args", json_array (List.map json_string args));
56
+
] in
57
+
let members = match env with
58
+
| None -> members
59
+
| Some env_vars -> members @ [("env", serialize_env env_vars)]
60
+
in
61
+
json_object members
62
+
63
+
| Options.SSE { url; headers } ->
64
+
let members = [
65
+
("type", json_string "sse");
66
+
("url", json_string url);
67
+
] in
68
+
let members = match headers with
69
+
| None -> members
70
+
| Some hdrs -> members @ [("headers", serialize_headers hdrs)]
71
+
in
72
+
json_object members
73
+
74
+
| Options.HTTP { url; headers } ->
75
+
let members = [
76
+
("type", json_string "http");
77
+
("url", json_string url);
78
+
] in
79
+
let members = match headers with
80
+
| None -> members
81
+
| Some hdrs -> members @ [("headers", serialize_headers hdrs)]
82
+
in
83
+
json_object members
84
+
in
85
+
((name, Jsont.Meta.none), config_json)
86
+
) servers in
87
+
88
+
(* Build full config object: {"mcpServers": {...}} *)
89
+
let mcp_servers_obj = Jsont.Object (server_jsons, Jsont.Meta.none) in
90
+
let full_config = Jsont.Object ([
91
+
(("mcpServers", Jsont.Meta.none), mcp_servers_obj)
92
+
], Jsont.Meta.none) in
93
+
94
+
(* Encode to string *)
95
+
match Jsont_bytesrw.encode_string' Jsont.json full_config with
96
+
| Ok s -> s
97
+
| Error err -> failwith ("Failed to encode MCP config: " ^ Jsont.Error.to_string err)
98
+
25
99
let build_command ~claude_path ~options =
26
100
let cmd = [claude_path; "--output-format"; "stream-json"; "--verbose"] in
27
101
···
90
164
in
91
165
cmd @ ["--json-schema"; schema_str]
92
166
| None -> cmd
167
+
in
168
+
169
+
(* MCP Server Configuration *)
170
+
let cmd =
171
+
if Options.mcp_servers options = [] then cmd
172
+
else
173
+
let mcp_config_json = serialize_mcp_config (Options.mcp_servers options) in
174
+
cmd @ ["--mcp-config"; mcp_config_json]
93
175
in
94
176
95
177
(* Use streaming input mode *)
+3
claudeio/lib/transport.mli
+3
claudeio/lib/transport.mli
+8
-1
claudeio/test/dune
+8
-1
claudeio/test/dune
···
88
88
(name test_incoming)
89
89
(package claude)
90
90
(modules test_incoming)
91
-
(libraries claude jsont.bytesrw))
91
+
(libraries claude jsont.bytesrw))
92
+
93
+
(executable
94
+
(public_name test_mcp_config)
95
+
(name test_mcp_config)
96
+
(package claude)
97
+
(modules test_mcp_config)
98
+
(libraries claude))
+155
claudeio/test/test_mcp_config.ml
+155
claudeio/test/test_mcp_config.ml
···
1
+
(* Test MCP configuration serialization and builder functions *)
2
+
3
+
let test_stdio_config () =
4
+
let open Claude.Options in
5
+
let config = Stdio {
6
+
command = "mcp-server-filesystem";
7
+
args = ["/workspace"];
8
+
env = Some [("KEY", "value")];
9
+
} in
10
+
let servers = [("filesystem", config)] in
11
+
12
+
(* Build options with MCP servers *)
13
+
let options = Claude.Options.default
14
+
|> Claude.Options.with_mcp_servers servers
15
+
in
16
+
17
+
(* Verify accessor works *)
18
+
let retrieved = Claude.Options.mcp_servers options in
19
+
assert (List.length retrieved = 1);
20
+
21
+
(* Test serialization via transport *)
22
+
let json_str = Claude.Transport.serialize_mcp_config servers in
23
+
print_endline "✓ Stdio config JSON:";
24
+
print_endline json_str;
25
+
print_endline ""
26
+
27
+
let test_with_mcp_stdio () =
28
+
(* Test the with_mcp_stdio convenience function *)
29
+
let options = Claude.Options.default
30
+
|> Claude.Options.with_mcp_stdio
31
+
~name:"filesystem"
32
+
~command:"mcp-server-filesystem"
33
+
~args:["/workspace"]
34
+
~env:[("VAR", "value")]
35
+
()
36
+
in
37
+
38
+
let servers = Claude.Options.mcp_servers options in
39
+
assert (List.length servers = 1);
40
+
let (name, config) = List.hd servers in
41
+
assert (name = "filesystem");
42
+
(match config with
43
+
| Claude.Options.Stdio cfg ->
44
+
assert (cfg.command = "mcp-server-filesystem");
45
+
assert (cfg.args = ["/workspace"]);
46
+
assert (cfg.env = Some [("VAR", "value")]);
47
+
print_endline "✓ with_mcp_stdio convenience function works"
48
+
| _ -> failwith "Expected Stdio config");
49
+
print_endline ""
50
+
51
+
let test_sse_config () =
52
+
let open Claude.Options in
53
+
let config = SSE {
54
+
url = "https://api.example.com/mcp";
55
+
headers = Some [("Authorization", "Bearer token")];
56
+
} in
57
+
let servers = [("api", config)] in
58
+
59
+
let json_str = Claude.Transport.serialize_mcp_config servers in
60
+
print_endline "✓ SSE config JSON:";
61
+
print_endline json_str;
62
+
print_endline ""
63
+
64
+
let test_http_config () =
65
+
let open Claude.Options in
66
+
let config = HTTP {
67
+
url = "https://api.example.com/mcp";
68
+
headers = Some [("Authorization", "Bearer token")];
69
+
} in
70
+
let servers = [("http_server", config)] in
71
+
72
+
let json_str = Claude.Transport.serialize_mcp_config servers in
73
+
print_endline "✓ HTTP config JSON:";
74
+
print_endline json_str;
75
+
print_endline ""
76
+
77
+
let test_multiple_servers () =
78
+
let open Claude.Options in
79
+
let servers = [
80
+
("filesystem", Stdio {
81
+
command = "mcp-server-filesystem";
82
+
args = ["/workspace"];
83
+
env = None;
84
+
});
85
+
("api", SSE {
86
+
url = "https://api.example.com/mcp";
87
+
headers = Some [("Authorization", "Bearer token")];
88
+
});
89
+
("http", HTTP {
90
+
url = "https://http.example.com/mcp";
91
+
headers = None;
92
+
});
93
+
] in
94
+
95
+
let json_str = Claude.Transport.serialize_mcp_config servers in
96
+
print_endline "✓ Multiple servers config JSON:";
97
+
print_endline json_str;
98
+
print_endline ""
99
+
100
+
let test_empty_config () =
101
+
let servers = [] in
102
+
let json_str = Claude.Transport.serialize_mcp_config servers in
103
+
print_endline "✓ Empty config JSON:";
104
+
print_endline json_str;
105
+
print_endline ""
106
+
107
+
let test_with_mcp_server () =
108
+
(* Test with_mcp_server builder function *)
109
+
let options = Claude.Options.default
110
+
|> Claude.Options.with_mcp_server
111
+
~name:"test"
112
+
~config:(Claude.Options.SSE {
113
+
url = "https://test.com";
114
+
headers = None
115
+
})
116
+
in
117
+
118
+
let servers = Claude.Options.mcp_servers options in
119
+
assert (List.length servers = 1);
120
+
print_endline "✓ with_mcp_server builder function works";
121
+
print_endline ""
122
+
123
+
let test_replace_server () =
124
+
(* Test that adding a server with the same name replaces it *)
125
+
let options = Claude.Options.default
126
+
|> Claude.Options.with_mcp_stdio ~name:"fs" ~command:"old-cmd" ()
127
+
|> Claude.Options.with_mcp_stdio ~name:"fs" ~command:"new-cmd" ()
128
+
in
129
+
130
+
let servers = Claude.Options.mcp_servers options in
131
+
assert (List.length servers = 1);
132
+
let (_, config) = List.hd servers in
133
+
(match config with
134
+
| Claude.Options.Stdio cfg ->
135
+
assert (cfg.command = "new-cmd");
136
+
print_endline "✓ Server replacement by name works"
137
+
| _ -> failwith "Expected Stdio config");
138
+
print_endline ""
139
+
140
+
let () =
141
+
print_endline "Testing MCP Configuration";
142
+
print_endline "========================";
143
+
print_endline "";
144
+
145
+
test_stdio_config ();
146
+
test_with_mcp_stdio ();
147
+
test_with_mcp_stdio ();
148
+
test_sse_config ();
149
+
test_http_config ();
150
+
test_multiple_servers ();
151
+
test_empty_config ();
152
+
test_with_mcp_server ();
153
+
test_replace_server ();
154
+
155
+
print_endline "✅ All MCP configuration tests completed successfully!"