My agentic slop goes here. Not intended for anyone else!

more

+161 -2
claudeio/lib/options.ml
···
type setting_source = User | Project | Local
+
type mcp_stdio_config = {
+
command : string;
+
args : string list;
+
env : (string * string) list option;
+
}
+
+
type mcp_sse_config = {
+
url : string;
+
headers : (string * string) list option;
+
}
+
+
type mcp_http_config = {
+
url : string;
+
headers : (string * string) list option;
+
}
+
+
type mcp_server_config =
+
| Stdio of mcp_stdio_config
+
| SSE of mcp_sse_config
+
| HTTP of mcp_http_config
+
module Unknown = struct
type t = Jsont.json
let empty = Jsont.Object ([], Jsont.Meta.none)
···
max_buffer_size : int option;
user : string option;
output_format : Structured_output.t option;
+
mcp_servers : (string * mcp_server_config) list;
unknown : Unknown.t;
}
···
max_buffer_size = None;
user = None;
output_format = None;
+
mcp_servers = [];
unknown = Unknown.empty;
}
···
?max_buffer_size
?user
?output_format
+
?(mcp_servers = [])
?(unknown = Unknown.empty)
() =
{ allowed_tools; disallowed_tools; max_thinking_tokens;
···
permission_prompt_tool_name; settings; add_dirs;
extra_args; debug_stderr; hooks;
max_budget_usd; fallback_model; setting_sources;
-
max_buffer_size; user; output_format; unknown }
+
max_buffer_size; user; output_format; mcp_servers; unknown }
let allowed_tools t = t.allowed_tools
let disallowed_tools t = t.disallowed_tools
···
let max_buffer_size t = t.max_buffer_size
let user t = t.user
let output_format t = t.output_format
+
let mcp_servers t = t.mcp_servers
let unknown t = t.unknown
let with_allowed_tools tools t = { t with allowed_tools = tools }
···
let with_user user t = { t with user = Some user }
let with_output_format format t = { t with output_format = Some format }
+
let with_mcp_server ~name ~config t =
+
let servers = List.filter (fun (n, _) -> n <> name) t.mcp_servers in
+
{ t with mcp_servers = (name, config) :: servers }
+
+
let with_mcp_servers servers t = { t with mcp_servers = servers }
+
+
let with_mcp_stdio ~name ~command ?(args = []) ?env () t =
+
let config = Stdio { command; args; env } in
+
with_mcp_server ~name ~config t
+
(* Helper codec for Model.t *)
let model_jsont : Model.t Jsont.t =
Jsont.map ~kind:"Model"
···
Jsont.Json.object' mems)
Jsont.json
+
(* Helper codec for headers - list of string pairs encoded as object *)
+
let headers_jsont : (string * string) list Jsont.t =
+
Jsont.map ~kind:"Headers"
+
~dec:(fun obj ->
+
match obj with
+
| Jsont.Object (members, _) ->
+
List.map (fun ((name, _), value) ->
+
match value with
+
| Jsont.String (s, _) -> (name, s)
+
| _ -> (name, "")
+
) members
+
| _ -> [])
+
~enc:(fun pairs ->
+
let mems = List.map (fun (k, v) ->
+
Jsont.Json.mem (Jsont.Json.name k) (Jsont.Json.string v)
+
) pairs in
+
Jsont.Json.object' mems)
+
Jsont.json
+
+
(* MCP server config codecs *)
+
let mcp_stdio_config_jsont : mcp_stdio_config Jsont.t =
+
let make command args env : mcp_stdio_config = { command; args; env } in
+
Jsont.Object.map ~kind:"McpStdioConfig" make
+
|> Jsont.Object.mem "command" Jsont.string ~enc:(fun (c : mcp_stdio_config) -> c.command) ~dec_absent:""
+
|> Jsont.Object.mem "args" (Jsont.list Jsont.string) ~enc:(fun (c : mcp_stdio_config) -> c.args) ~dec_absent:[]
+
|> Jsont.Object.opt_mem "env" env_jsont ~enc:(fun (c : mcp_stdio_config) -> c.env)
+
|> Jsont.Object.finish
+
+
let mcp_sse_config_jsont : mcp_sse_config Jsont.t =
+
let make url headers : mcp_sse_config = { url; headers } in
+
Jsont.Object.map ~kind:"McpSseConfig" make
+
|> Jsont.Object.mem "url" Jsont.string ~enc:(fun (c : mcp_sse_config) -> c.url) ~dec_absent:""
+
|> Jsont.Object.opt_mem "headers" headers_jsont ~enc:(fun (c : mcp_sse_config) -> c.headers)
+
|> Jsont.Object.finish
+
+
let mcp_http_config_jsont : mcp_http_config Jsont.t =
+
let make url headers : mcp_http_config = { url; headers } in
+
Jsont.Object.map ~kind:"McpHttpConfig" make
+
|> Jsont.Object.mem "url" Jsont.string ~enc:(fun (c : mcp_http_config) -> c.url) ~dec_absent:""
+
|> Jsont.Object.opt_mem "headers" headers_jsont ~enc:(fun (c : mcp_http_config) -> c.headers)
+
|> Jsont.Object.finish
+
+
let mcp_server_config_jsont : mcp_server_config Jsont.t =
+
Jsont.map ~kind:"McpServerConfig"
+
~dec:(fun obj ->
+
match obj with
+
| Jsont.Object (members, _) ->
+
(* Look for type field to determine variant *)
+
let type_field = List.find_map (fun ((name, _), value) ->
+
if name = "type" then
+
match value with
+
| Jsont.String (s, _) -> Some s
+
| _ -> None
+
else None
+
) members in
+
(match type_field with
+
| Some "stdio" ->
+
let config = Jsont.Json.decode mcp_stdio_config_jsont obj in
+
(match config with
+
| Ok cfg -> Stdio cfg
+
| Error _ -> Stdio { command = ""; args = []; env = None })
+
| Some "sse" ->
+
let config = Jsont.Json.decode mcp_sse_config_jsont obj in
+
(match config with
+
| Ok cfg -> SSE cfg
+
| Error _ -> SSE { url = ""; headers = None })
+
| Some "http" ->
+
let config = Jsont.Json.decode mcp_http_config_jsont obj in
+
(match config with
+
| Ok cfg -> HTTP cfg
+
| Error _ -> HTTP { url = ""; headers = None })
+
| _ -> Stdio { command = ""; args = []; env = None })
+
| _ -> Stdio { command = ""; args = []; env = None })
+
~enc:(fun config ->
+
match config with
+
| Stdio cfg ->
+
let obj = Jsont.Json.encode mcp_stdio_config_jsont cfg in
+
(match obj with
+
| Ok (Jsont.Object (members, meta)) ->
+
let type_mem = Jsont.Json.mem (Jsont.Json.name "type") (Jsont.Json.string "stdio") in
+
Jsont.Object (type_mem :: members, meta)
+
| Ok json -> json
+
| Error _ -> Jsont.Object ([], Jsont.Meta.none))
+
| SSE cfg ->
+
let obj = Jsont.Json.encode mcp_sse_config_jsont cfg in
+
(match obj with
+
| Ok (Jsont.Object (members, meta)) ->
+
let type_mem = Jsont.Json.mem (Jsont.Json.name "type") (Jsont.Json.string "sse") in
+
Jsont.Object (type_mem :: members, meta)
+
| Ok json -> json
+
| Error _ -> Jsont.Object ([], Jsont.Meta.none))
+
| HTTP cfg ->
+
let obj = Jsont.Json.encode mcp_http_config_jsont cfg in
+
(match obj with
+
| Ok (Jsont.Object (members, meta)) ->
+
let type_mem = Jsont.Json.mem (Jsont.Json.name "type") (Jsont.Json.string "http") in
+
Jsont.Object (type_mem :: members, meta)
+
| Ok json -> json
+
| Error _ -> Jsont.Object ([], Jsont.Meta.none)))
+
Jsont.json
+
+
(* Codec for MCP servers map - encoded as object with server names as keys *)
+
let mcp_servers_jsont : (string * mcp_server_config) list Jsont.t =
+
Jsont.map ~kind:"McpServers"
+
~dec:(fun obj ->
+
match obj with
+
| Jsont.Object (members, _) ->
+
List.filter_map (fun ((name, _), value) ->
+
match Jsont.Json.decode mcp_server_config_jsont value with
+
| Ok cfg -> Some (name, cfg)
+
| Error _ -> None
+
) members
+
| _ -> [])
+
~enc:(fun servers ->
+
let mems = List.map (fun (name, cfg) ->
+
match Jsont.Json.encode mcp_server_config_jsont cfg with
+
| Ok json -> Jsont.Json.mem (Jsont.Json.name name) json
+
| Error _ -> Jsont.Json.mem (Jsont.Json.name name) (Jsont.Object ([], Jsont.Meta.none))
+
) servers in
+
Jsont.Json.object' mems)
+
Jsont.json
+
let jsont : t Jsont.t =
let make allowed_tools disallowed_tools max_thinking_tokens
system_prompt append_system_prompt permission_mode
-
model env unknown =
+
model env mcp_servers unknown =
{ allowed_tools; disallowed_tools; max_thinking_tokens;
system_prompt; append_system_prompt; permission_mode;
permission_callback = Some Permissions.default_allow_callback;
···
max_buffer_size = None;
user = None;
output_format = None;
+
mcp_servers;
unknown }
in
Jsont.Object.map ~kind:"Options" make
···
|> Jsont.Object.opt_mem "permission_mode" Permissions.Mode.jsont ~enc:permission_mode
|> Jsont.Object.opt_mem "model" model_jsont ~enc:model
|> Jsont.Object.mem "env" env_jsont ~enc:env ~dec_absent:[]
+
|> Jsont.Object.mem "mcp_servers" mcp_servers_jsont ~enc:mcp_servers ~dec_absent:[]
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown
|> Jsont.Object.finish
+76 -2
claudeio/lib/options.mli
···
- [Project]: Load project-level settings from .claude/ in project root
- [Local]: Load local settings from current directory *)
+
(** {2 MCP Server Configuration}
+
+
MCP (Model Context Protocol) servers provide tools and resources.
+
+
Example:
+
{[
+
let options = Options.default
+
|> Options.with_mcp_stdio
+
~name:"filesystem"
+
~command:"mcp-server-filesystem"
+
~args:["/workspace"]
+
()
+
|> Options.with_allowed_tools [
+
"mcp__filesystem__read_file";
+
"mcp__filesystem__write_file";
+
]
+
]}
+
+
Tool Naming: MCP tools are named [mcp__<server>__<tool>] *)
+
+
type mcp_stdio_config = {
+
command : string;
+
args : string list;
+
env : (string * string) list option;
+
}
+
(** Stdio-based MCP server (external process) *)
+
+
type mcp_sse_config = {
+
url : string;
+
headers : (string * string) list option;
+
}
+
(** Server-Sent Events MCP server *)
+
+
type mcp_http_config = {
+
url : string;
+
headers : (string * string) list option;
+
}
+
(** HTTP-based MCP server *)
+
+
type mcp_server_config =
+
| Stdio of mcp_stdio_config
+
| SSE of mcp_sse_config
+
| HTTP of mcp_http_config
+
(** MCP server configuration variants *)
+
type t
(** The type of configuration options. *)
···
?max_buffer_size:int ->
?user:string ->
?output_format:Structured_output.t ->
+
?mcp_servers:(string * mcp_server_config) list ->
?unknown:Jsont.json ->
unit -> t
(** [create ?allowed_tools ?disallowed_tools ?max_thinking_tokens ?system_prompt
?append_system_prompt ?permission_mode ?permission_callback ?model ?cwd ?env
?continue_conversation ?resume ?max_turns ?permission_prompt_tool_name ?settings
?add_dirs ?extra_args ?debug_stderr ?hooks ?max_budget_usd ?fallback_model
-
?setting_sources ?max_buffer_size ?user ()]
+
?setting_sources ?max_buffer_size ?user ?mcp_servers ()]
creates a new configuration.
@param allowed_tools List of explicitly allowed tool names
@param disallowed_tools List of explicitly disallowed tool names
···
@param setting_sources Control which settings load (user/project/local)
@param max_buffer_size Control for stdout buffer size in bytes
@param user Unix user for subprocess execution
-
@param output_format Optional structured output format specification *)
+
@param output_format Optional structured output format specification
+
@param mcp_servers MCP server configurations (name -> config mapping) *)
(** {1 Accessors} *)
···
val output_format : t -> Structured_output.t option
(** [output_format t] returns the optional structured output format. *)
+
+
val mcp_servers : t -> (string * mcp_server_config) list
+
(** [mcp_servers t] returns the MCP server configurations.
+
Tools from MCP servers are named: mcp__<server_name>__<tool_name> *)
val unknown : t -> Jsont.json
(** [unknown t] returns any unknown JSON fields that were preserved during decoding. *)
···
val with_output_format : Structured_output.t -> t -> t
(** [with_output_format format t] sets the structured output format. *)
+
+
val with_mcp_server :
+
name:string ->
+
config:mcp_server_config ->
+
t -> t
+
(** [with_mcp_server ~name ~config t] adds an MCP server configuration.
+
If a server with the same name exists, it will be replaced. *)
+
+
val with_mcp_servers :
+
(string * mcp_server_config) list ->
+
t -> t
+
(** [with_mcp_servers servers t] sets MCP servers (replaces existing).
+
Each element is a pair of (server_name, server_config). *)
+
+
val with_mcp_stdio :
+
name:string ->
+
command:string ->
+
?args:string list ->
+
?env:(string * string) list ->
+
unit ->
+
t -> t
+
(** [with_mcp_stdio ~name ~command ?args ?env () t] is a convenience
+
function to add a stdio-based MCP server. *)
(** {1 Serialization} *)
+56 -27
claudeio/lib/sdk_control.ml
···
let src = Logs.Src.create "claude.sdk_control" ~doc:"Claude SDK control protocol"
module Log = (val Logs.src_log src : Logs.LOG)
+
(** MCP Message Routing *)
+
module Mcp_message = struct
+
module Unknown = struct
+
type t = Jsont.json
+
let empty = Jsont.Object ([], Jsont.Meta.none)
+
let is_empty = function Jsont.Object ([], _) -> true | _ -> false
+
let jsont = Jsont.json
+
end
+
+
type request = {
+
server_name : string;
+
message : Jsont.json;
+
unknown : Unknown.t;
+
}
+
+
type response = {
+
mcp_response : Jsont.json;
+
unknown : Unknown.t;
+
}
+
+
let make_request ~server_name ~message ?(unknown = Unknown.empty) () =
+
{ server_name; message; unknown }
+
+
let make_response ~mcp_response ?(unknown = Unknown.empty) () =
+
{ mcp_response; unknown }
+
+
let request_jsont : request Jsont.t =
+
let make server_name message (unknown : Unknown.t) : request =
+
{ server_name; message; unknown }
+
in
+
Jsont.Object.map ~kind:"McpMessageRequest" make
+
|> Jsont.Object.mem "server_name" Jsont.string ~enc:(fun (r : request) -> r.server_name)
+
|> Jsont.Object.mem "message" Jsont.json ~enc:(fun (r : request) -> r.message)
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : request) -> r.unknown)
+
|> Jsont.Object.finish
+
+
let response_jsont : response Jsont.t =
+
let make mcp_response (unknown : Unknown.t) : response =
+
{ mcp_response; unknown }
+
in
+
Jsont.Object.map ~kind:"McpMessageResponse" make
+
|> Jsont.Object.mem "mcp_response" Jsont.json ~enc:(fun (r : response) -> r.mcp_response)
+
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : response) -> r.unknown)
+
|> Jsont.Object.finish
+
+
let pp_request fmt req =
+
Fmt.pf fmt "@[<2>McpMessage.Request@ { server = %S }@]" req.server_name
+
+
let pp_response fmt _resp =
+
Fmt.pf fmt "@[<2>McpMessage.Response@ { mcp_response = <json> }@]"
+
end
+
module Request = struct
module Unknown = struct
type t = Jsont.json
···
unknown : Unknown.t;
}
-
type mcp_message = {
-
subtype : [`Mcp_message];
-
server_name : string;
-
message : Jsont.json;
-
unknown : Unknown.t;
-
}
-
type set_model = {
subtype : [`Set_model];
model : string;
···
| Initialize of initialize
| Set_permission_mode of set_permission_mode
| Hook_callback of hook_callback
-
| Mcp_message of mcp_message
+
| Mcp_message of Mcp_message.request
| Set_model of set_model
| Get_server_info of get_server_info
···
}
let mcp_message ~server_name ~message ?(unknown = Unknown.empty) () =
-
Mcp_message {
-
subtype = `Mcp_message;
-
server_name;
-
message;
-
unknown;
-
}
+
Mcp_message (Mcp_message.make_request ~server_name ~message ~unknown ())
let set_model ~model ?(unknown = Unknown.empty) () =
Set_model { subtype = `Set_model; model; unknown }
···
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : hook_callback) -> r.unknown)
|> Jsont.Object.finish
-
let mcp_message_jsont : mcp_message Jsont.t =
-
let make server_name message (unknown : Unknown.t) : mcp_message =
-
{ subtype = `Mcp_message; server_name; message; unknown }
-
in
-
Jsont.Object.map ~kind:"McpMessage" make
-
|> Jsont.Object.mem "server_name" Jsont.string ~enc:(fun (r : mcp_message) -> r.server_name)
-
|> Jsont.Object.mem "message" Jsont.json ~enc:(fun (r : mcp_message) -> r.message)
-
|> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : mcp_message) -> r.unknown)
-
|> Jsont.Object.finish
-
let set_model_jsont : set_model Jsont.t =
let make model (unknown : Unknown.t) : set_model = { subtype = `Set_model; model; unknown } in
Jsont.Object.map ~kind:"SetModel" make
···
let case_initialize = Jsont.Object.Case.map "initialize" initialize_jsont ~dec:(fun v -> Initialize v) in
let case_set_permission_mode = Jsont.Object.Case.map "set_permission_mode" set_permission_mode_jsont ~dec:(fun v -> Set_permission_mode v) in
let case_hook_callback = Jsont.Object.Case.map "hook_callback" hook_callback_jsont ~dec:(fun v -> Hook_callback v) in
-
let case_mcp_message = Jsont.Object.Case.map "mcp_message" mcp_message_jsont ~dec:(fun v -> Mcp_message v) in
+
let case_mcp_message = Jsont.Object.Case.map "mcp_message" Mcp_message.request_jsont ~dec:(fun v -> Mcp_message v) in
let case_set_model = Jsont.Object.Case.map "set_model" set_model_jsont ~dec:(fun v -> Set_model v) in
let case_get_server_info = Jsont.Object.Case.map "get_server_info" get_server_info_jsont ~dec:(fun v -> Get_server_info v) in
···
Fmt.pf fmt "@[<2>HookCallback@ { id = %S;@ tool_use_id = %a }@]"
h.callback_id Fmt.(option string) h.tool_use_id
| Mcp_message m ->
-
Fmt.pf fmt "@[<2>McpMessage@ { server = %S }@]"
-
m.server_name
+
Mcp_message.pp_request fmt m
| Set_model s ->
Fmt.pf fmt "@[<2>SetModel@ { model = %S }@]" s.model
| Get_server_info _ ->
+73 -9
claudeio/lib/sdk_control.mli
···
(** The log source for SDK control operations *)
val src : Logs.Src.t
+
(** {1 Control Subtypes}
+
+
These modules define the individual request/response subtypes for
+
the SDK control protocol. Each subtype represents a specific control
+
operation with its own request and response structure. *)
+
+
(** {2 MCP Message Routing}
+
+
The [Mcp_message] subtype routes JSONRPC messages to in-process MCP servers.
+
This is used when the SDK manages MCP servers directly (SDK MCP servers).
+
+
External MCP servers (stdio, HTTP, SSE) are handled by the CLI directly
+
and don't use this control message.
+
+
Example:
+
{[
+
let req = Mcp_message.make_request
+
~server_name:"calculator"
+
~message:(* JSONRPC tools/list request *)
+
+
(* CLI routes to SDK MCP server and returns response *)
+
let resp = (* receive Mcp_message response *)
+
let jsonrpc_response = resp.mcp_response
+
]} *)
+
module Mcp_message : sig
+
module Unknown : sig
+
type t = Jsont.json
+
val empty : t
+
val is_empty : t -> bool
+
val jsont : t Jsont.t
+
end
+
+
type request = {
+
server_name : string;
+
(** Name of the SDK MCP server to route the message to *)
+
+
message : Jsont.json;
+
(** JSONRPC message to send to the MCP server *)
+
+
unknown : Unknown.t;
+
(** Unknown fields for forward compatibility *)
+
}
+
(** Request to route JSONRPC message to an in-process MCP server. *)
+
+
type response = {
+
mcp_response : Jsont.json;
+
(** JSONRPC response from the MCP server *)
+
+
unknown : Unknown.t;
+
(** Unknown fields for forward compatibility *)
+
}
+
(** Response containing JSONRPC response from MCP server. *)
+
+
val request_jsont : request Jsont.t
+
(** [request_jsont] is the jsont codec for MCP message requests. *)
+
+
val response_jsont : response Jsont.t
+
(** [response_jsont] is the jsont codec for MCP message responses. *)
+
+
val make_request : server_name:string -> message:Jsont.json -> ?unknown:Unknown.t -> unit -> request
+
(** [make_request ~server_name ~message ?unknown ()] creates an MCP message request. *)
+
+
val make_response : mcp_response:Jsont.json -> ?unknown:Unknown.t -> unit -> response
+
(** [make_response ~mcp_response ?unknown ()] creates an MCP message response. *)
+
+
val pp_request : Format.formatter -> request -> unit
+
(** [pp_request fmt req] pretty-prints an MCP message request. *)
+
+
val pp_response : Format.formatter -> response -> unit
+
(** [pp_response fmt resp] pretty-prints an MCP message response. *)
+
end
+
(** {1 Request Types} *)
module Request : sig
···
}
(** Hook callback request. *)
-
type mcp_message = {
-
subtype : [`Mcp_message];
-
server_name : string;
-
message : Jsont.json;
-
unknown : Unknown.t;
-
}
-
(** MCP server message request. *)
-
type set_model = {
subtype : [`Set_model];
model : string;
···
| Initialize of initialize
| Set_permission_mode of set_permission_mode
| Hook_callback of hook_callback
-
| Mcp_message of mcp_message
+
| Mcp_message of Mcp_message.request
| Set_model of set_model
| Get_server_info of get_server_info
(** The type of SDK control requests. *)
+82
claudeio/lib/transport.ml
···
| Options.Project -> "project"
| Options.Local -> "local"
+
(* Helper functions for JSON construction *)
+
let json_string s = Jsont.String (s, Jsont.Meta.none)
+
+
let json_array items =
+
Jsont.Array (items, Jsont.Meta.none)
+
+
let json_object members =
+
Jsont.Object (
+
List.map (fun (k, v) -> ((k, Jsont.Meta.none), v)) members,
+
Jsont.Meta.none
+
)
+
+
(* Serialize MCP server configuration to JSON string *)
+
let serialize_mcp_config (servers : (string * Options.mcp_server_config) list) : string =
+
(* Serialize environment variables as JSON object *)
+
let serialize_env env_vars =
+
json_object (List.map (fun (k, v) -> (k, json_string v)) env_vars)
+
in
+
+
(* Serialize headers as JSON object *)
+
let serialize_headers headers =
+
json_object (List.map (fun (k, v) -> (k, json_string v)) headers)
+
in
+
+
(* Convert each server config to JSON *)
+
let server_jsons = List.map (fun (name, config) ->
+
let config_json = match config with
+
| Options.Stdio { command; args; env } ->
+
let members = [
+
("command", json_string command);
+
("args", json_array (List.map json_string args));
+
] in
+
let members = match env with
+
| None -> members
+
| Some env_vars -> members @ [("env", serialize_env env_vars)]
+
in
+
json_object members
+
+
| Options.SSE { url; headers } ->
+
let members = [
+
("type", json_string "sse");
+
("url", json_string url);
+
] in
+
let members = match headers with
+
| None -> members
+
| Some hdrs -> members @ [("headers", serialize_headers hdrs)]
+
in
+
json_object members
+
+
| Options.HTTP { url; headers } ->
+
let members = [
+
("type", json_string "http");
+
("url", json_string url);
+
] in
+
let members = match headers with
+
| None -> members
+
| Some hdrs -> members @ [("headers", serialize_headers hdrs)]
+
in
+
json_object members
+
in
+
((name, Jsont.Meta.none), config_json)
+
) servers in
+
+
(* Build full config object: {"mcpServers": {...}} *)
+
let mcp_servers_obj = Jsont.Object (server_jsons, Jsont.Meta.none) in
+
let full_config = Jsont.Object ([
+
(("mcpServers", Jsont.Meta.none), mcp_servers_obj)
+
], Jsont.Meta.none) in
+
+
(* Encode to string *)
+
match Jsont_bytesrw.encode_string' Jsont.json full_config with
+
| Ok s -> s
+
| Error err -> failwith ("Failed to encode MCP config: " ^ Jsont.Error.to_string err)
+
let build_command ~claude_path ~options =
let cmd = [claude_path; "--output-format"; "stream-json"; "--verbose"] in
···
in
cmd @ ["--json-schema"; schema_str]
| None -> cmd
+
in
+
+
(* MCP Server Configuration *)
+
let cmd =
+
if Options.mcp_servers options = [] then cmd
+
else
+
let mcp_config_json = serialize_mcp_config (Options.mcp_servers options) in
+
cmd @ ["--mcp-config"; mcp_config_json]
in
(* Use streaming input mode *)
+3
claudeio/lib/transport.mli
···
val receive_line : t -> string option
val interrupt : t -> unit
val close : t -> unit
+
+
val serialize_mcp_config : (string * Options.mcp_server_config) list -> string
+
(** Serialize MCP server configuration to JSON string for CLI --mcp-config flag *)
+8 -1
claudeio/test/dune
···
(name test_incoming)
(package claude)
(modules test_incoming)
-
(libraries claude jsont.bytesrw))
+
(libraries claude jsont.bytesrw))
+
+
(executable
+
(public_name test_mcp_config)
+
(name test_mcp_config)
+
(package claude)
+
(modules test_mcp_config)
+
(libraries claude))
+155
claudeio/test/test_mcp_config.ml
···
+
(* Test MCP configuration serialization and builder functions *)
+
+
let test_stdio_config () =
+
let open Claude.Options in
+
let config = Stdio {
+
command = "mcp-server-filesystem";
+
args = ["/workspace"];
+
env = Some [("KEY", "value")];
+
} in
+
let servers = [("filesystem", config)] in
+
+
(* Build options with MCP servers *)
+
let options = Claude.Options.default
+
|> Claude.Options.with_mcp_servers servers
+
in
+
+
(* Verify accessor works *)
+
let retrieved = Claude.Options.mcp_servers options in
+
assert (List.length retrieved = 1);
+
+
(* Test serialization via transport *)
+
let json_str = Claude.Transport.serialize_mcp_config servers in
+
print_endline "✓ Stdio config JSON:";
+
print_endline json_str;
+
print_endline ""
+
+
let test_with_mcp_stdio () =
+
(* Test the with_mcp_stdio convenience function *)
+
let options = Claude.Options.default
+
|> Claude.Options.with_mcp_stdio
+
~name:"filesystem"
+
~command:"mcp-server-filesystem"
+
~args:["/workspace"]
+
~env:[("VAR", "value")]
+
()
+
in
+
+
let servers = Claude.Options.mcp_servers options in
+
assert (List.length servers = 1);
+
let (name, config) = List.hd servers in
+
assert (name = "filesystem");
+
(match config with
+
| Claude.Options.Stdio cfg ->
+
assert (cfg.command = "mcp-server-filesystem");
+
assert (cfg.args = ["/workspace"]);
+
assert (cfg.env = Some [("VAR", "value")]);
+
print_endline "✓ with_mcp_stdio convenience function works"
+
| _ -> failwith "Expected Stdio config");
+
print_endline ""
+
+
let test_sse_config () =
+
let open Claude.Options in
+
let config = SSE {
+
url = "https://api.example.com/mcp";
+
headers = Some [("Authorization", "Bearer token")];
+
} in
+
let servers = [("api", config)] in
+
+
let json_str = Claude.Transport.serialize_mcp_config servers in
+
print_endline "✓ SSE config JSON:";
+
print_endline json_str;
+
print_endline ""
+
+
let test_http_config () =
+
let open Claude.Options in
+
let config = HTTP {
+
url = "https://api.example.com/mcp";
+
headers = Some [("Authorization", "Bearer token")];
+
} in
+
let servers = [("http_server", config)] in
+
+
let json_str = Claude.Transport.serialize_mcp_config servers in
+
print_endline "✓ HTTP config JSON:";
+
print_endline json_str;
+
print_endline ""
+
+
let test_multiple_servers () =
+
let open Claude.Options in
+
let servers = [
+
("filesystem", Stdio {
+
command = "mcp-server-filesystem";
+
args = ["/workspace"];
+
env = None;
+
});
+
("api", SSE {
+
url = "https://api.example.com/mcp";
+
headers = Some [("Authorization", "Bearer token")];
+
});
+
("http", HTTP {
+
url = "https://http.example.com/mcp";
+
headers = None;
+
});
+
] in
+
+
let json_str = Claude.Transport.serialize_mcp_config servers in
+
print_endline "✓ Multiple servers config JSON:";
+
print_endline json_str;
+
print_endline ""
+
+
let test_empty_config () =
+
let servers = [] in
+
let json_str = Claude.Transport.serialize_mcp_config servers in
+
print_endline "✓ Empty config JSON:";
+
print_endline json_str;
+
print_endline ""
+
+
let test_with_mcp_server () =
+
(* Test with_mcp_server builder function *)
+
let options = Claude.Options.default
+
|> Claude.Options.with_mcp_server
+
~name:"test"
+
~config:(Claude.Options.SSE {
+
url = "https://test.com";
+
headers = None
+
})
+
in
+
+
let servers = Claude.Options.mcp_servers options in
+
assert (List.length servers = 1);
+
print_endline "✓ with_mcp_server builder function works";
+
print_endline ""
+
+
let test_replace_server () =
+
(* Test that adding a server with the same name replaces it *)
+
let options = Claude.Options.default
+
|> Claude.Options.with_mcp_stdio ~name:"fs" ~command:"old-cmd" ()
+
|> Claude.Options.with_mcp_stdio ~name:"fs" ~command:"new-cmd" ()
+
in
+
+
let servers = Claude.Options.mcp_servers options in
+
assert (List.length servers = 1);
+
let (_, config) = List.hd servers in
+
(match config with
+
| Claude.Options.Stdio cfg ->
+
assert (cfg.command = "new-cmd");
+
print_endline "✓ Server replacement by name works"
+
| _ -> failwith "Expected Stdio config");
+
print_endline ""
+
+
let () =
+
print_endline "Testing MCP Configuration";
+
print_endline "========================";
+
print_endline "";
+
+
test_stdio_config ();
+
test_with_mcp_stdio ();
+
test_with_mcp_stdio ();
+
test_sse_config ();
+
test_http_config ();
+
test_multiple_servers ();
+
test_empty_config ();
+
test_with_mcp_server ();
+
test_replace_server ();
+
+
print_endline "✅ All MCP configuration tests completed successfully!"