+1

dune

··· 1 1 ; Root dune file 2 2 3 3 ; Ignore third_party directory (for fetched dependency sources) 4 4 + 4 5 (data_only_dirs third_party)

+55 -48

lib/claude.mli

··· 32 32 33 33 {2 Domain Types} 34 34 - {!Content_block}: Content blocks (text, tool use, tool results, thinking) 35 35 - - {!Message}: Messages exchanged with Claude (user, assistant, system, result) 35 35 + - {!Message}: Messages exchanged with Claude (user, assistant, system, 36 36 + result) 36 37 - {!Tool_input}: Opaque tool input with typed accessors 37 38 - {!Server_info}: Server capabilities and metadata 38 39 ··· 44 45 {[ 45 46 open Eio.Std 46 47 47 47 - let () = Eio_main.run @@ fun env -> 48 48 + let () = 49 49 + Eio_main.run @@ fun env -> 48 50 Switch.run @@ fun sw -> 49 49 - let client = Claude.Client.create ~sw 50 50 - ~process_mgr:(Eio.Stdenv.process_mgr env) () in 51 51 + let client = 52 52 + Claude.Client.create ~sw ~process_mgr:(Eio.Stdenv.process_mgr env) () 53 53 + in 51 54 52 55 Claude.Client.query client "What is 2+2?"; 53 56 54 54 - let handler = object 55 55 - inherit Claude.Handler.default 56 56 - method! on_text t = print_endline (Claude.Response.Text.content t) 57 57 - end in 57 57 + let handler = 58 58 + object 59 59 + inherit Claude.Handler.default 60 60 + method! on_text t = print_endline (Claude.Response.Text.content t) 61 61 + end 62 62 + in 58 63 59 64 Claude.Client.run client ~handler 60 65 ]} ··· 68 73 Subclass {!Handler.default} and override only the methods you need: 69 74 70 75 {[ 71 71 - let my_handler = object 72 72 - inherit Claude.Handler.default 73 73 - 74 74 - method! on_text t = 75 75 - print_endline (Claude.Response.Text.content t) 76 76 + let my_handler = 77 77 + object 78 78 + inherit Claude.Handler.default 79 79 + method! on_text t = print_endline (Claude.Response.Text.content t) 76 80 77 77 - method! on_tool_use t = 78 78 - Printf.printf "Tool: %s\n" (Claude.Response.Tool_use.name t) 81 81 + method! on_tool_use t = 82 82 + Printf.printf "Tool: %s\n" (Claude.Response.Tool_use.name t) 79 83 80 80 - method! on_complete c = 81 81 - Printf.printf "Done! Cost: $%.4f\n" 82 82 - (Option.value ~default:0.0 (Claude.Response.Complete.total_cost_usd c)) 83 83 - end in 84 84 + method! on_complete c = 85 85 + Printf.printf "Done! Cost: $%.4f\n" 86 86 + (Option.value ~default:0.0 87 87 + (Claude.Response.Complete.total_cost_usd c)) 88 88 + end 89 89 + in 84 90 85 91 Claude.Client.run client ~handler:my_handler 86 92 ]} ··· 92 98 {[ 93 99 Claude.Client.receive client 94 100 |> Seq.iter (function 95 95 - | Claude.Response.Text t -> print_endline (Claude.Response.Text.content t) 101 101 + | Claude.Response.Text t -> 102 102 + print_endline (Claude.Response.Text.content t) 96 103 | Claude.Response.Complete c -> Printf.printf "Done!\n" 97 104 | _ -> ()) 98 105 ]} ··· 105 112 let options = 106 113 Claude.Options.default 107 114 |> Claude.Options.with_allowed_tools [ "Read"; "Write"; "Bash" ] 108 108 - |> Claude.Options.with_permission_mode Claude.Permissions.Mode.Accept_edits 115 115 + |> Claude.Options.with_permission_mode 116 116 + Claude.Permissions.Mode.Accept_edits 109 117 ]} 110 118 111 119 {2 Custom Permission Callbacks} ··· 115 123 {[ 116 124 let my_callback ctx = 117 125 if ctx.Claude.Permissions.tool_name = "Bash" then 118 118 - Claude.Permissions.Decision.deny ~message:"Bash not allowed" ~interrupt:false 119 119 - else 120 120 - Claude.Permissions.Decision.allow () 126 126 + Claude.Permissions.Decision.deny ~message:"Bash not allowed" 127 127 + ~interrupt:false 128 128 + else Claude.Permissions.Decision.allow () 121 129 122 130 let options = 123 131 Claude.Options.default ··· 132 140 let hooks = 133 141 Claude.Hooks.empty 134 142 |> Claude.Hooks.on_pre_tool_use ~pattern:"Bash" (fun input -> 135 135 - if String.is_prefix ~prefix:"rm" (input.tool_input |> Claude.Tool_input.get_string "command" |> Option.value ~default:"") then 136 136 - Claude.Hooks.PreToolUse.deny ~reason:"Dangerous command" () 137 137 - else 138 138 - Claude.Hooks.PreToolUse.continue ()) 143 143 + if 144 144 + String.is_prefix ~prefix:"rm" 145 145 + (input.tool_input 146 146 + |> Claude.Tool_input.get_string "command" 147 147 + |> Option.value ~default:"") 148 148 + then Claude.Hooks.PreToolUse.deny ~reason:"Dangerous command" () 149 149 + else Claude.Hooks.PreToolUse.continue ()) 139 150 140 140 - let options = 141 141 - Claude.Options.default |> Claude.Options.with_hooks hooks 151 151 + let options = Claude.Options.default |> Claude.Options.with_hooks hooks 142 152 ]} 143 153 144 154 {1 Error Handling} ··· 146 156 The library uses a structured exception type {!Err.E} for all errors: 147 157 148 158 {[ 149 149 - try 150 150 - Claude.Client.query client "Hello" 159 159 + try Claude.Client.query client "Hello" 151 160 with Claude.Err.E err -> 152 161 Printf.eprintf "Error: %s\n" (Claude.Err.to_string err) 153 162 ]} ··· 222 231 {2 Example} 223 232 224 233 {[ 225 225 - let greet = Claude.Tool.create 226 226 - ~name:"greet" 227 227 - ~description:"Greet a user" 228 228 - ~input_schema:(Claude.Tool.schema_object 229 229 - ["name", Claude.Tool.schema_string] 230 230 - ~required:["name"]) 231 231 - ~handler:(fun args -> 232 232 - match Claude.Tool_input.get_string args "name" with 233 233 - | Some name -> Ok (Claude.Tool.text_result ("Hello, " ^ name ^ "!")) 234 234 - | None -> Error "Missing name") 234 234 + let greet = 235 235 + Claude.Tool.create ~name:"greet" ~description:"Greet a user" 236 236 + ~input_schema: 237 237 + (Claude.Tool.schema_object 238 238 + [ ("name", Claude.Tool.schema_string) ] 239 239 + ~required:[ "name" ]) 240 240 + ~handler:(fun args -> 241 241 + match Claude.Tool_input.get_string args "name" with 242 242 + | Some name -> Ok (Claude.Tool.text_result ("Hello, " ^ name ^ "!")) 243 243 + | None -> Error "Missing name") 235 244 236 236 - let server = Claude.Mcp_server.create 237 237 - ~name:"my-tools" 238 238 - ~tools:[greet] 239 239 - () 245 245 + let server = Claude.Mcp_server.create ~name:"my-tools" ~tools:[ greet ] () 240 246 241 241 - let options = Claude.Options.default 247 247 + let options = 248 248 + Claude.Options.default 242 249 |> Claude.Options.with_mcp_server ~name:"tools" server 243 243 - |> Claude.Options.with_allowed_tools ["mcp__tools__greet"] 250 250 + |> Claude.Options.with_allowed_tools [ "mcp__tools__greet" ] 244 251 ]} *) 245 252 246 253 module Tool = Tool

+88 -54

lib/client.ml

··· 16 16 |> Err.get_ok ~msg:"Control_response.success: " 17 17 18 18 let error ~request_id ~code ~message ?data () = 19 19 - let error_detail = Sdk_control.Response.error_detail ~code ~message ?data () in 19 19 + let error_detail = 20 20 + Sdk_control.Response.error_detail ~code ~message ?data () 21 21 + in 20 22 let resp = Sdk_control.Response.error ~request_id ~error:error_detail () in 21 23 let ctrl = Sdk_control.create_response ~response:resp () in 22 24 Jsont.Json.encode Sdk_control.jsont ctrl ··· 81 83 (json_to_string input_json)); 82 84 (* Convert permission_suggestions to suggested rules *) 83 85 let suggestions = Option.value req.permission_suggestions ~default:[] in 84 84 - let suggested_rules = Permissions.extract_rules_from_proto_updates suggestions in 86 86 + let suggested_rules = 87 87 + Permissions.extract_rules_from_proto_updates suggestions 88 88 + in 85 89 86 90 (* Convert input to Tool_input.t *) 87 91 let input = Tool_input.of_json input_json in ··· 94 98 Log.info (fun m -> 95 99 m "Invoking permission callback for tool: %s" tool_name); 96 100 let callback = 97 97 - Option.value t.permission_callback 98 98 - ~default:Permissions.default_allow 101 101 + Option.value t.permission_callback ~default:Permissions.default_allow 99 102 in 100 103 let decision = callback context in 101 104 Log.info (fun m -> ··· 103 106 (if Permissions.Decision.is_allow decision then "ALLOW" else "DENY")); 104 107 105 108 (* Convert permission decision to proto result *) 106 106 - let proto_result = Permissions.Decision.to_proto_result ~original_input:input decision in 109 109 + let proto_result = 110 110 + Permissions.Decision.to_proto_result ~original_input:input decision 111 111 + in 107 112 108 113 (* Encode to JSON *) 109 114 let response_data = ··· 148 153 in 149 154 Log.err (fun m -> m "%s" error_msg); 150 155 Transport.send t.transport 151 151 - (Control_response.error ~request_id ~code:`Method_not_found ~message:error_msg ()) 156 156 + (Control_response.error ~request_id ~code:`Method_not_found 157 157 + ~message:error_msg ()) 152 158 | exn -> 153 159 let error_msg = 154 160 Printf.sprintf "Hook callback error: %s" (Printexc.to_string exn) 155 161 in 156 162 Log.err (fun m -> m "%s" error_msg); 157 163 Transport.send t.transport 158 158 - (Control_response.error ~request_id ~code:`Internal_error ~message:error_msg ())) 164 164 + (Control_response.error ~request_id ~code:`Internal_error 165 165 + ~message:error_msg ())) 159 166 | Sdk_control.Request.Mcp_message req -> ( 160 160 - (* Handle MCP request for in-process SDK servers *) 161 161 - let module J = Jsont.Json in 167 167 + let module 168 168 + (* Handle MCP request for in-process SDK servers *) 169 169 + J = 170 170 + Jsont.Json 171 171 + in 162 172 let server_name = req.server_name in 163 173 let message = req.message in 164 174 Log.info (fun m -> m "MCP request for server '%s'" server_name); 165 175 166 176 match Hashtbl.find_opt t.mcp_servers server_name with 167 177 | None -> 168 168 - let error_msg = Printf.sprintf "MCP server '%s' not found" server_name in 178 178 + let error_msg = 179 179 + Printf.sprintf "MCP server '%s' not found" server_name 180 180 + in 169 181 Log.err (fun m -> m "%s" error_msg); 170 182 (* Return JSONRPC error in mcp_response format *) 171 171 - let mcp_error = J.object' [ 172 172 - J.mem (J.name "jsonrpc") (J.string "2.0"); 173 173 - J.mem (J.name "id") (J.null ()); 174 174 - J.mem (J.name "error") (J.object' [ 175 175 - J.mem (J.name "code") (J.number (-32601.0)); 176 176 - J.mem (J.name "message") (J.string error_msg) 177 177 - ]) 178 178 - ] in 179 179 - let response_data = J.object' [J.mem (J.name "mcp_response") mcp_error] in 180 180 - let response = Control_response.success ~request_id ~response:(Some response_data) in 183 183 + let mcp_error = 184 184 + J.object' 185 185 + [ 186 186 + J.mem (J.name "jsonrpc") (J.string "2.0"); 187 187 + J.mem (J.name "id") (J.null ()); 188 188 + J.mem (J.name "error") 189 189 + (J.object' 190 190 + [ 191 191 + J.mem (J.name "code") (J.number (-32601.0)); 192 192 + J.mem (J.name "message") (J.string error_msg); 193 193 + ]); 194 194 + ] 195 195 + in 196 196 + let response_data = 197 197 + J.object' [ J.mem (J.name "mcp_response") mcp_error ] 198 198 + in 199 199 + let response = 200 200 + Control_response.success ~request_id ~response:(Some response_data) 201 201 + in 181 202 Transport.send t.transport response 182 203 | Some server -> 183 204 let mcp_response = Mcp_server.handle_json_message server message in 184 184 - Log.debug (fun m -> m "MCP response: %s" (json_to_string mcp_response)); 185 185 - let response_data = J.object' [J.mem (J.name "mcp_response") mcp_response] in 186 186 - let response = Control_response.success ~request_id ~response:(Some response_data) in 205 205 + Log.debug (fun m -> 206 206 + m "MCP response: %s" (json_to_string mcp_response)); 207 207 + let response_data = 208 208 + J.object' [ J.mem (J.name "mcp_response") mcp_response ] 209 209 + in 210 210 + let response = 211 211 + Control_response.success ~request_id ~response:(Some response_data) 212 212 + in 187 213 Transport.send t.transport response) 188 214 | _ -> 189 215 (* Other request types not handled here *) 190 216 let error_msg = "Unsupported control request type" in 191 217 Transport.send t.transport 192 192 - (Control_response.error ~request_id ~code:`Invalid_request ~message:error_msg ()) 218 218 + (Control_response.error ~request_id ~code:`Invalid_request 219 219 + ~message:error_msg ()) 193 220 194 221 let handle_control_response t control_resp = 195 222 let request_id = ··· 219 246 | Some line -> ( 220 247 (* Use unified Incoming codec for all message types *) 221 248 match Jsont_bytesrw.decode_string' Incoming.jsont line with 222 222 - | Ok incoming -> 223 223 - Seq.Cons (incoming, loop) 249 249 + | Ok incoming -> Seq.Cons (incoming, loop) 224 250 | Error err -> 225 251 Log.err (fun m -> 226 252 m "Failed to decode incoming message: %s\nLine: %s" ··· 262 288 ctrl_req.request_id); 263 289 handle_control_request t ctrl_req; 264 290 loop rest) 265 265 - 266 291 and emit_responses responses rest = 267 292 match responses with 268 293 | [] -> loop rest ··· 288 313 289 314 (* Setup MCP servers from options *) 290 315 let mcp_servers_ht = Hashtbl.create 16 in 291 291 - List.iter (fun (name, server) -> 292 292 - Log.info (fun m -> m "Registering MCP server: %s" name); 293 293 - Hashtbl.add mcp_servers_ht name server 294 294 - ) (Options.mcp_servers options); 316 316 + List.iter 317 317 + (fun (name, server) -> 318 318 + Log.info (fun m -> m "Registering MCP server: %s" name); 319 319 + Hashtbl.add mcp_servers_ht name server) 320 320 + (Options.mcp_servers options); 295 321 296 322 let t = 297 323 { ··· 331 357 incr next_callback_id; 332 358 Hashtbl.add hook_callbacks callback_id callback; 333 359 Log.debug (fun m -> 334 334 - m "Registered callback: %s for event: %s" 335 335 - callback_id event_name); 360 360 + m "Registered callback: %s for event: %s" callback_id 361 361 + event_name); 336 362 Hook_matcher_wire. 337 337 - { 338 338 - matcher = pattern; 339 339 - hook_callback_ids = [callback_id]; 340 340 - }) 363 363 + { matcher = pattern; hook_callback_ids = [ callback_id ] }) 341 364 matchers 342 365 in 343 366 (event_name, Hook_matcher_wire.encode matcher_wires)) ··· 373 396 let respond_to_tool t ~tool_use_id ~content ?(is_error = false) () = 374 397 (* Check for duplicate response - prevents API errors from multiple responses *) 375 398 if Hashtbl.mem t.responded_tool_ids tool_use_id then begin 376 376 - Log.warn (fun m -> m "Skipping duplicate tool response for tool_use_id: %s" tool_use_id) 377 377 - end else begin 399 399 + Log.warn (fun m -> 400 400 + m "Skipping duplicate tool response for tool_use_id: %s" tool_use_id) 401 401 + end 402 402 + else begin 378 403 Hashtbl.add t.responded_tool_ids tool_use_id (); 379 379 - let user_msg = Message.User.with_tool_result ~tool_use_id ~content ~is_error () in 404 404 + let user_msg = 405 405 + Message.User.with_tool_result ~tool_use_id ~content ~is_error () 406 406 + in 380 407 let msg = Message.User user_msg in 381 408 send_message t msg 382 409 end 383 410 384 411 let respond_to_tools t responses = 385 412 (* Filter out duplicates *) 386 386 - let new_responses = List.filter (fun (tool_use_id, _, _) -> 387 387 - if Hashtbl.mem t.responded_tool_ids tool_use_id then begin 388 388 - Log.warn (fun m -> m "Skipping duplicate tool response for tool_use_id: %s" tool_use_id); 389 389 - false 390 390 - end else begin 391 391 - Hashtbl.add t.responded_tool_ids tool_use_id (); 392 392 - true 393 393 - end 394 394 - ) responses in 413 413 + let new_responses = 414 414 + List.filter 415 415 + (fun (tool_use_id, _, _) -> 416 416 + if Hashtbl.mem t.responded_tool_ids tool_use_id then begin 417 417 + Log.warn (fun m -> 418 418 + m "Skipping duplicate tool response for tool_use_id: %s" 419 419 + tool_use_id); 420 420 + false 421 421 + end 422 422 + else begin 423 423 + Hashtbl.add t.responded_tool_ids tool_use_id (); 424 424 + true 425 425 + end) 426 426 + responses 427 427 + in 395 428 if new_responses <> [] then begin 396 429 let tool_results = 397 430 List.map ··· 405 438 send_message t msg 406 439 end 407 440 408 408 - let clear_tool_response_tracking t = 409 409 - Hashtbl.clear t.responded_tool_ids 410 410 - 441 441 + let clear_tool_response_tracking t = Hashtbl.clear t.responded_tool_ids 411 442 let receive t = fun () -> handle_messages t 412 443 413 444 let run t ~handler = ··· 416 447 let rec loop seq = 417 448 match seq () with 418 449 | Seq.Nil -> () 419 419 - | Seq.Cons (Response.Complete _ as resp, _) -> 450 450 + | Seq.Cons ((Response.Complete _ as resp), _) -> 420 451 Handler.dispatch handler resp 421 452 | Seq.Cons (resp, rest) -> 422 453 Handler.dispatch handler resp; ··· 506 537 match response with 507 538 | Sdk_control.Response.Success s -> s.response 508 539 | Sdk_control.Response.Error e -> 509 509 - raise (Failure (Printf.sprintf "Control request failed: [%d] %s" e.error.code e.error.message)) 540 540 + raise 541 541 + (Failure 542 542 + (Printf.sprintf "Control request failed: [%d] %s" e.error.code 543 543 + e.error.message)) 510 544 511 545 let set_permission_mode t mode = 512 546 let request_id = Printf.sprintf "set_perm_mode_%f" (Eio.Time.now t.clock) in

+34 -24

lib/client.mli

··· 36 36 {2 Message Flow} 37 37 38 38 1. Create a client with {!create} 2. Send messages with {!query} or 39 39 - {!Advanced.send_message} 3. Receive responses with {!receive} or {!receive_all} 4. 40 40 - Continue multi-turn conversations by sending more messages 5. Client 41 41 - automatically cleans up when the switch exits 39 39 + {!Advanced.send_message} 3. Receive responses with {!receive} or 40 40 + {!receive_all} 4. Continue multi-turn conversations by sending more messages 41 41 + 5. Client automatically cleans up when the switch exits 42 42 43 43 {2 Advanced Features} 44 44 ··· 81 81 {!Advanced.send_message} instead. *) 82 82 83 83 val respond_to_tool : 84 84 - t -> tool_use_id:string -> content:Jsont.json -> ?is_error:bool -> unit -> unit 84 84 + t -> 85 85 + tool_use_id:string -> 86 86 + content:Jsont.json -> 87 87 + ?is_error:bool -> 88 88 + unit -> 89 89 + unit 85 90 (** [respond_to_tool t ~tool_use_id ~content ?is_error ()] responds to a tool 86 91 use request. 87 92 ··· 90 95 prevents API errors from duplicate tool responses. 91 96 92 97 @param tool_use_id The ID from the {!Response.Tool_use.t} event 93 93 - @param content The result content (can be a string or array of content blocks) 98 98 + @param content 99 99 + The result content (can be a string or array of content blocks) 94 100 @param is_error Whether this is an error response (default: false) *) 95 101 96 102 val respond_to_tools : t -> (string * Jsont.json * bool option) list -> unit 97 103 (** [respond_to_tools t responses] responds to multiple tool use requests at 98 104 once. 99 105 100 100 - {b Duplicate protection:} Any [tool_use_id] that has already been 101 101 - responded to is filtered out with a warning log. 106 106 + {b Duplicate protection:} Any [tool_use_id] that has already been responded 107 107 + to is filtered out with a warning log. 102 108 103 103 - Each tuple is [(tool_use_id, content, is_error option)] where content 104 104 - can be a string or array of content blocks. 109 109 + Each tuple is [(tool_use_id, content, is_error option)] where content can be 110 110 + a string or array of content blocks. 105 111 106 112 Example: 107 113 {[ ··· 116 122 (** [clear_tool_response_tracking t] clears the internal tracking of which 117 123 tool_use_ids have been responded to. 118 124 119 119 - This is useful when starting a new conversation or turn where you want 120 120 - to allow responses to previously-seen tool IDs. Normally this is not 121 121 - needed as tool IDs are unique per conversation turn. *) 125 125 + This is useful when starting a new conversation or turn where you want to 126 126 + allow responses to previously-seen tool IDs. Normally this is not needed as 127 127 + tool IDs are unique per conversation turn. *) 122 128 123 129 (** {1 Response Handling} *) 124 130 ··· 130 136 131 137 Example: 132 138 {[ 133 133 - let my_handler = object 134 134 - inherit Claude.Handler.default 135 135 - method! on_text t = print_endline (Response.Text.content t) 136 136 - method! on_complete c = 137 137 - Printf.printf "Cost: $%.4f\n" 138 138 - (Option.value ~default:0.0 (Response.Complete.total_cost_usd c)) 139 139 - end in 139 139 + let my_handler = 140 140 + object 141 141 + inherit Claude.Handler.default 142 142 + method! on_text t = print_endline (Response.Text.content t) 143 143 + 144 144 + method! on_complete c = 145 145 + Printf.printf "Cost: $%.4f\n" 146 146 + (Option.value ~default:0.0 (Response.Complete.total_cost_usd c)) 147 147 + end 148 148 + in 140 149 Client.query client "Hello"; 141 150 Client.run client ~handler:my_handler 142 151 ]} *) ··· 293 302 val send_raw : t -> Sdk_control.t -> unit 294 303 (** [send_raw t control] sends a raw SDK control message. 295 304 296 296 - This is for advanced use cases that need direct control protocol access. *) 305 305 + This is for advanced use cases that need direct control protocol access. 306 306 + *) 297 307 298 308 val send_json : t -> Jsont.json -> unit 299 309 (** [send_json t json] sends raw JSON to Claude. ··· 305 315 306 316 This includes all message types before Response conversion: 307 317 - {!Proto.Incoming.t.constructor-Message} - Regular messages 308 308 - - {!Proto.Incoming.t.constructor-Control_response} - Control responses (normally handled 309 309 - internally) 310 310 - - {!Proto.Incoming.t.constructor-Control_request} - Control requests (normally handled 311 311 - internally) 318 318 + - {!Proto.Incoming.t.constructor-Control_response} - Control responses 319 319 + (normally handled internally) 320 320 + - {!Proto.Incoming.t.constructor-Control_request} - Control requests 321 321 + (normally handled internally) 312 322 313 323 Most users should use {!receive} or {!run} instead. *) 314 324 end

+5 -7

lib/content_block.ml

··· 20 20 21 21 let id = Proto.Content_block.Tool_use.id 22 22 let name = Proto.Content_block.Tool_use.name 23 23 - 24 24 - let input t = 25 25 - Proto.Content_block.Tool_use.input t |> Tool_input.of_json 26 26 - 23 23 + let input t = Proto.Content_block.Tool_use.input t |> Tool_input.of_json 27 24 let of_proto proto = proto 28 28 - 29 25 let to_proto t = t 30 26 end 31 27 ··· 67 63 | Proto.Content_block.Tool_use proto_tool_use -> 68 64 Tool_use (Tool_use.of_proto proto_tool_use) 69 65 | _ -> 70 70 - failwith "Internal error: Proto.Content_block.tool_use returned non-Tool_use" 66 66 + failwith 67 67 + "Internal error: Proto.Content_block.tool_use returned non-Tool_use" 71 68 72 69 let tool_result ~tool_use_id ?content ?is_error () = 73 70 let proto = ··· 78 75 Tool_result (Tool_result.of_proto proto_tool_result) 79 76 | _ -> 80 77 failwith 81 81 - "Internal error: Proto.Content_block.tool_result returned non-Tool_result" 78 78 + "Internal error: Proto.Content_block.tool_result returned \ 79 79 + non-Tool_result" 82 80 83 81 let thinking ~thinking ~signature = 84 82 let proto = Proto.Content_block.thinking ~thinking ~signature in

+5 -3

lib/err.ml

··· 31 31 Fmt.pf ppf "Control error (request_id=%s): %s" request_id message 32 32 33 33 let to_string err = Fmt.str "%a" pp err 34 34 - 35 34 let raise err = Stdlib.raise (E err) 36 35 37 36 (* Register exception printer for better error messages *) ··· 51 50 let permission_denied ~tool_name ~message = 52 51 raise (Permission_denied { tool_name; message }) 53 52 54 54 - let hook_error ~callback_id ~message = raise (Hook_error { callback_id; message }) 55 55 - let control_error ~request_id ~message = raise (Control_error { request_id; message }) 53 53 + let hook_error ~callback_id ~message = 54 54 + raise (Hook_error { callback_id; message }) 55 55 + 56 56 + let control_error ~request_id ~message = 57 57 + raise (Control_error { request_id; message }) 56 58 57 59 (** {1 Result Helpers} *) 58 60

+4 -2

lib/err.mli

··· 40 40 (** {1 Result Helpers} *) 41 41 42 42 val get_ok : msg:string -> ('a, string) result -> 'a 43 43 - (** [get_ok ~msg result] returns the Ok value or raises Protocol_error with msg prefix. *) 43 43 + (** [get_ok ~msg result] returns the Ok value or raises Protocol_error with msg 44 44 + prefix. *) 44 45 45 46 val get_ok' : msg:string -> ('a, string) result -> 'a 46 46 - (** [get_ok' ~msg result] returns the Ok value or raises Protocol_error with string error. *) 47 47 + (** [get_ok' ~msg result] returns the Ok value or raises Protocol_error with 48 48 + string error. *)

+9 -10

lib/handler.ml

··· 7 7 8 8 (** {1 Handler Interface} *) 9 9 10 10 - class type handler = 11 11 - object 12 12 - method on_text : Response.Text.t -> unit 13 13 - method on_tool_use : Response.Tool_use.t -> unit 14 14 - method on_tool_result : Content_block.Tool_result.t -> unit 15 15 - method on_thinking : Response.Thinking.t -> unit 16 16 - method on_init : Response.Init.t -> unit 17 17 - method on_error : Response.Error.t -> unit 18 18 - method on_complete : Response.Complete.t -> unit 19 19 - end 10 10 + class type handler = object 11 11 + method on_text : Response.Text.t -> unit 12 12 + method on_tool_use : Response.Tool_use.t -> unit 13 13 + method on_tool_result : Content_block.Tool_result.t -> unit 14 14 + method on_thinking : Response.Thinking.t -> unit 15 15 + method on_init : Response.Init.t -> unit 16 16 + method on_error : Response.Error.t -> unit 17 17 + method on_complete : Response.Complete.t -> unit 18 18 + end 20 19 21 20 (** {1 Concrete Implementations} *) 22 21

+49 -42

lib/handler.mli

··· 16 16 methods you care about: 17 17 18 18 {[ 19 19 - let my_handler = object 20 20 - inherit Claude.Handler.default 21 21 - method! on_text t = print_endline (Response.Text.content t) 22 22 - method! on_complete c = 23 23 - Printf.printf "Done! Cost: $%.4f\n" 24 24 - (Option.value ~default:0.0 (Response.Complete.total_cost_usd c)) 25 25 - end 19 19 + let my_handler = 20 20 + object 21 21 + inherit Claude.Handler.default 22 22 + method! on_text t = print_endline (Response.Text.content t) 23 23 + 24 24 + method! on_complete c = 25 25 + Printf.printf "Done! Cost: $%.4f\n" 26 26 + (Option.value ~default:0.0 (Response.Complete.total_cost_usd c)) 27 27 + end 26 28 ]} 27 29 28 30 For compile-time guarantees that all events are handled, inherit from ··· 43 45 44 46 (** {1 Handler Interface} *) 45 47 48 48 + (** The handler interface for processing response events. 49 49 + 50 50 + Each method corresponds to a variant of {!Response.t}. Handlers can be 51 51 + passed to {!Client.run} to process responses in an event-driven style. *) 46 52 class type handler = object 47 53 method on_text : Response.Text.t -> unit 48 54 (** [on_text t] is called when text content is received from the assistant. *) 49 55 50 56 method on_tool_use : Response.Tool_use.t -> unit 51 57 (** [on_tool_use t] is called when the assistant requests a tool invocation. 52 52 - The caller is responsible for responding with 53 53 - {!Client.respond_to_tool}. *) 58 58 + The caller is responsible for responding with {!Client.respond_to_tool}. 59 59 + *) 54 60 55 61 method on_tool_result : Content_block.Tool_result.t -> unit 56 56 - (** [on_tool_result t] is called when a tool result is observed in the 57 57 - message stream. This is typically an echo of what was sent to Claude. *) 62 62 + (** [on_tool_result t] is called when a tool result is observed in the message 63 63 + stream. This is typically an echo of what was sent to Claude. *) 58 64 59 65 method on_thinking : Response.Thinking.t -> unit 60 66 (** [on_thinking t] is called when internal reasoning content is received. *) ··· 71 77 (** [on_complete t] is called when the conversation completes. This provides 72 78 final metrics like duration, cost, and token usage. *) 73 79 end 74 74 - (** The handler interface for processing response events. 75 75 - 76 76 - Each method corresponds to a variant of {!Response.t}. Handlers can be 77 77 - passed to {!Client.run} to process responses in an event-driven style. *) 78 80 79 81 (** {1 Concrete Implementations} *) 80 82 ··· 85 87 methods you need: 86 88 87 89 {[ 88 88 - let handler = object 89 89 - inherit Claude.Handler.default 90 90 - method! on_text t = Printf.printf "Text: %s\n" (Response.Text.content t) 91 91 - end 90 90 + let handler = 91 91 + object 92 92 + inherit Claude.Handler.default 93 93 + 94 94 + method! on_text t = 95 95 + Printf.printf "Text: %s\n" (Response.Text.content t) 96 96 + end 92 97 ]} 93 98 94 99 Methods you don't override will simply be ignored, making this ideal for 95 100 prototyping and for cases where you only care about specific events. *) 96 101 102 102 + (** Abstract handler requiring all methods to be implemented. 103 103 + 104 104 + Use this when you want compile-time guarantees that all events are handled: 105 105 + 106 106 + {[ 107 107 + let handler = object 108 108 + inherit Claude.Handler.abstract 109 109 + method on_text t = (* required *) 110 110 + method on_tool_use t = (* required *) 111 111 + method on_tool_result t = (* required *) 112 112 + method on_thinking t = (* required *) 113 113 + method on_init t = (* required *) 114 114 + method on_error t = (* required *) 115 115 + method on_complete t = (* required *) 116 116 + end 117 117 + ]} 118 118 + 119 119 + The compiler will enforce that you implement all methods, ensuring no events 120 120 + are silently ignored. *) 97 121 class virtual abstract : object 98 122 method virtual on_text : Response.Text.t -> unit 99 123 (** [on_text t] must be implemented by subclasses. *) ··· 116 140 method virtual on_complete : Response.Complete.t -> unit 117 141 (** [on_complete t] must be implemented by subclasses. *) 118 142 end 119 119 - (** Abstract handler requiring all methods to be implemented. 120 120 - 121 121 - Use this when you want compile-time guarantees that all events are handled: 122 122 - 123 123 - {[ 124 124 - let handler = object 125 125 - inherit Claude.Handler.abstract 126 126 - method on_text t = (* required *) 127 127 - method on_tool_use t = (* required *) 128 128 - method on_tool_result t = (* required *) 129 129 - method on_thinking t = (* required *) 130 130 - method on_init t = (* required *) 131 131 - method on_error t = (* required *) 132 132 - method on_complete t = (* required *) 133 133 - end 134 134 - ]} 135 135 - 136 136 - The compiler will enforce that you implement all methods, ensuring no events 137 137 - are silently ignored. *) 138 143 139 144 (** {1 Dispatch Functions} *) 140 145 ··· 144 149 145 150 Example: 146 151 {[ 147 147 - let handler = object 148 148 - inherit Claude.Handler.default 149 149 - method! on_text t = print_endline (Response.Text.content t) 150 150 - end in 152 152 + let handler = 153 153 + object 154 154 + inherit Claude.Handler.default 155 155 + method! on_text t = print_endline (Response.Text.content t) 156 156 + end 157 157 + in 151 158 dispatch handler (Response.Text text_event) 152 159 ]} *) 153 160

+11 -19

lib/hooks.ml

··· 30 30 31 31 let deny ?reason () = { decision = Some Deny; reason; updated_input = None } 32 32 let ask ?reason () = { decision = Some Ask; reason; updated_input = None } 33 33 - 34 34 - let continue () = 35 35 - { decision = None; reason = None; updated_input = None } 33 33 + let continue () = { decision = None; reason = None; updated_input = None } 36 34 37 35 type callback = input -> output 38 36 ··· 52 50 let updated_input = 53 51 Option.map Tool_input.to_json output.updated_input 54 52 in 55 55 - Proto.Hooks.PreToolUse.Output.allow ?reason:output.reason 56 56 - ?updated_input () 53 53 + Proto.Hooks.PreToolUse.Output.allow ?reason:output.reason ?updated_input 54 54 + () 57 55 | Some Deny -> Proto.Hooks.PreToolUse.Output.deny ?reason:output.reason () 58 56 | Some Ask -> Proto.Hooks.PreToolUse.Output.ask ?reason:output.reason () 59 57 end ··· 127 125 let input_of_proto proto = 128 126 { 129 127 session_id = Proto.Hooks.UserPromptSubmit.Input.session_id proto; 130 130 - transcript_path = 131 131 - Proto.Hooks.UserPromptSubmit.Input.transcript_path proto; 128 128 + transcript_path = Proto.Hooks.UserPromptSubmit.Input.transcript_path proto; 132 129 prompt = Proto.Hooks.UserPromptSubmit.Input.prompt proto; 133 130 } 134 131 ··· 164 161 } 165 162 166 163 let output_to_proto output = 167 167 - if output.block then 168 168 - Proto.Hooks.Stop.Output.block ?reason:output.reason () 164 164 + if output.block then Proto.Hooks.Stop.Output.block ?reason:output.reason () 169 165 else Proto.Hooks.Stop.Output.continue () 170 166 end 171 167 ··· 191 187 192 188 module PreCompact = struct 193 189 type input = { session_id : string; transcript_path : string } 194 194 - 195 190 type callback = input -> unit 196 191 197 192 let input_of_proto proto = ··· 247 242 | PostToolUseHook (pattern, callback) -> 248 243 post_tool_use_hooks := (pattern, callback) :: !post_tool_use_hooks 249 244 | UserPromptSubmitHook callback -> 250 250 - user_prompt_submit_hooks := (None, callback) :: !user_prompt_submit_hooks 245 245 + user_prompt_submit_hooks := 246 246 + (None, callback) :: !user_prompt_submit_hooks 251 247 | StopHook callback -> stop_hooks := (None, callback) :: !stop_hooks 252 248 | SubagentStopHook callback -> 253 249 subagent_stop_hooks := (None, callback) :: !subagent_stop_hooks ··· 289 285 proto_output 290 286 with 291 287 | Ok json -> json 292 292 - | Error msg -> 293 293 - failwith ("PreToolUse output encoding: " ^ msg) 288 288 + | Error msg -> failwith ("PreToolUse output encoding: " ^ msg) 294 289 in 295 290 (* Return wire format result *) 296 291 Proto.Hooks.continue ~hook_specific_output () ··· 328 323 proto_output 329 324 with 330 325 | Ok json -> json 331 331 - | Error msg -> 332 332 - failwith ("PostToolUse output encoding: " ^ msg) 326 326 + | Error msg -> failwith ("PostToolUse output encoding: " ^ msg) 333 327 in 334 328 if typed_output.block then 335 329 Proto.Hooks.block ~hook_specific_output () ··· 396 390 match Jsont.Json.decode Proto.Hooks.Stop.Input.jsont json with 397 391 | Ok input -> input 398 392 | Error msg -> 399 399 - Log.err (fun m -> 400 400 - m "Stop: failed to decode input: %s" msg); 393 393 + Log.err (fun m -> m "Stop: failed to decode input: %s" msg); 401 394 raise (Invalid_argument ("Stop input: " ^ msg)) 402 395 in 403 396 let typed_input = Stop.input_of_proto proto_input in ··· 447 440 proto_output 448 441 with 449 442 | Ok json -> json 450 450 - | Error msg -> 451 451 - failwith ("SubagentStop output encoding: " ^ msg) 443 443 + | Error msg -> failwith ("SubagentStop output encoding: " ^ msg) 452 444 in 453 445 if typed_output.block then 454 446 Proto.Hooks.block ~hook_specific_output ()

+15 -23

lib/hooks.mli

··· 61 61 type decision = 62 62 | Allow 63 63 | Deny 64 64 - | Ask 65 65 - (** Permission decision for tool usage. *) 64 64 + | Ask (** Permission decision for tool usage. *) 66 65 67 66 type output = { 68 67 decision : decision option; ··· 112 111 transcript_path : string; 113 112 tool_name : string; 114 113 tool_input : Tool_input.t; 115 115 - tool_response : Jsont.json; (* Response varies by tool *) 114 114 + tool_response : Jsont.json; (* Response varies by tool *) 116 115 } 117 117 - (** Input provided to PostToolUse hooks. 118 118 - Note: [tool_response] remains as {!type:Jsont.json} since response schemas 119 119 - vary by tool. *) 116 116 + (** Input provided to PostToolUse hooks. Note: [tool_response] remains as 117 117 + {!type:Jsont.json} since response schemas vary by tool. *) 120 118 121 119 (** {2 Output} *) 122 120 ··· 133 131 (** [continue ?additional_context ()] creates a continue response. 134 132 @param additional_context Optional context to add to the transcript *) 135 133 136 136 - val block : 137 137 - ?reason:string -> ?additional_context:string -> unit -> output 134 134 + val block : ?reason:string -> ?additional_context:string -> unit -> output 138 135 (** [block ?reason ?additional_context ()] creates a block response. 139 136 @param reason Optional explanation for blocking 140 137 @param additional_context Optional context to add to the transcript *) ··· 210 207 211 208 (** {2 Output} *) 212 209 213 213 - type output = { 214 214 - block : bool; 215 215 - reason : string option; 216 216 - } 210 210 + type output = { block : bool; reason : string option } 217 211 (** Output from Stop hooks. *) 218 212 219 213 (** {2 Response Builders} *) ··· 278 272 module PreCompact : sig 279 273 (** {2 Input} *) 280 274 281 281 - type input = { 282 282 - session_id : string; 283 283 - transcript_path : string; 284 284 - } 275 275 + type input = { session_id : string; transcript_path : string } 285 276 (** Input provided to PreCompact hooks. *) 286 277 287 278 (** {2 Callback Type} *) 288 279 289 280 type callback = input -> unit 290 290 - (** Callback function type for PreCompact hooks. 291 291 - PreCompact hooks have no output - they are notification-only. *) 281 281 + (** Callback function type for PreCompact hooks. PreCompact hooks have no 282 282 + output - they are notification-only. *) 292 283 293 284 (** {2 Conversion Functions} *) 294 285 ··· 313 304 314 305 val on_pre_tool_use : ?pattern:string -> PreToolUse.callback -> t -> t 315 306 (** [on_pre_tool_use ?pattern callback config] adds a PreToolUse hook. 316 316 - @param pattern Optional regex pattern to match tool names (e.g., "Bash|Edit") 307 307 + @param pattern 308 308 + Optional regex pattern to match tool names (e.g., "Bash|Edit") 317 309 @param callback Function to invoke on matching events *) 318 310 319 311 val on_post_tool_use : ?pattern:string -> PostToolUse.callback -> t -> t ··· 341 333 342 334 val get_callbacks : 343 335 t -> 344 344 - (Proto.Hooks.event * (string option * (Jsont.json -> Proto.Hooks.result)) 345 345 - list) 336 336 + (Proto.Hooks.event 337 337 + * (string option * (Jsont.json -> Proto.Hooks.result)) list) 346 338 list 347 339 (** [get_callbacks config] returns hook configuration in format suitable for 348 340 registration with the CLI. ··· 353 345 - Invoke the user's typed callback 354 346 - Convert output back to wire format using output_to_proto 355 347 356 356 - This is an internal function used by {!Client} - you should not need to 357 357 - call it directly. *) 348 348 + This is an internal function used by {!Client} - you should not need to call 349 349 + it directly. *)

+67 -54

lib/mcp_server.ml

··· 24 24 (* JSONRPC helpers using Jsont.Json builders *) 25 25 26 26 let jsonrpc_success ~id result = 27 27 - J.object' [ 28 28 - J.mem (J.name "jsonrpc") (J.string "2.0"); 29 29 - J.mem (J.name "id") id; 30 30 - J.mem (J.name "result") result 31 31 - ] 27 27 + J.object' 28 28 + [ 29 29 + J.mem (J.name "jsonrpc") (J.string "2.0"); 30 30 + J.mem (J.name "id") id; 31 31 + J.mem (J.name "result") result; 32 32 + ] 32 33 33 34 let jsonrpc_error ~id ~code ~message = 34 34 - J.object' [ 35 35 - J.mem (J.name "jsonrpc") (J.string "2.0"); 36 36 - J.mem (J.name "id") id; 37 37 - J.mem (J.name "error") (J.object' [ 38 38 - J.mem (J.name "code") (J.number (Float.of_int code)); 39 39 - J.mem (J.name "message") (J.string message) 40 40 - ]) 41 41 - ] 35 35 + J.object' 36 36 + [ 37 37 + J.mem (J.name "jsonrpc") (J.string "2.0"); 38 38 + J.mem (J.name "id") id; 39 39 + J.mem (J.name "error") 40 40 + (J.object' 41 41 + [ 42 42 + J.mem (J.name "code") (J.number (Float.of_int code)); 43 43 + J.mem (J.name "message") (J.string message); 44 44 + ]); 45 45 + ] 42 46 43 47 (* Extract string from JSON *) 44 48 let get_string key (obj : Jsont.json) = ··· 62 66 let get_id (msg : Jsont.json) : Jsont.json = 63 67 match msg with 64 68 | Jsont.Object (mems, _) -> ( 65 65 - match J.find_mem "id" mems with 66 66 - | Some (_, id) -> id 67 67 - | None -> J.null ()) 69 69 + match J.find_mem "id" mems with Some (_, id) -> id | None -> J.null ()) 68 70 | _ -> J.null () 69 71 70 72 (* Handle initialize request *) 71 73 let handle_initialize t ~id = 72 72 - jsonrpc_success ~id (J.object' [ 73 73 - J.mem (J.name "protocolVersion") (J.string "2024-11-05"); 74 74 - J.mem (J.name "capabilities") (J.object' [ 75 75 - J.mem (J.name "tools") (J.object' []) 76 76 - ]); 77 77 - J.mem (J.name "serverInfo") (J.object' [ 78 78 - J.mem (J.name "name") (J.string t.name); 79 79 - J.mem (J.name "version") (J.string t.version) 80 80 - ]) 81 81 - ]) 74 74 + jsonrpc_success ~id 75 75 + (J.object' 76 76 + [ 77 77 + J.mem (J.name "protocolVersion") (J.string "2024-11-05"); 78 78 + J.mem (J.name "capabilities") 79 79 + (J.object' [ J.mem (J.name "tools") (J.object' []) ]); 80 80 + J.mem (J.name "serverInfo") 81 81 + (J.object' 82 82 + [ 83 83 + J.mem (J.name "name") (J.string t.name); 84 84 + J.mem (J.name "version") (J.string t.version); 85 85 + ]); 86 86 + ]) 82 87 83 88 (* Handle tools/list request *) 84 89 let handle_tools_list t ~id = 85 85 - let tools_json = List.map (fun tool -> 86 86 - J.object' [ 87 87 - J.mem (J.name "name") (J.string (Tool.name tool)); 88 88 - J.mem (J.name "description") (J.string (Tool.description tool)); 89 89 - J.mem (J.name "inputSchema") (Tool.input_schema tool) 90 90 - ] 91 91 - ) t.tools in 92 92 - jsonrpc_success ~id (J.object' [J.mem (J.name "tools") (J.list tools_json)]) 90 90 + let tools_json = 91 91 + List.map 92 92 + (fun tool -> 93 93 + J.object' 94 94 + [ 95 95 + J.mem (J.name "name") (J.string (Tool.name tool)); 96 96 + J.mem (J.name "description") (J.string (Tool.description tool)); 97 97 + J.mem (J.name "inputSchema") (Tool.input_schema tool); 98 98 + ]) 99 99 + t.tools 100 100 + in 101 101 + jsonrpc_success ~id (J.object' [ J.mem (J.name "tools") (J.list tools_json) ]) 93 102 94 103 (* Handle tools/call request *) 95 104 let handle_tools_call t ~id ~params = 96 105 match get_string "name" params with 97 97 - | None -> 98 98 - jsonrpc_error ~id ~code:(-32602) ~message:"Missing 'name' parameter" 99 99 - | Some tool_name -> 106 106 + | None -> jsonrpc_error ~id ~code:(-32602) ~message:"Missing 'name' parameter" 107 107 + | Some tool_name -> ( 100 108 match Hashtbl.find_opt t.tool_map tool_name with 101 109 | None -> 102 110 jsonrpc_error ~id ~code:(-32601) 103 111 ~message:(Printf.sprintf "Tool '%s' not found" tool_name) 104 104 - | Some tool -> 105 105 - let arguments = match get_object "arguments" params with 112 112 + | Some tool -> ( 113 113 + let arguments = 114 114 + match get_object "arguments" params with 106 115 | Some args -> args 107 116 | None -> J.object' [] 108 117 in 109 118 let input = Tool_input.of_json arguments in 110 119 match Tool.call tool input with 111 120 | Ok content -> 112 112 - jsonrpc_success ~id (J.object' [J.mem (J.name "content") content]) 121 121 + jsonrpc_success ~id 122 122 + (J.object' [ J.mem (J.name "content") content ]) 113 123 | Error msg -> 114 124 (* Return error as content with is_error flag *) 115 115 - jsonrpc_success ~id (J.object' [ 116 116 - J.mem (J.name "content") (J.list [J.object' [ 117 117 - J.mem (J.name "type") (J.string "text"); 118 118 - J.mem (J.name "text") (J.string msg) 119 119 - ]]); 120 120 - J.mem (J.name "isError") (J.bool true) 121 121 - ]) 125 125 + jsonrpc_success ~id 126 126 + (J.object' 127 127 + [ 128 128 + J.mem (J.name "content") 129 129 + (J.list 130 130 + [ 131 131 + J.object' 132 132 + [ 133 133 + J.mem (J.name "type") (J.string "text"); 134 134 + J.mem (J.name "text") (J.string msg); 135 135 + ]; 136 136 + ]); 137 137 + J.mem (J.name "isError") (J.bool true); 138 138 + ]))) 122 139 123 140 let handle_request t ~method_ ~params ~id = 124 141 match method_ with ··· 130 147 ~message:(Printf.sprintf "Method '%s' not found" method_) 131 148 132 149 let handle_json_message t (msg : Jsont.json) = 133 133 - let method_ = match get_string "method" msg with 134 134 - | Some m -> m 135 135 - | None -> "" 136 136 - in 137 137 - let params = match get_object "params" msg with 138 138 - | Some p -> p 139 139 - | None -> J.object' [] 150 150 + let method_ = match get_string "method" msg with Some m -> m | None -> "" in 151 151 + let params = 152 152 + match get_object "params" msg with Some p -> p | None -> J.object' [] 140 153 in 141 154 let id = get_id msg in 142 155 handle_request t ~method_ ~params ~id

+22 -30

lib/mcp_server.mli

··· 12 12 {2 Basic Usage} 13 13 14 14 {[ 15 15 - let greet = Tool.create 16 16 - ~name:"greet" 17 17 - ~description:"Greet a user" 18 18 - ~input_schema:(Tool.schema_object ["name", Tool.schema_string] ~required:["name"]) 19 19 - ~handler:(fun args -> 20 20 - match Tool_input.get_string args "name" with 21 21 - | Some name -> Ok (Tool.text_result (Printf.sprintf "Hello, %s!" name)) 22 22 - | None -> Error "Missing name") 15 15 + let greet = 16 16 + Tool.create ~name:"greet" ~description:"Greet a user" 17 17 + ~input_schema: 18 18 + (Tool.schema_object 19 19 + [ ("name", Tool.schema_string) ] 20 20 + ~required:[ "name" ]) 21 21 + ~handler:(fun args -> 22 22 + match Tool_input.get_string args "name" with 23 23 + | Some name -> 24 24 + Ok (Tool.text_result (Printf.sprintf "Hello, %s!" name)) 25 25 + | None -> Error "Missing name") 23 26 24 24 - let server = Mcp_server.create 25 25 - ~name:"my-tools" 26 26 - ~tools:[greet] 27 27 - () 27 27 + let server = Mcp_server.create ~name:"my-tools" ~tools:[ greet ] () 28 28 29 29 - let options = Options.default 29 29 + let options = 30 30 + Options.default 30 31 |> Options.with_mcp_server ~name:"tools" server 31 31 - |> Options.with_allowed_tools ["mcp__tools__greet"] 32 32 + |> Options.with_allowed_tools [ "mcp__tools__greet" ] 32 33 ]} 33 34 34 35 {2 Tool Naming} 35 36 36 36 - When you register an MCP server with name "foo" containing a tool "bar", 37 37 - the full tool name becomes [mcp__foo__bar]. This is how Claude CLI 38 38 - routes MCP tool calls. 37 37 + When you register an MCP server with name "foo" containing a tool "bar", the 38 38 + full tool name becomes [mcp__foo__bar]. This is how Claude CLI routes MCP 39 39 + tool calls. 39 40 40 41 {2 Protocol} 41 42 ··· 47 48 type t 48 49 (** Abstract type for MCP servers. *) 49 50 50 50 - val create : 51 51 - name:string -> 52 52 - ?version:string -> 53 53 - tools:Tool.t list -> 54 54 - unit -> 55 55 - t 51 51 + val create : name:string -> ?version:string -> tools:Tool.t list -> unit -> t 56 52 (** [create ~name ?version ~tools ()] creates an in-process MCP server. 57 53 58 54 @param name Server identifier. Used in tool naming: [mcp__<name>__<tool>]. ··· 71 67 (** {1 MCP Protocol Handling} *) 72 68 73 69 val handle_request : 74 74 - t -> 75 75 - method_:string -> 76 76 - params:Jsont.json -> 77 77 - id:Jsont.json -> 78 78 - Jsont.json 70 70 + t -> method_:string -> params:Jsont.json -> id:Jsont.json -> Jsont.json 79 71 (** [handle_request t ~method_ ~params ~id] handles an MCP JSONRPC request. 80 72 81 73 Returns a JSONRPC response object with the given [id]. ··· 90 82 val handle_json_message : t -> Jsont.json -> Jsont.json 91 83 (** [handle_json_message t msg] handles a complete JSONRPC message. 92 84 93 93 - Extracts method, params, and id from the message and delegates 94 94 - to {!handle_request}. *) 85 85 + Extracts method, params, and id from the message and delegates to 86 86 + {!handle_request}. *)

+20 -13

lib/message.ml

··· 11 11 type t = Proto.Message.User.t 12 12 13 13 let of_string s = Proto.Message.User.create_string s 14 14 - let of_blocks blocks = Proto.Message.User.create_blocks (List.map Content_block.to_proto blocks) 14 14 + 15 15 + let of_blocks blocks = 16 16 + Proto.Message.User.create_blocks (List.map Content_block.to_proto blocks) 15 17 16 18 let with_tool_result ~tool_use_id ~content ?is_error () = 17 17 - Proto.Message.User.create_with_tool_result ~tool_use_id ~content ?is_error () 19 19 + Proto.Message.User.create_with_tool_result ~tool_use_id ~content ?is_error 20 20 + () 18 21 19 22 let as_text t = 20 23 match Proto.Message.User.content t with ··· 40 43 41 44 module Assistant = struct 42 45 type error = Proto.Message.Assistant.error 46 46 + type t = Proto.Message.Assistant.t 43 47 44 44 - type t = Proto.Message.Assistant.t 48 48 + let content t = 49 49 + List.map Content_block.of_proto (Proto.Message.Assistant.content t) 45 50 46 46 - let content t = List.map Content_block.of_proto (Proto.Message.Assistant.content t) 47 51 let model t = Proto.Message.Assistant.model t 48 52 let error t = Proto.Message.Assistant.error t 49 53 ··· 65 69 (content t) 66 70 67 71 let has_tool_use t = 68 68 - List.exists (function Content_block.Tool_use _ -> true | _ -> false) (content t) 72 72 + List.exists 73 73 + (function Content_block.Tool_use _ -> true | _ -> false) 74 74 + (content t) 69 75 70 76 let combined_text t = String.concat "\n" (text_blocks t) 71 71 - 72 77 let of_proto proto = proto 73 78 let to_proto t = t 74 79 ··· 90 95 let model = Proto.Message.System.model 91 96 let cwd = Proto.Message.System.cwd 92 97 let error_message = Proto.Message.System.error_msg 93 93 - 94 98 let of_proto proto = proto 95 99 let to_proto t = t 96 100 ··· 110 114 let input_tokens = Proto.Message.Result.Usage.input_tokens 111 115 let output_tokens = Proto.Message.Result.Usage.output_tokens 112 116 let total_tokens = Proto.Message.Result.Usage.total_tokens 113 113 - let cache_creation_input_tokens = Proto.Message.Result.Usage.cache_creation_input_tokens 114 114 - let cache_read_input_tokens = Proto.Message.Result.Usage.cache_read_input_tokens 117 117 + 118 118 + let cache_creation_input_tokens = 119 119 + Proto.Message.Result.Usage.cache_creation_input_tokens 120 120 + 121 121 + let cache_read_input_tokens = 122 122 + Proto.Message.Result.Usage.cache_read_input_tokens 115 123 116 124 let of_proto proto = proto 117 125 end ··· 124 132 let num_turns = Proto.Message.Result.num_turns 125 133 let session_id = Proto.Message.Result.session_id 126 134 let total_cost_usd = Proto.Message.Result.total_cost_usd 127 127 - 128 135 let usage t = Option.map Usage.of_proto (Proto.Message.Result.usage t) 129 136 let result_text = Proto.Message.Result.result 130 137 let structured_output = Proto.Message.Result.structured_output 131 131 - 132 138 let of_proto proto = proto 133 139 let to_proto t = t 134 140 ··· 176 182 if text = "" then None else Some text 177 183 | _ -> None 178 184 179 179 - let extract_tool_uses = function Assistant a -> Assistant.tool_uses a | _ -> [] 185 185 + let extract_tool_uses = function 186 186 + | Assistant a -> Assistant.tool_uses a 187 187 + | _ -> [] 180 188 181 189 let get_session_id = function 182 190 | System s -> System.session_id s ··· 193 201 (* Convenience constructors *) 194 202 let user_string s = User (User.of_string s) 195 203 let user_blocks blocks = User (User.of_blocks blocks) 196 196 - 197 204 let pp fmt t = Jsont.pp_value Proto.Message.jsont () fmt (to_proto t) 198 205 let log_received t = Log.info (fun m -> m "← %a" pp t) 199 206 let log_sending t = Log.info (fun m -> m "→ %a" pp t)

+7 -4

lib/options.ml

··· 124 124 let with_settings path t = { t with settings = Some path } 125 125 let with_add_dirs dirs t = { t with add_dirs = dirs } 126 126 let with_extra_args args t = { t with extra_args = args } 127 127 - let with_debug_stderr sink t = { t with debug_stderr = Some (sink :> Eio.Flow.sink_ty Eio.Flow.sink) } 127 127 + 128 128 + let with_debug_stderr sink t = 129 129 + { t with debug_stderr = Some (sink :> Eio.Flow.sink_ty Eio.Flow.sink) } 130 130 + 128 131 let with_hooks hooks t = { t with hooks = Some hooks } 129 132 let with_max_budget_usd budget t = { t with max_budget_usd = Some budget } 130 133 let with_fallback_model model t = { t with fallback_model = Some model } 131 131 - 132 134 let with_no_settings t = { t with setting_sources = Some [] } 133 133 - 134 135 let with_max_buffer_size size t = { t with max_buffer_size = Some size } 135 136 let with_user user t = { t with user = Some user } 136 137 let with_output_format format t = { t with output_format = Some format } ··· 157 158 let base = Proto.Options.empty in 158 159 let base = Proto.Options.with_allowed_tools t.allowed_tools base in 159 160 let base = Proto.Options.with_disallowed_tools t.disallowed_tools base in 160 160 - let base = Proto.Options.with_max_thinking_tokens t.max_thinking_tokens base in 161 161 + let base = 162 162 + Proto.Options.with_max_thinking_tokens t.max_thinking_tokens base 163 163 + in 161 164 let base = 162 165 match t.system_prompt with 163 166 | None -> base

+2 -1

lib/options.mli

··· 279 279 module Advanced : sig 280 280 val to_wire : t -> Proto.Options.t 281 281 (** [to_wire t] converts to wire format (excludes Eio types and callbacks). 282 282 - This is used internally by the client to send options to the Claude CLI. *) 282 282 + This is used internally by the client to send options to the Claude CLI. 283 283 + *) 283 284 end

+9 -7

lib/permissions.ml

··· 54 54 } 55 55 56 56 let to_proto (t : t) : Proto.Permissions.Rule.t = 57 57 - Proto.Permissions.Rule.create ~tool_name:t.tool_name ?rule_content:t.rule_content 58 58 - () 57 57 + Proto.Permissions.Rule.create ~tool_name:t.tool_name 58 58 + ?rule_content:t.rule_content () 59 59 end 60 60 61 61 (** Permission decisions *) ··· 66 66 67 67 let allow ?updated_input () = Allow { updated_input } 68 68 let deny ~message ~interrupt = Deny { message; interrupt } 69 69 - 70 69 let is_allow = function Allow _ -> true | Deny _ -> false 71 70 let is_deny = function Allow _ -> false | Deny _ -> true 72 71 ··· 78 77 | Allow _ -> None 79 78 | Deny { message; _ } -> Some message 80 79 81 81 - let deny_interrupt = function Allow _ -> false | Deny { interrupt; _ } -> interrupt 80 80 + let deny_interrupt = function 81 81 + | Allow _ -> false 82 82 + | Deny { interrupt; _ } -> interrupt 82 83 83 84 let to_proto_result ~original_input (t : t) : Proto.Permissions.Result.t = 84 85 match t with ··· 86 87 let updated_input_json = 87 88 match updated_input with 88 89 | Some input -> Some (Tool_input.to_json input) 89 89 - | None -> Some (Tool_input.to_json original_input) (* Return original when not modified *) 90 90 + | None -> Some (Tool_input.to_json original_input) 91 91 + (* Return original when not modified *) 90 92 in 91 93 Proto.Permissions.Result.allow ?updated_input:updated_input_json () 92 94 | Deny { message; interrupt } -> 93 95 Proto.Permissions.Result.deny ~message ~interrupt () 94 96 end 95 97 96 96 - (** Permission context *) 97 98 type context = { 98 99 tool_name : string; 99 100 input : Tool_input.t; 100 101 suggested_rules : Rule.t list; 101 102 } 103 103 + (** Permission context *) 102 104 103 105 let extract_rules_from_proto_updates updates = 104 106 List.concat_map ··· 108 110 | None -> []) 109 111 updates 110 112 111 111 - (** Permission callback type *) 112 113 type callback = context -> Decision.t 114 114 + (** Permission callback type *) 113 115 114 116 (** Default callbacks *) 115 117 let default_allow _ctx = Decision.allow ()

+12 -7

lib/permissions.mli

··· 17 17 module Mode : sig 18 18 (** Permission modes control the overall behavior of the permission system. *) 19 19 20 20 + (** The type of permission modes. *) 20 21 type t = 21 22 | Default (** Standard permission mode with normal checks *) 22 23 | Accept_edits (** Automatically accept file edits *) 23 24 | Plan (** Planning mode with restricted execution *) 24 25 | Bypass_permissions (** Bypass all permission checks *) 25 25 - (** The type of permission modes. *) 26 26 27 27 val to_string : t -> string 28 28 (** [to_string t] converts a mode to its string representation. *) ··· 95 95 (** [deny_message t] returns the denial message if the decision is deny. *) 96 96 97 97 val deny_interrupt : t -> bool 98 98 - (** [deny_interrupt t] returns whether to interrupt if the decision is deny. *) 98 98 + (** [deny_interrupt t] returns whether to interrupt if the decision is deny. 99 99 + *) 99 100 100 100 - val to_proto_result : original_input:Tool_input.t -> t -> Proto.Permissions.Result.t 101 101 - (** [to_proto_result ~original_input t] converts to the protocol result representation. 102 102 - When the decision allows without modification, the original_input is returned. *) 101 101 + val to_proto_result : 102 102 + original_input:Tool_input.t -> t -> Proto.Permissions.Result.t 103 103 + (** [to_proto_result ~original_input t] converts to the protocol result 104 104 + representation. When the decision allows without modification, the 105 105 + original_input is returned. *) 103 106 end 104 107 105 108 (** {1 Permission Context} *) ··· 111 114 } 112 115 (** The context provided to permission callbacks. *) 113 116 114 114 - val extract_rules_from_proto_updates : Proto.Permissions.Update.t list -> Rule.t list 117 117 + val extract_rules_from_proto_updates : 118 118 + Proto.Permissions.Update.t list -> Rule.t list 115 119 (** [extract_rules_from_proto_updates updates] extracts rules from protocol 116 120 permission updates. Used internally to convert protocol suggestions into 117 121 context rules. *) ··· 136 140 (** {1 Logging} *) 137 141 138 142 val log_permission_check : tool_name:string -> decision:Decision.t -> unit 139 139 - (** [log_permission_check ~tool_name ~decision] logs a permission check result. *) 143 143 + (** [log_permission_check ~tool_name ~decision] logs a permission check result. 144 144 + *)

+6 -9

lib/response.ml

··· 33 33 let session_id = Message.System.session_id 34 34 let model = Message.System.model 35 35 let cwd = Message.System.cwd 36 36 - 37 37 - let of_system sys = 38 38 - if Message.System.is_init sys then Some sys else None 36 36 + let of_system sys = if Message.System.is_init sys then Some sys else None 39 37 end 40 38 41 39 module Error = struct ··· 56 54 | `Unknown -> "Unknown error") 57 55 58 56 let is_system_error = function System_error _ -> true | _ -> false 59 59 - 60 57 let is_assistant_error = function Assistant_error _ -> true | _ -> false 61 58 62 59 let of_system sys = ··· 102 99 (* Convert content blocks to response events *) 103 100 Message.Assistant.content msg 104 101 |> List.map (function 105 105 - | Content_block.Text text -> Text (Text.of_block text) 106 106 - | Content_block.Tool_use tool -> Tool_use (Tool_use.of_block tool) 107 107 - | Content_block.Tool_result result -> Tool_result result 108 108 - | Content_block.Thinking thinking -> 109 109 - Thinking (Thinking.of_block thinking))) 102 102 + | Content_block.Text text -> Text (Text.of_block text) 103 103 + | Content_block.Tool_use tool -> Tool_use (Tool_use.of_block tool) 104 104 + | Content_block.Tool_result result -> Tool_result result 105 105 + | Content_block.Thinking thinking -> 106 106 + Thinking (Thinking.of_block thinking))) 110 107 | Message.System sys -> ( 111 108 (* System messages can be Init or Error *) 112 109 match Init.of_system sys with

+6 -5

lib/response.mli

··· 134 134 135 135 (** {1 Response Event Union Type} *) 136 136 137 137 + (** The type of response events that can be received from Claude. *) 137 138 type t = 138 139 | Text of Text.t (** Text content from assistant *) 139 140 | Tool_use of Tool_use.t (** Tool invocation request *) 140 140 - | Tool_result of Content_block.Tool_result.t (** Tool result (pass-through) *) 141 141 + | Tool_result of Content_block.Tool_result.t 142 142 + (** Tool result (pass-through) *) 141 143 | Thinking of Thinking.t (** Internal reasoning *) 142 144 | Init of Init.t (** Session initialization *) 143 145 | Error of Error.t (** Error event *) 144 146 | Complete of Complete.t (** Session completion *) 145 145 - (** The type of response events that can be received from Claude. *) 146 147 147 148 (** {1 Conversion} *) 148 149 149 150 val of_message : Message.t -> t list 150 150 - (** [of_message msg] converts a message to response events. An assistant 151 151 - message may produce multiple events (one per content block). User messages 152 152 - produce empty lists since they are not responses. *) 151 151 + (** [of_message msg] converts a message to response events. An assistant message 152 152 + may produce multiple events (one per content block). User messages produce 153 153 + empty lists since they are not responses. *)

+5 -8

lib/sdk_control.ml

··· 128 128 |> Jsont.Object.mem "input" Jsont.json ~enc:(fun (r : permission) -> 129 129 r.input) 130 130 |> Jsont.Object.opt_mem "permission_suggestions" 131 131 - (Jsont.list Proto.Permissions.Update.jsont) ~enc:(fun (r : permission) -> 132 132 - r.permission_suggestions) 131 131 + (Jsont.list Proto.Permissions.Update.jsont) 132 132 + ~enc:(fun (r : permission) -> r.permission_suggestions) 133 133 |> Jsont.Object.opt_mem "blocked_path" Jsont.string 134 134 ~enc:(fun (r : permission) -> r.blocked_path) 135 135 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : permission) -> ··· 288 288 module Error_code = Proto.Control.Response.Error_code 289 289 290 290 (* Structured error similar to JSON-RPC *) 291 291 - type error_detail = { 292 292 - code : int; 293 293 - message : string; 294 294 - data : Jsont.json option; 295 295 - } 291 291 + type error_detail = { code : int; message : string; data : Jsont.json option } 296 292 297 293 let error_detail ~code ~message ?data () = 298 294 { code = Error_code.to_int code; message; data } ··· 348 344 Jsont.Object.map ~kind:"Error" make 349 345 |> Jsont.Object.mem "request_id" Jsont.string ~enc:(fun (r : error) -> 350 346 r.request_id) 351 351 - |> Jsont.Object.mem "error" error_detail_jsont ~enc:(fun (r : error) -> r.error) 347 347 + |> Jsont.Object.mem "error" error_detail_jsont ~enc:(fun (r : error) -> 348 348 + r.error) 352 349 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : error) -> 353 350 r.unknown) 354 351 |> Jsont.Object.finish

+13 -10

lib/sdk_control.mli

··· 183 183 module Response : sig 184 184 (** SDK control response types. *) 185 185 186 186 - (** Re-export Error_code from Proto for convenience. *) 187 186 module Error_code = Proto.Control.Response.Error_code 187 187 + (** Re-export Error_code from Proto for convenience. *) 188 188 189 189 - (** Structured error detail similar to JSON-RPC. 190 190 - 191 191 - This allows programmatic error handling with numeric error codes and 192 192 - optional structured data for additional context. *) 193 189 type error_detail = { 194 190 code : int; (** Error code for programmatic handling *) 195 191 message : string; (** Human-readable error message *) 196 192 data : Jsont.json option; (** Optional additional error data *) 197 193 } 194 194 + (** Structured error detail similar to JSON-RPC. 195 195 + 196 196 + This allows programmatic error handling with numeric error codes and 197 197 + optional structured data for additional context. *) 198 198 199 199 val error_detail : 200 200 - code:[< Error_code.t] -> message:string -> ?data:Jsont.json -> unit -> error_detail 200 200 + code:[< Error_code.t ] -> 201 201 + message:string -> 202 202 + ?data:Jsont.json -> 203 203 + unit -> 204 204 + error_detail 201 205 (** [error_detail ~code ~message ?data ()] creates a structured error detail 202 206 using typed error codes. 203 207 204 208 Example: 205 209 {[ 206 206 - error_detail 207 207 - ~code:`Method_not_found 208 208 - ~message:"Hook callback not found" 210 210 + error_detail ~code:`Method_not_found ~message:"Hook callback not found" 209 211 () 210 212 ]} *) 211 213 ··· 238 240 239 241 val error : 240 242 request_id:string -> error:error_detail -> ?unknown:Unknown.t -> unit -> t 241 241 - (** [error ~request_id ~error ?unknown] creates an error response with structured error detail. *) 243 243 + (** [error ~request_id ~error ?unknown] creates an error response with 244 244 + structured error detail. *) 242 245 243 246 val jsont : t Jsont.t 244 247 (** [jsont] is the jsont codec for responses. Use [Jsont.pp_value jsont ()]

-3

lib/server_info.ml

··· 16 16 let capabilities t = t.capabilities 17 17 let commands t = t.commands 18 18 let output_styles t = t.output_styles 19 19 - 20 19 let has_capability t cap = List.mem cap t.capabilities 21 21 - 22 20 let supports_hooks t = has_capability t "hooks" 23 23 - 24 21 let supports_structured_output t = has_capability t "structured-output" 25 22 26 23 let of_proto (proto : Proto.Control.Server_info.t) : t =

+2 -2

lib/server_info.mli

··· 36 36 (** [supports_hooks t] checks if the hooks capability is available. *) 37 37 38 38 val supports_structured_output : t -> bool 39 39 - (** [supports_structured_output t] checks if the structured output capability 40 40 - is available. *) 39 39 + (** [supports_structured_output t] checks if the structured output capability is 40 40 + available. *) 41 41 42 42 (** {1 Internal} *) 43 43

+4 -2

lib/structured_output.mli

··· 23 23 24 24 {2 Creating Output Formats} 25 25 26 26 - Use {!of_json_schema} to specify a JSON Schema as a {!type:Jsont.json} value: 26 26 + Use {!of_json_schema} to specify a JSON Schema as a {!type:Jsont.json} 27 27 + value: 27 28 {[ 28 29 let meta = Jsont.Meta.none in 29 30 let schema = Jsont.Object ([ ··· 122 123 val of_json_schema : Jsont.json -> t 123 124 (** [of_json_schema schema] creates an output format from a JSON Schema. 124 125 125 125 - The schema should be a valid JSON Schema Draft 7 as a {!type:Jsont.json} value. 126 126 + The schema should be a valid JSON Schema Draft 7 as a {!type:Jsont.json} 127 127 + value. 126 128 127 129 Example: 128 130 {[

+36 -28

lib/tool.ml

··· 23 23 (* Convenience constructors using Jsont.Json builders *) 24 24 25 25 let text_result s = 26 26 - J.list [ 27 27 - J.object' [ 28 28 - J.mem (J.name "type") (J.string "text"); 29 29 - J.mem (J.name "text") (J.string s) 26 26 + J.list 27 27 + [ 28 28 + J.object' 29 29 + [ 30 30 + J.mem (J.name "type") (J.string "text"); 31 31 + J.mem (J.name "text") (J.string s); 32 32 + ]; 30 33 ] 31 31 - ] 32 34 33 35 let error_result s = 34 34 - J.list [ 35 35 - J.object' [ 36 36 - J.mem (J.name "type") (J.string "text"); 37 37 - J.mem (J.name "text") (J.string s); 38 38 - J.mem (J.name "is_error") (J.bool true) 36 36 + J.list 37 37 + [ 38 38 + J.object' 39 39 + [ 40 40 + J.mem (J.name "type") (J.string "text"); 41 41 + J.mem (J.name "text") (J.string s); 42 42 + J.mem (J.name "is_error") (J.bool true); 43 43 + ]; 39 44 ] 40 40 - ] 41 45 42 46 (* Schema helpers *) 43 47 44 44 - let schema_string = J.object' [J.mem (J.name "type") (J.string "string")] 45 45 - let schema_int = J.object' [J.mem (J.name "type") (J.string "integer")] 46 46 - let schema_number = J.object' [J.mem (J.name "type") (J.string "number")] 47 47 - let schema_bool = J.object' [J.mem (J.name "type") (J.string "boolean")] 48 48 + let schema_string = J.object' [ J.mem (J.name "type") (J.string "string") ] 49 49 + let schema_int = J.object' [ J.mem (J.name "type") (J.string "integer") ] 50 50 + let schema_number = J.object' [ J.mem (J.name "type") (J.string "number") ] 51 51 + let schema_bool = J.object' [ J.mem (J.name "type") (J.string "boolean") ] 48 52 49 53 let schema_array item_schema = 50 50 - J.object' [ 51 51 - J.mem (J.name "type") (J.string "array"); 52 52 - J.mem (J.name "items") item_schema 53 53 - ] 54 54 + J.object' 55 55 + [ 56 56 + J.mem (J.name "type") (J.string "array"); 57 57 + J.mem (J.name "items") item_schema; 58 58 + ] 54 59 55 60 let schema_string_enum values = 56 56 - J.object' [ 57 57 - J.mem (J.name "type") (J.string "string"); 58 58 - J.mem (J.name "enum") (J.list (List.map J.string values)) 59 59 - ] 61 61 + J.object' 62 62 + [ 63 63 + J.mem (J.name "type") (J.string "string"); 64 64 + J.mem (J.name "enum") (J.list (List.map J.string values)); 65 65 + ] 60 66 61 67 let schema_object props ~required = 62 62 - J.object' [ 63 63 - J.mem (J.name "type") (J.string "object"); 64 64 - J.mem (J.name "properties") (J.object' (List.map (fun (k, v) -> J.mem (J.name k) v) props)); 65 65 - J.mem (J.name "required") (J.list (List.map J.string required)) 66 66 - ] 68 68 + J.object' 69 69 + [ 70 70 + J.mem (J.name "type") (J.string "object"); 71 71 + J.mem (J.name "properties") 72 72 + (J.object' (List.map (fun (k, v) -> J.mem (J.name k) v) props)); 73 73 + J.mem (J.name "required") (J.list (List.map J.string required)); 74 74 + ]

+42 -30

lib/tool.mli

··· 5 5 6 6 (** Custom tool definitions for MCP servers. 7 7 8 8 - Tools are functions that Claude can invoke. They run in-process within 9 9 - your OCaml application via the MCP (Model Context Protocol). 8 8 + Tools are functions that Claude can invoke. They run in-process within your 9 9 + OCaml application via the MCP (Model Context Protocol). 10 10 11 11 {2 Basic Usage} 12 12 13 13 {[ 14 14 - let greet = Tool.create 15 15 - ~name:"greet" 16 16 - ~description:"Greet a user by name" 17 17 - ~input_schema:(`O [ 18 18 - "type", `String "object"; 19 19 - "properties", `O [ 20 20 - "name", `O ["type", `String "string"] 21 21 - ]; 22 22 - "required", `A [`String "name"] 23 23 - ]) 24 24 - ~handler:(fun args -> 25 25 - match Tool_input.get_string args "name" with 26 26 - | Some name -> Ok (`A [`O ["type", `String "text"; 27 27 - "text", `String (Printf.sprintf "Hello, %s!" name)]]) 28 28 - | None -> Error "Missing 'name' parameter") 14 14 + let greet = 15 15 + Tool.create ~name:"greet" ~description:"Greet a user by name" 16 16 + ~input_schema: 17 17 + (`O 18 18 + [ 19 19 + ("type", `String "object"); 20 20 + ( "properties", 21 21 + `O [ ("name", `O [ ("type", `String "string") ]) ] ); 22 22 + ("required", `A [ `String "name" ]); 23 23 + ]) 24 24 + ~handler:(fun args -> 25 25 + match Tool_input.get_string args "name" with 26 26 + | Some name -> 27 27 + Ok 28 28 + (`A 29 29 + [ 30 30 + `O 31 31 + [ 32 32 + ("type", `String "text"); 33 33 + ("text", `String (Printf.sprintf "Hello, %s!" name)); 34 34 + ]; 35 35 + ]) 36 36 + | None -> Error "Missing 'name' parameter") 29 37 ]} 30 38 31 39 {2 Tool Response Format} ··· 36 44 37 45 Content blocks are typically: 38 46 {[ 39 39 - `A [`O ["type", `String "text"; "text", `String "result"]] 47 47 + `A [ `O [ ("type", `String "text"); ("text", `String "result") ] ] 40 48 ]} *) 41 49 42 50 type t ··· 50 58 t 51 59 (** [create ~name ~description ~input_schema ~handler] creates a custom tool. 52 60 53 53 - @param name Unique tool identifier. Claude uses this in function calls. 54 54 - When registered with an MCP server named "foo", the full tool name 55 55 - becomes [mcp__foo__<name>]. 56 56 - @param description Human-readable description. Helps Claude understand 57 57 - when to use the tool. 58 58 - @param input_schema JSON Schema defining input parameters. Should be 59 59 - a valid JSON Schema object with "type", "properties", etc. 60 60 - @param handler Function that executes the tool. Receives tool input, 61 61 - returns content array or error message. *) 61 61 + @param name 62 62 + Unique tool identifier. Claude uses this in function calls. When 63 63 + registered with an MCP server named "foo", the full tool name becomes 64 64 + [mcp__foo__<name>]. 65 65 + @param description 66 66 + Human-readable description. Helps Claude understand when to use the tool. 67 67 + @param input_schema 68 68 + JSON Schema defining input parameters. Should be a valid JSON Schema 69 69 + object with "type", "properties", etc. 70 70 + @param handler 71 71 + Function that executes the tool. Receives tool input, returns content 72 72 + array or error message. *) 62 73 63 74 val name : t -> string 64 75 (** [name t] returns the tool's name. *) ··· 87 98 88 99 Build JSON Schema objects more easily. *) 89 100 90 90 - val schema_object : (string * Jsont.json) list -> required:string list -> Jsont.json 101 101 + val schema_object : 102 102 + (string * Jsont.json) list -> required:string list -> Jsont.json 91 103 (** [schema_object props ~required] creates an object schema. 92 104 {[ 93 105 schema_object 94 94 - ["name", schema_string; "age", schema_int] 95 95 - ~required:["name"] 106 106 + [ ("name", schema_string); ("age", schema_int) ] 107 107 + ~required:[ "name" ] 96 108 ]} *) 97 109 98 110 val schema_string : Jsont.json

+5 -4

lib/tool_input.ml

··· 15 15 (** {1 Helper Functions} *) 16 16 17 17 (* Extract members from JSON object, or return empty list if not an object *) 18 18 - let get_members = function 19 19 - | Jsont.Object (members, _) -> members 20 20 - | _ -> [] 18 18 + let get_members = function Jsont.Object (members, _) -> members | _ -> [] 21 19 22 20 (* Find a member by key in the object *) 23 21 let find_member key members = ··· 87 85 List.map (fun ((name, _), _) -> name) members 88 86 89 87 let is_empty t = 90 90 - match t with Jsont.Object ([], _) -> true | Jsont.Object _ -> false | _ -> true 88 88 + match t with 89 89 + | Jsont.Object ([], _) -> true 90 90 + | Jsont.Object _ -> false 91 91 + | _ -> true 91 92 92 93 (** {1 Construction} *) 93 94

+6 -3

lib/tool_input.mli

··· 19 19 string. *) 20 20 21 21 val get_int : t -> string -> int option 22 22 - (** [get_int t key] returns the integer value for [key], if present and an int. *) 22 22 + (** [get_int t key] returns the integer value for [key], if present and an int. 23 23 + *) 23 24 24 25 val get_bool : t -> string -> bool option 25 25 - (** [get_bool t key] returns the boolean value for [key], if present and a bool. *) 26 26 + (** [get_bool t key] returns the boolean value for [key], if present and a bool. 27 27 + *) 26 28 27 29 val get_float : t -> string -> float option 28 28 - (** [get_float t key] returns the float value for [key], if present and a float. *) 30 30 + (** [get_float t key] returns the float value for [key], if present and a float. 31 31 + *) 29 32 30 33 val get_string_list : t -> string -> string list option 31 34 (** [get_string_list t key] returns the string list for [key], if present and a

+4 -5

lib/transport.ml

··· 140 140 let preserved = 141 141 List.filter_map 142 142 (fun var -> 143 143 - Option.map (fun value -> Printf.sprintf "%s=%s" var value) 143 143 + Option.map 144 144 + (fun value -> Printf.sprintf "%s=%s" var value) 144 145 (Sys.getenv_opt var)) 145 146 preserve_vars 146 147 in ··· 196 197 let max_size = 197 198 match Options.max_buffer_size options with 198 199 | Some size -> size 199 199 - | None -> 1_000_000 (* Default 1MB *) 200 200 + | None -> 100_000_000 (* Default 100MB *) 200 201 in 201 202 let stdout = 202 203 Eio.Buf_read.of_flow ~max_size (stdout_r :> Eio.Flow.source_ty r) ··· 239 240 Log.info (fun m -> m "Sending interrupt signal"); 240 241 (* Create interrupt request using Proto types *) 241 242 let request = Proto.Control.Request.interrupt () in 242 242 - let envelope = 243 243 - Proto.Control.create_request ~request_id:"" ~request () 244 244 - in 243 243 + let envelope = Proto.Control.create_request ~request_id:"" ~request () in 245 244 let outgoing = Proto.Outgoing.Control_request envelope in 246 245 let interrupt_msg = Proto.Outgoing.to_json outgoing in 247 246 send t interrupt_msg

+6 -1

proto/content_block.ml

··· 19 19 end 20 20 21 21 module Tool_use = struct 22 22 - type t = { id : string; name : string; input : Jsont.json; unknown : Unknown.t } 22 22 + type t = { 23 23 + id : string; 24 24 + name : string; 25 25 + input : Jsont.json; 26 26 + unknown : Unknown.t; 27 27 + } 23 28 24 29 let create ~id ~name ~input = { id; name; input; unknown = Unknown.empty } 25 30 let make id name input unknown = { id; name; input; unknown }

+2 -1

proto/content_block.mli

··· 82 82 (** [create ~tool_use_id ?content ?is_error ()] creates a new tool result 83 83 block. 84 84 @param tool_use_id The ID of the corresponding tool use block 85 85 - @param content Optional result content (can be string or array of content blocks) 85 85 + @param content 86 86 + Optional result content (can be string or array of content blocks) 86 87 @param is_error Whether the tool execution resulted in an error *) 87 88 88 89 val tool_use_id : t -> string

+85 -66

proto/control.ml

··· 68 68 Set_permission_mode { mode; unknown = Unknown.empty } 69 69 70 70 let hook_callback ~callback_id ~input ?tool_use_id () = 71 71 - Hook_callback 72 72 - { callback_id; input; tool_use_id; unknown = Unknown.empty } 71 71 + Hook_callback { callback_id; input; tool_use_id; unknown = Unknown.empty } 73 72 74 73 let mcp_message ~server_name ~message () = 75 74 Mcp_message { server_name; message; unknown = Unknown.empty } ··· 88 87 permission_r = 89 88 { tool_name; input; permission_suggestions; blocked_path; unknown } 90 89 in 91 91 - (Jsont.Object.map ~kind:"Permission" make 92 92 - |> Jsont.Object.mem "toolName" Jsont.string 93 93 - ~enc:(fun (r : permission_r) -> r.tool_name) 94 94 - |> Jsont.Object.mem "input" Jsont.json ~enc:(fun (r : permission_r) -> r.input) 90 90 + Jsont.Object.map ~kind:"Permission" make 91 91 + |> Jsont.Object.mem "toolName" Jsont.string ~enc:(fun (r : permission_r) -> 92 92 + r.tool_name) 93 93 + |> Jsont.Object.mem "input" Jsont.json ~enc:(fun (r : permission_r) -> 94 94 + r.input) 95 95 |> Jsont.Object.opt_mem "permissionSuggestions" 96 96 (Jsont.list Permissions.Update.jsont) ~enc:(fun (r : permission_r) -> 97 97 - r.permission_suggestions) 98 98 - |> Jsont.Object.opt_mem "blockedPath" Jsont.string ~enc:(fun (r : permission_r) -> 99 99 - r.blocked_path) 100 100 - |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : permission_r) -> r.unknown) 101 101 - |> Jsont.Object.finish) 97 97 + r.permission_suggestions) 98 98 + |> Jsont.Object.opt_mem "blockedPath" Jsont.string 99 99 + ~enc:(fun (r : permission_r) -> r.blocked_path) 100 100 + |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : permission_r) -> 101 101 + r.unknown) 102 102 + |> Jsont.Object.finish 102 103 103 104 let initialize_jsont : initialize_r Jsont.t = 104 105 (* The hooks field is an object with string keys and json values *) ··· 111 112 hooks_map_jsont 112 113 in 113 114 let make hooks unknown = { hooks; unknown } in 114 114 - (Jsont.Object.map ~kind:"Initialize" make 115 115 - |> Jsont.Object.opt_mem "hooks" hooks_jsont ~enc:(fun (r : initialize_r) -> r.hooks) 116 116 - |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : initialize_r) -> r.unknown) 117 117 - |> Jsont.Object.finish) 115 115 + Jsont.Object.map ~kind:"Initialize" make 116 116 + |> Jsont.Object.opt_mem "hooks" hooks_jsont ~enc:(fun (r : initialize_r) -> 117 117 + r.hooks) 118 118 + |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : initialize_r) -> 119 119 + r.unknown) 120 120 + |> Jsont.Object.finish 118 121 119 122 let set_permission_mode_jsont : set_permission_mode_r Jsont.t = 120 123 let make mode unknown = { mode; unknown } in 121 121 - (Jsont.Object.map ~kind:"SetPermissionMode" make 122 122 - |> Jsont.Object.mem "mode" Permissions.Mode.jsont ~enc:(fun (r : set_permission_mode_r) -> r.mode) 123 123 - |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : set_permission_mode_r) -> r.unknown) 124 124 - |> Jsont.Object.finish) 124 124 + Jsont.Object.map ~kind:"SetPermissionMode" make 125 125 + |> Jsont.Object.mem "mode" Permissions.Mode.jsont 126 126 + ~enc:(fun (r : set_permission_mode_r) -> r.mode) 127 127 + |> Jsont.Object.keep_unknown Unknown.mems 128 128 + ~enc:(fun (r : set_permission_mode_r) -> r.unknown) 129 129 + |> Jsont.Object.finish 125 130 126 131 let hook_callback_jsont : hook_callback_r Jsont.t = 127 132 let make callback_id input tool_use_id unknown = 128 133 { callback_id; input; tool_use_id; unknown } 129 134 in 130 130 - (Jsont.Object.map ~kind:"HookCallback" make 131 131 - |> Jsont.Object.mem "callbackId" Jsont.string ~enc:(fun (r : hook_callback_r) -> r.callback_id) 132 132 - |> Jsont.Object.mem "input" Jsont.json ~enc:(fun (r : hook_callback_r) -> r.input) 133 133 - |> Jsont.Object.opt_mem "toolUseId" Jsont.string ~enc:(fun (r : hook_callback_r) -> 134 134 - r.tool_use_id) 135 135 - |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : hook_callback_r) -> r.unknown) 136 136 - |> Jsont.Object.finish) 135 135 + Jsont.Object.map ~kind:"HookCallback" make 136 136 + |> Jsont.Object.mem "callbackId" Jsont.string 137 137 + ~enc:(fun (r : hook_callback_r) -> r.callback_id) 138 138 + |> Jsont.Object.mem "input" Jsont.json ~enc:(fun (r : hook_callback_r) -> 139 139 + r.input) 140 140 + |> Jsont.Object.opt_mem "toolUseId" Jsont.string 141 141 + ~enc:(fun (r : hook_callback_r) -> r.tool_use_id) 142 142 + |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : hook_callback_r) -> 143 143 + r.unknown) 144 144 + |> Jsont.Object.finish 137 145 138 146 let mcp_message_jsont : mcp_message_r Jsont.t = 139 147 let make server_name message unknown = { server_name; message; unknown } in 140 140 - (Jsont.Object.map ~kind:"McpMessage" make 141 141 - |> Jsont.Object.mem "serverName" Jsont.string ~enc:(fun (r : mcp_message_r) -> r.server_name) 142 142 - |> Jsont.Object.mem "message" Jsont.json ~enc:(fun (r : mcp_message_r) -> r.message) 143 143 - |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : mcp_message_r) -> r.unknown) 144 144 - |> Jsont.Object.finish) 148 148 + Jsont.Object.map ~kind:"McpMessage" make 149 149 + |> Jsont.Object.mem "serverName" Jsont.string 150 150 + ~enc:(fun (r : mcp_message_r) -> r.server_name) 151 151 + |> Jsont.Object.mem "message" Jsont.json ~enc:(fun (r : mcp_message_r) -> 152 152 + r.message) 153 153 + |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : mcp_message_r) -> 154 154 + r.unknown) 155 155 + |> Jsont.Object.finish 145 156 146 157 let set_model_jsont : set_model_r Jsont.t = 147 158 let make model unknown = { model; unknown } in 148 148 - (Jsont.Object.map ~kind:"SetModel" make 149 149 - |> Jsont.Object.mem "model" Jsont.string ~enc:(fun (r : set_model_r) -> r.model) 150 150 - |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : set_model_r) -> r.unknown) 151 151 - |> Jsont.Object.finish) 159 159 + Jsont.Object.map ~kind:"SetModel" make 160 160 + |> Jsont.Object.mem "model" Jsont.string ~enc:(fun (r : set_model_r) -> 161 161 + r.model) 162 162 + |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : set_model_r) -> 163 163 + r.unknown) 164 164 + |> Jsont.Object.finish 152 165 153 166 let get_server_info_jsont : unit Jsont.t = 154 154 - (Jsont.Object.map ~kind:"GetServerInfo" (fun _unknown -> ()) 167 167 + Jsont.Object.map ~kind:"GetServerInfo" (fun _unknown -> ()) 155 168 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun () -> Unknown.empty) 156 156 - |> Jsont.Object.finish) 169 169 + |> Jsont.Object.finish 157 170 158 171 (* Main variant codec using subtype discriminator *) 159 172 let jsont : t Jsont.t = ··· 225 238 module Response = struct 226 239 (* Standard JSON-RPC 2.0 error codes using polymorphic variants *) 227 240 module Error_code = struct 228 228 - type t = [ 229 229 - | `Parse_error 241 241 + type t = 242 242 + [ `Parse_error 230 243 | `Invalid_request 231 244 | `Method_not_found 232 245 | `Invalid_params 233 246 | `Internal_error 234 234 - | `Custom of int 235 235 - ] 247 247 + | `Custom of int ] 236 248 237 237 - let to_int : [< t] -> int = function 249 249 + let to_int : [< t ] -> int = function 238 250 | `Parse_error -> -32700 239 251 | `Invalid_request -> -32600 240 252 | `Method_not_found -> -32601 ··· 252 264 end 253 265 254 266 (* Structured error similar to JSON-RPC *) 255 255 - type error_detail = { 256 256 - code : int; 257 257 - message : string; 258 258 - data : Jsont.json option; 259 259 - } 267 267 + type error_detail = { code : int; message : string; data : Jsont.json option } 260 268 261 269 let error_detail ~code ~message ?data () = 262 270 { code = Error_code.to_int code; message; data } ··· 293 301 (* Individual record codecs *) 294 302 let success_jsont : success_r Jsont.t = 295 303 let make request_id response unknown = { request_id; response; unknown } in 296 296 - (Jsont.Object.map ~kind:"Success" make 297 297 - |> Jsont.Object.mem "requestId" Jsont.string ~enc:(fun (r : success_r) -> r.request_id) 298 298 - |> Jsont.Object.opt_mem "response" Jsont.json ~enc:(fun (r : success_r) -> r.response) 299 299 - |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : success_r) -> r.unknown) 300 300 - |> Jsont.Object.finish) 304 304 + Jsont.Object.map ~kind:"Success" make 305 305 + |> Jsont.Object.mem "requestId" Jsont.string ~enc:(fun (r : success_r) -> 306 306 + r.request_id) 307 307 + |> Jsont.Object.opt_mem "response" Jsont.json ~enc:(fun (r : success_r) -> 308 308 + r.response) 309 309 + |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : success_r) -> 310 310 + r.unknown) 311 311 + |> Jsont.Object.finish 301 312 302 313 let error_jsont : error_r Jsont.t = 303 314 let make request_id error unknown = { request_id; error; unknown } in 304 304 - (Jsont.Object.map ~kind:"Error" make 305 305 - |> Jsont.Object.mem "requestId" Jsont.string ~enc:(fun (r : error_r) -> r.request_id) 306 306 - |> Jsont.Object.mem "error" error_detail_jsont ~enc:(fun (r : error_r) -> r.error) 307 307 - |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : error_r) -> r.unknown) 308 308 - |> Jsont.Object.finish) 315 315 + Jsont.Object.map ~kind:"Error" make 316 316 + |> Jsont.Object.mem "requestId" Jsont.string ~enc:(fun (r : error_r) -> 317 317 + r.request_id) 318 318 + |> Jsont.Object.mem "error" error_detail_jsont ~enc:(fun (r : error_r) -> 319 319 + r.error) 320 320 + |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : error_r) -> 321 321 + r.unknown) 322 322 + |> Jsont.Object.finish 309 323 310 324 (* Main variant codec using subtype discriminator *) 311 325 let jsont : t Jsont.t = ··· 345 359 (* Envelope codecs *) 346 360 let request_envelope_jsont : request_envelope Jsont.t = 347 361 let make request_id request unknown = { request_id; request; unknown } in 348 348 - (Jsont.Object.map ~kind:"RequestEnvelope" make 349 349 - |> Jsont.Object.mem "requestId" Jsont.string ~enc:(fun (r : request_envelope) -> r.request_id) 350 350 - |> Jsont.Object.mem "request" Request.jsont ~enc:(fun (r : request_envelope) -> r.request) 351 351 - |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : request_envelope) -> r.unknown) 352 352 - |> Jsont.Object.finish) 362 362 + Jsont.Object.map ~kind:"RequestEnvelope" make 363 363 + |> Jsont.Object.mem "requestId" Jsont.string 364 364 + ~enc:(fun (r : request_envelope) -> r.request_id) 365 365 + |> Jsont.Object.mem "request" Request.jsont 366 366 + ~enc:(fun (r : request_envelope) -> r.request) 367 367 + |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : request_envelope) -> 368 368 + r.unknown) 369 369 + |> Jsont.Object.finish 353 370 354 371 let response_envelope_jsont : response_envelope Jsont.t = 355 372 let make response unknown = { response; unknown } in 356 356 - (Jsont.Object.map ~kind:"ResponseEnvelope" make 357 357 - |> Jsont.Object.mem "response" Response.jsont ~enc:(fun (r : response_envelope) -> r.response) 358 358 - |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : response_envelope) -> r.unknown) 359 359 - |> Jsont.Object.finish) 373 373 + Jsont.Object.map ~kind:"ResponseEnvelope" make 374 374 + |> Jsont.Object.mem "response" Response.jsont 375 375 + ~enc:(fun (r : response_envelope) -> r.response) 376 376 + |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : response_envelope) -> 377 377 + r.unknown) 378 378 + |> Jsont.Object.finish 360 379 361 380 (** Server information *) 362 381 module Server_info = struct

+30 -28

proto/control.mli

··· 62 62 | Mcp_message of mcp_message_r 63 63 | Set_model of set_model_r 64 64 | Get_server_info 65 65 - (** The type of SDK control requests. Wire format uses "subtype" field: 66 66 - "interrupt", "canUseTool", "initialize", "setPermissionMode", 67 67 - "hookCallback", "mcpMessage", "setModel", "getServerInfo". *) 65 65 + (** The type of SDK control requests. Wire format uses "subtype" field: 66 66 + "interrupt", "canUseTool", "initialize", "setPermissionMode", 67 67 + "hookCallback", "mcpMessage", "setModel", "getServerInfo". *) 68 68 69 69 val jsont : t Jsont.t 70 70 (** [jsont] is the Jsont codec for requests. *) ··· 90 90 *) 91 91 92 92 val hook_callback : 93 93 - callback_id:string -> 94 94 - input:Jsont.json -> 95 95 - ?tool_use_id:string -> 96 96 - unit -> 97 97 - t 93 93 + callback_id:string -> input:Jsont.json -> ?tool_use_id:string -> unit -> t 98 94 (** [hook_callback ~callback_id ~input ?tool_use_id ()] creates a hook 99 95 callback request. *) 100 96 ··· 117 113 118 114 These codes follow the JSON-RPC 2.0 specification for structured error 119 115 responses. Using the typed codes instead of raw integers improves code 120 120 - clarity and prevents typos. Polymorphic variants allow for easy extension. *) 116 116 + clarity and prevents typos. Polymorphic variants allow for easy extension. 117 117 + *) 121 118 module Error_code : sig 122 122 - type t = [ 123 123 - | `Parse_error (** -32700: Invalid JSON received *) 119 119 + type t = 120 120 + [ `Parse_error (** -32700: Invalid JSON received *) 124 121 | `Invalid_request (** -32600: The request object is invalid *) 125 122 | `Method_not_found (** -32601: The requested method does not exist *) 126 123 | `Invalid_params (** -32602: Invalid method parameters *) 127 124 | `Internal_error (** -32603: Internal server error *) 128 128 - | `Custom of int (** Application-specific error codes *) 129 129 - ] 125 125 + | `Custom of int (** Application-specific error codes *) ] 130 126 131 131 - val to_int : [< t] -> int 127 127 + val to_int : [< t ] -> int 132 128 (** [to_int t] converts an error code to its integer representation. *) 133 129 134 130 val of_int : int -> t 135 135 - (** [of_int n] converts an integer to an error code. 136 136 - Standard codes are mapped to their variants, others become [`Custom n]. *) 131 131 + (** [of_int n] converts an integer to an error code. Standard codes are 132 132 + mapped to their variants, others become [`Custom n]. *) 137 133 end 138 134 139 139 - (** Structured error detail similar to JSON-RPC. *) 140 135 type error_detail = { 141 136 code : int; (** Error code for programmatic handling *) 142 137 message : string; (** Human-readable error message *) 143 138 data : Jsont.json option; (** Optional additional error data *) 144 139 } 140 140 + (** Structured error detail similar to JSON-RPC. *) 145 141 146 142 val error_detail : 147 147 - code:[< Error_code.t] -> message:string -> ?data:Jsont.json -> unit -> error_detail 143 143 + code:[< Error_code.t ] -> 144 144 + message:string -> 145 145 + ?data:Jsont.json -> 146 146 + unit -> 147 147 + error_detail 148 148 (** [error_detail ~code ~message ?data ()] creates a structured error detail 149 149 using typed error codes. 150 150 151 151 Example: 152 152 {[ 153 153 - error_detail 154 154 - ~code:`Method_not_found 155 155 - ~message:"Hook callback not found" 153 153 + error_detail ~code:`Method_not_found ~message:"Hook callback not found" 156 154 () 157 155 ]} *) 158 156 ··· 171 169 unknown : Unknown.t; 172 170 } 173 171 174 174 - type t = Success of success_r | Error of error_r 175 175 - (** The type of SDK control responses. Wire format uses "subtype" field: 176 176 - "success", "error". *) 172 172 + type t = 173 173 + | Success of success_r 174 174 + | Error of error_r 175 175 + (** The type of SDK control responses. Wire format uses "subtype" field: 176 176 + "success", "error". *) 177 177 178 178 val jsont : t Jsont.t 179 179 (** [jsont] is the Jsont codec for responses. *) ··· 182 182 (** [success ~request_id ?response ()] creates a success response. *) 183 183 184 184 val error : request_id:string -> error:error_detail -> unit -> t 185 185 - (** [error ~request_id ~error ()] creates an error response with structured error detail. *) 185 185 + (** [error ~request_id ~error ()] creates an error response with structured 186 186 + error detail. *) 186 187 end 187 188 188 189 (** {1 Control Envelopes} *) ··· 203 204 val response_envelope_jsont : response_envelope Jsont.t 204 205 (** [response_envelope_jsont] is the Jsont codec for response envelopes. *) 205 206 206 206 - val create_request : request_id:string -> request:Request.t -> unit -> request_envelope 207 207 + val create_request : 208 208 + request_id:string -> request:Request.t -> unit -> request_envelope 207 209 (** [create_request ~request_id ~request ()] creates a control request envelope. 208 210 *) 209 211 ··· 228 230 output_styles:string list -> 229 231 unit -> 230 232 t 231 231 - (** [create ~version ~capabilities ~commands ~output_styles ()] creates 232 232 - server info. *) 233 233 + (** [create ~version ~capabilities ~commands ~output_styles ()] creates server 234 234 + info. *) 233 235 234 236 val version : t -> string 235 237 (** [version t] returns the server version. *)

+18 -15

proto/hooks.ml

··· 68 68 let decision_jsont : decision Jsont.t = 69 69 Jsont.enum [ ("continue", Continue); ("block", Block) ] 70 70 71 71 - (** Generic hook result *) 72 71 type result = { 73 72 decision : decision option; 74 73 system_message : string option; 75 74 hook_specific_output : Jsont.json option; 76 75 unknown : Unknown.t; 77 76 } 77 77 + (** Generic hook result *) 78 78 79 79 let result_jsont : result Jsont.t = 80 80 let make decision system_message hook_specific_output unknown = ··· 144 144 in 145 145 Jsont.Object.map ~kind:"PreToolUseOutput" make 146 146 |> Jsont.Object.mem "hookEventName" Jsont.string ~enc:(fun _ -> 147 147 - "PreToolUse") 147 147 + "PreToolUse") 148 148 |> Jsont.Object.opt_mem "permissionDecision" permission_decision_jsont 149 149 ~enc:(fun o -> o.permission_decision) 150 150 |> Jsont.Object.opt_mem "permissionDecisionReason" Jsont.string 151 151 ~enc:(fun o -> o.permission_decision_reason) 152 152 |> Jsont.Object.opt_mem "updatedInput" Jsont.json ~enc:(fun o -> 153 153 - o.updated_input) 153 153 + o.updated_input) 154 154 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun o -> o.unknown) 155 155 |> Jsont.Object.finish 156 156 ··· 243 243 in 244 244 Jsont.Object.map ~kind:"PostToolUseOutput" make 245 245 |> Jsont.Object.mem "hookEventName" Jsont.string ~enc:(fun _ -> 246 246 - "PostToolUse") 247 247 - |> Jsont.Object.opt_mem "decision" decision_jsont ~enc:(fun o -> o.decision) 246 246 + "PostToolUse") 247 247 + |> Jsont.Object.opt_mem "decision" decision_jsont ~enc:(fun o -> 248 248 + o.decision) 248 249 |> Jsont.Object.opt_mem "reason" Jsont.string ~enc:(fun o -> o.reason) 249 250 |> Jsont.Object.opt_mem "additionalContext" Jsont.string ~enc:(fun o -> 250 250 - o.additional_context) 251 251 + o.additional_context) 251 252 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun o -> o.unknown) 252 253 |> Jsont.Object.finish 253 254 ··· 310 311 in 311 312 Jsont.Object.map ~kind:"UserPromptSubmitOutput" make 312 313 |> Jsont.Object.mem "hookEventName" Jsont.string ~enc:(fun _ -> 313 313 - "UserPromptSubmit") 314 314 - |> Jsont.Object.opt_mem "decision" decision_jsont ~enc:(fun o -> o.decision) 314 314 + "UserPromptSubmit") 315 315 + |> Jsont.Object.opt_mem "decision" decision_jsont ~enc:(fun o -> 316 316 + o.decision) 315 317 |> Jsont.Object.opt_mem "reason" Jsont.string ~enc:(fun o -> o.reason) 316 318 |> Jsont.Object.opt_mem "additionalContext" Jsont.string ~enc:(fun o -> 317 317 - o.additional_context) 319 319 + o.additional_context) 318 320 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun o -> o.unknown) 319 321 |> Jsont.Object.finish 320 322 ··· 376 378 in 377 379 Jsont.Object.map ~kind:"StopOutput" make 378 380 |> Jsont.Object.mem "hookEventName" Jsont.string ~enc:(fun _ -> "Stop") 379 379 - |> Jsont.Object.opt_mem "decision" decision_jsont ~enc:(fun o -> o.decision) 381 381 + |> Jsont.Object.opt_mem "decision" decision_jsont ~enc:(fun o -> 382 382 + o.decision) 380 383 |> Jsont.Object.opt_mem "reason" Jsont.string ~enc:(fun o -> o.reason) 381 384 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun o -> o.unknown) 382 385 |> Jsont.Object.finish ··· 410 413 in 411 414 Jsont.Object.map ~kind:"SubagentStopOutput" make 412 415 |> Jsont.Object.mem "hookEventName" Jsont.string ~enc:(fun _ -> 413 413 - "SubagentStop") 416 416 + "SubagentStop") 414 417 |> Jsont.Object.opt_mem "decision" decision_jsont ~enc:(fun (o : t) -> 415 415 - o.Stop.Output.decision) 418 418 + o.Stop.Output.decision) 416 419 |> Jsont.Object.opt_mem "reason" Jsont.string ~enc:(fun (o : t) -> 417 417 - o.Stop.Output.reason) 420 420 + o.Stop.Output.reason) 418 421 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (o : t) -> 419 419 - o.Stop.Output.unknown) 422 422 + o.Stop.Output.unknown) 420 423 |> Jsont.Object.finish 421 424 422 425 let continue = Stop.Output.continue ··· 454 457 let jsont : t Jsont.t = 455 458 Jsont.Object.map ~kind:"PreCompactOutput" (fun _hook_event_name -> ()) 456 459 |> Jsont.Object.mem "hookEventName" Jsont.string ~enc:(fun () -> 457 457 - "PreCompact") 460 460 + "PreCompact") 458 461 |> Jsont.Object.finish 459 462 460 463 let continue () = ()

+12 -13

proto/hooks.mli

··· 17 17 - Helper functions for common responses 18 18 19 19 This is the wire format module - it does not include the callback system or 20 20 - Eio dependencies. For the full hooks system with callbacks, see the 21 21 - [Hooks] module in the [lib] directory. *) 20 20 + Eio dependencies. For the full hooks system with callbacks, see the [Hooks] 21 21 + module in the [lib] directory. *) 22 22 23 23 (** {1 Hook Events} *) 24 24 25 25 + (** Hook event types *) 25 26 type event = 26 27 | Pre_tool_use (** Fires before a tool is executed *) 27 28 | Post_tool_use (** Fires after a tool completes *) ··· 29 30 | Stop (** Fires when conversation stops *) 30 31 | Subagent_stop (** Fires when a subagent stops *) 31 32 | Pre_compact (** Fires before message compaction *) 32 32 - (** Hook event types *) 33 33 34 34 val event_to_string : event -> string 35 35 - (** [event_to_string event] converts an event to its wire format string. 36 36 - Wire format: "PreToolUse", "PostToolUse", "UserPromptSubmit", "Stop", 35 35 + (** [event_to_string event] converts an event to its wire format string. Wire 36 36 + format: "PreToolUse", "PostToolUse", "UserPromptSubmit", "Stop", 37 37 "SubagentStop", "PreCompact" *) 38 38 39 39 val event_of_string : string -> event ··· 67 67 68 68 (** {1 Decisions} *) 69 69 70 70 + (** Hook decision control *) 70 71 type decision = 71 72 | Continue (** Allow the action to proceed *) 72 73 | Block (** Block the action *) 73 73 - (** Hook decision control *) 74 74 75 75 val decision_jsont : decision Jsont.t 76 76 - (** [decision_jsont] is the Jsont codec for hook decisions. 77 77 - Wire format: "continue", "block" *) 76 76 + (** [decision_jsont] is the Jsont codec for hook decisions. Wire format: 77 77 + "continue", "block" *) 78 78 79 79 (** {1 Typed Hook Modules} *) 80 80 ··· 108 108 (** {2 Output} *) 109 109 110 110 type permission_decision = [ `Allow | `Deny | `Ask ] 111 111 - (** Permission decision for tool usage. 112 112 - Wire format: "allow", "deny", "ask" *) 111 111 + (** Permission decision for tool usage. Wire format: "allow", "deny", "ask" *) 113 112 114 113 val permission_decision_jsont : permission_decision Jsont.t 115 115 - (** [permission_decision_jsont] is the Jsont codec for permission decisions. *) 114 114 + (** [permission_decision_jsont] is the Jsont codec for permission decisions. 115 115 + *) 116 116 117 117 module Output : sig 118 118 type t ··· 121 121 val jsont : t Jsont.t 122 122 (** [jsont] is the Jsont codec for PreToolUse output. *) 123 123 124 124 - val allow : 125 125 - ?reason:string -> ?updated_input:Jsont.json -> unit -> t 124 124 + val allow : ?reason:string -> ?updated_input:Jsont.json -> unit -> t 126 125 (** [allow ?reason ?updated_input ()] creates an allow response. 127 126 @param reason Optional explanation for allowing 128 127 @param updated_input Optional modified tool input *)

+7 -8

proto/message.ml

··· 57 57 let content = decode_content json_content in 58 58 make content unknown) 59 59 |> Jsont.Object.mem "content" Jsont.json ~enc:(fun t -> 60 60 - encode_content (content t)) 60 60 + encode_content (content t)) 61 61 |> Jsont.Object.keep_unknown Unknown.mems ~enc:unknown 62 62 |> Jsont.Object.finish 63 63 ··· 68 68 let content = decode_content json_content in 69 69 { content; unknown = Unknown.empty }) 70 70 |> Jsont.Object.mem "content" Jsont.json ~enc:(fun t -> 71 71 - encode_content (content t)) 71 71 + encode_content (content t)) 72 72 |> Jsont.Object.finish 73 73 in 74 74 Jsont.Object.map ~kind:"UserEnvelope" Fun.id ··· 84 84 { content; unknown = Unknown.empty }) 85 85 |> Jsont.Object.mem "role" Jsont.string ~enc:(fun _ -> "user") 86 86 |> Jsont.Object.mem "content" Jsont.json ~enc:(fun t -> 87 87 - encode_content (content t)) 87 87 + encode_content (content t)) 88 88 |> Jsont.Object.finish 89 89 in 90 90 Jsont.Object.map ~kind:"UserOutgoingEnvelope" Fun.id ··· 176 176 in 177 177 Jsont.Object.map ~kind:"SystemInit" make 178 178 |> Jsont.Object.opt_mem "session_id" Jsont.string ~enc:(fun (r : init) -> 179 179 - r.session_id) 179 179 + r.session_id) 180 180 |> Jsont.Object.opt_mem "model" Jsont.string ~enc:(fun (r : init) -> 181 181 - r.model) 181 181 + r.model) 182 182 |> Jsont.Object.opt_mem "cwd" Jsont.string ~enc:(fun (r : init) -> r.cwd) 183 183 - |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : init) -> 184 184 - r.unknown) 183 183 + |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : init) -> r.unknown) 185 184 |> Jsont.Object.finish 186 185 187 186 let error_jsont : error Jsont.t = ··· 189 188 Jsont.Object.map ~kind:"SystemError" make 190 189 |> Jsont.Object.mem "error" Jsont.string ~enc:(fun (r : error) -> r.error) 191 190 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : error) -> 192 192 - r.unknown) 191 191 + r.unknown) 193 192 |> Jsont.Object.finish 194 193 195 194 (* Main codec using case_mem for "subtype" discriminator *)

+4 -3

proto/message.mli

··· 32 32 33 33 val outgoing_jsont : t Jsont.t 34 34 (** [outgoing_jsont] is the codec for encoding outgoing user messages to CLI. 35 35 - This produces the envelope format with "message" wrapper containing 36 36 - "role" and "content" fields. *) 35 35 + This produces the envelope format with "message" wrapper containing "role" 36 36 + and "content" fields. *) 37 37 38 38 val create_string : string -> t 39 39 (** [create_string s] creates a user message with simple text content. *) ··· 44 44 val create_with_tool_result : 45 45 tool_use_id:string -> content:Jsont.json -> ?is_error:bool -> unit -> t 46 46 (** [create_with_tool_result ~tool_use_id ~content ?is_error ()] creates a 47 47 - user message containing a tool result. Content can be a string or array. *) 47 47 + user message containing a tool result. Content can be a string or array. 48 48 + *) 48 49 49 50 val content : t -> content 50 51 (** [content t] returns the content of the user message. *)

+7 -3

proto/options.ml

··· 11 11 let setting_source_jsont : setting_source Jsont.t = 12 12 Jsont.enum [ ("user", User); ("project", Project); ("local", Local) ] 13 13 14 14 - (** Configuration type *) 15 14 type t = { 16 15 allowed_tools : string list; 17 16 disallowed_tools : string list; ··· 34 33 output_format : Structured_output.t option; 35 34 unknown : Unknown.t; 36 35 } 36 36 + (** Configuration type *) 37 37 38 38 let empty = 39 39 { ··· 61 61 62 62 (** Accessor functions *) 63 63 let allowed_tools t = t.allowed_tools 64 64 + 64 65 let disallowed_tools t = t.disallowed_tools 65 66 let max_thinking_tokens t = t.max_thinking_tokens 66 67 let system_prompt t = t.system_prompt ··· 83 84 84 85 (** Builder functions *) 85 86 let with_allowed_tools allowed_tools t = { t with allowed_tools } 87 87 + 86 88 let with_disallowed_tools disallowed_tools t = { t with disallowed_tools } 87 89 88 90 let with_max_thinking_tokens max_thinking_tokens t = ··· 133 135 let make allowed_tools disallowed_tools max_thinking_tokens system_prompt 134 136 append_system_prompt permission_mode model continue_conversation resume 135 137 max_turns permission_prompt_tool_name settings add_dirs max_budget_usd 136 136 - fallback_model setting_sources max_buffer_size user output_format unknown = 138 138 + fallback_model setting_sources max_buffer_size user output_format unknown 139 139 + = 137 140 { 138 141 allowed_tools; 139 142 disallowed_tools; ··· 178 181 |> mem "addDirs" (Jsont.list Jsont.string) ~enc:add_dirs ~dec_absent:[] 179 182 |> opt_mem "maxBudgetUsd" Jsont.number ~enc:max_budget_usd 180 183 |> opt_mem "fallbackModel" Model.jsont ~enc:fallback_model 181 181 - |> opt_mem "settingSources" (Jsont.list setting_source_jsont) 184 184 + |> opt_mem "settingSources" 185 185 + (Jsont.list setting_source_jsont) 182 186 ~enc:setting_sources 183 187 |> opt_mem "maxBufferSize" Jsont.int ~enc:max_buffer_size 184 188 |> opt_mem "user" Jsont.string ~enc:user

+4 -4

proto/options.mli

··· 14 14 15 15 (** {1 Setting Sources} *) 16 16 17 17 + (** The type of setting sources, indicating where configuration was loaded from. 18 18 + *) 17 19 type setting_source = 18 20 | User (** User-level settings *) 19 21 | Project (** Project-level settings *) 20 22 | Local (** Local directory settings *) 21 21 - (** The type of setting sources, indicating where configuration was loaded 22 22 - from. *) 23 23 24 24 (** {1 Configuration Type} *) 25 25 26 26 type t 27 27 (** The type of configuration options. 28 28 29 29 - This represents all configurable options for Claude interactions, encoded 30 30 - in JSON format. *) 29 29 + This represents all configurable options for Claude interactions, encoded in 30 30 + JSON format. *) 31 31 32 32 val jsont : t Jsont.t 33 33 (** [jsont] is the Jsont codec for configuration options.

+1 -2

proto/permissions.ml

··· 200 200 Jsont.Object.map ~kind:"AllowRecord" make 201 201 |> Jsont.Object.mem "updatedInput" (Jsont.option Jsont.json) 202 202 ~enc:(function 203 203 - | Allow { updated_input; _ } -> updated_input 204 204 - | _ -> None) 203 203 + | Allow { updated_input; _ } -> updated_input | _ -> None) 205 204 ~dec_absent:None 206 205 |> Jsont.Object.opt_mem "updatedPermissions" (Jsont.list Update.jsont) 207 206 ~enc:(function

+6 -6

proto/permissions.mli

··· 14 14 module Mode : sig 15 15 (** Permission modes control the overall behavior of the permission system. *) 16 16 17 17 + (** The type of permission modes. *) 17 18 type t = 18 19 | Default (** Standard permission mode with normal checks *) 19 20 | Accept_edits (** Automatically accept file edits *) 20 21 | Plan (** Planning mode with restricted execution *) 21 22 | Bypass_permissions (** Bypass all permission checks *) 22 22 - (** The type of permission modes. *) 23 23 24 24 val jsont : t Jsont.t 25 25 (** [jsont] is the Jsont codec for permission modes. Wire format uses ··· 38 38 module Behavior : sig 39 39 (** Behaviors determine how permission requests are handled. *) 40 40 41 41 + (** The type of permission behaviors. *) 41 42 type t = 42 43 | Allow (** Allow the operation *) 43 44 | Deny (** Deny the operation *) 44 45 | Ask (** Ask the user for permission *) 45 45 - (** The type of permission behaviors. *) 46 46 47 47 val jsont : t Jsont.t 48 48 (** [jsont] is the Jsont codec for permission behaviors. Wire format uses ··· 92 92 module Update : sig 93 93 (** Updates modify permission settings. *) 94 94 95 95 + (** The destination for permission updates. *) 95 96 type destination = 96 97 | User_settings (** Apply to user settings *) 97 98 | Project_settings (** Apply to project settings *) 98 99 | Local_settings (** Apply to local settings *) 99 100 | Session (** Apply to current session only *) 100 100 - (** The destination for permission updates. *) 101 101 102 102 + (** The type of permission update. *) 102 103 type update_type = 103 104 | Add_rules (** Add new rules *) 104 105 | Replace_rules (** Replace existing rules *) ··· 106 107 | Set_mode (** Set permission mode *) 107 108 | Add_directories (** Add allowed directories *) 108 109 | Remove_directories (** Remove allowed directories *) 109 109 - (** The type of permission update. *) 110 110 111 111 type t 112 112 (** The type of permission updates. *) ··· 200 200 interrupt : bool; (** Whether to interrupt execution *) 201 201 unknown : Unknown.t; (** Unknown fields *) 202 202 } 203 203 - (** The type of permission results. Wire format uses a discriminated union 204 204 - with "behavior" field set to "allow" or "deny". *) 203 203 + (** The type of permission results. Wire format uses a discriminated 204 204 + union with "behavior" field set to "allow" or "deny". *) 205 205 206 206 val jsont : t Jsont.t 207 207 (** [jsont] is the Jsont codec for permission results. Preserves unknown

+2 -1

proto/structured_output.mli

··· 23 23 val of_json_schema : Jsont.json -> t 24 24 (** [of_json_schema schema] creates an output format from a JSON Schema. 25 25 26 26 - The schema should be a valid JSON Schema Draft 7 as a {!type:Jsont.json} value. 26 26 + The schema should be a valid JSON Schema Draft 7 as a {!type:Jsont.json} 27 27 + value. 27 28 28 29 Example: 29 30 {[

+9 -7

proto/unknown.ml

··· 39 39 (** Mems codec for use with Jsont.Object.keep_unknown. 40 40 41 41 This provides a custom mems codec that converts between our (string * 42 42 - Jsont.json) list representation and the Jsont.mem list representation 43 43 - used by keep_unknown. *) 42 42 + Jsont.json) list representation and the Jsont.mem list representation used 43 43 + by keep_unknown. *) 44 44 let mems : (t, Jsont.json, Jsont.mem list) Jsont.Object.Mems.map = 45 45 let open Jsont in 46 46 (* The decoder builds up a mem list (the third type parameter) and ··· 53 53 in 54 54 let enc = 55 55 { 56 56 - Object.Mems.enc = (fun k fields acc -> 57 57 - List.fold_left 58 58 - (fun acc (name, json) -> k Meta.none name json acc) 59 59 - acc fields); 56 56 + Object.Mems.enc = 57 57 + (fun k fields acc -> 58 58 + List.fold_left 59 59 + (fun acc (name, json) -> k Meta.none name json acc) 60 60 + acc fields); 60 61 } 61 62 in 62 62 - Object.Mems.map ~kind:"Unknown" ~dec_empty ~dec_add ~dec_finish ~enc Jsont.json 63 63 + Object.Mems.map ~kind:"Unknown" ~dec_empty ~dec_add ~dec_finish ~enc 64 64 + Jsont.json

+8 -4

test/advanced_config_demo.ml

··· 28 28 let ci_cd_config () = 29 29 Options.default |> Options.with_no_settings (* Disable all settings loading *) 30 30 |> Options.with_max_budget_usd 0.50 (* 50 cent limit per run *) 31 31 - |> Options.with_fallback_model (Claude.Proto.Model.of_string "claude-haiku-4") (* Fast fallback *) 31 31 + |> Options.with_fallback_model (Claude.Proto.Model.of_string "claude-haiku-4") 32 32 + (* Fast fallback *) 32 33 |> Options.with_model (Claude.Proto.Model.of_string "claude-sonnet-4-5") 33 34 |> Options.with_permission_mode Permissions.Mode.Bypass_permissions 34 35 ··· 40 41 let production_config () = 41 42 Options.default 42 43 |> Options.with_model (Claude.Proto.Model.of_string "claude-sonnet-4-5") 43 43 - |> Options.with_fallback_model (Claude.Proto.Model.of_string "claude-sonnet-3-5") 44 44 + |> Options.with_fallback_model 45 45 + (Claude.Proto.Model.of_string "claude-sonnet-3-5") 44 46 |> Options.with_max_budget_usd 10.0 (* $10 limit *) 45 47 |> Options.with_max_buffer_size 5_000_000 (* 5MB buffer for large outputs *) 46 48 ··· 61 63 let test_config () = 62 64 Options.default |> Options.with_no_settings 63 65 |> Options.with_max_budget_usd 0.10 (* 10 cent limit per test *) 64 64 - |> Options.with_model (Claude.Proto.Model.of_string "claude-haiku-4") (* Fast, cheap model *) 66 66 + |> Options.with_model (Claude.Proto.Model.of_string "claude-haiku-4") 67 67 + (* Fast, cheap model *) 65 68 |> Options.with_permission_mode Permissions.Mode.Bypass_permissions 66 69 |> Options.with_max_buffer_size 1_000_000 (* 1MB buffer *) 67 70 ··· 101 104 Printf.printf "Response: %s\n" (Response.Text.content text) 102 105 | Response.Complete result -> 103 106 Printf.printf "\n=== Session Complete ===\n"; 104 104 - Printf.printf "Duration: %dms\n" (Response.Complete.duration_ms result); 107 107 + Printf.printf "Duration: %dms\n" 108 108 + (Response.Complete.duration_ms result); 105 109 (match Response.Complete.total_cost_usd result with 106 110 | Some cost -> Printf.printf "Cost: $%.4f\n" cost 107 111 | None -> ());

+7 -3

test/camel_jokes.ml

··· 26 26 m "%s thinking: %s" name (Claude.Response.Thinking.content t)) 27 27 | Claude.Response.Complete c -> 28 28 (if Claude.Response.Complete.total_cost_usd c <> None then 29 29 - let cost = Option.get (Claude.Response.Complete.total_cost_usd c) in 29 29 + let cost = 30 30 + Option.get (Claude.Response.Complete.total_cost_usd c) 31 31 + in 30 32 Log.info (fun m -> m "%s's joke cost: $%.6f" name cost)); 31 33 Log.debug (fun m -> 32 34 m "%s session: %s, duration: %dms" name 33 35 (Claude.Response.Complete.session_id c) 34 36 (Claude.Response.Complete.duration_ms c)) 35 37 | Claude.Response.Error e -> 36 36 - Log.err (fun m -> m "Error from %s: %s" name (Claude.Response.Error.message e)) 38 38 + Log.err (fun m -> 39 39 + m "Error from %s: %s" name (Claude.Response.Error.message e)) 37 40 | Claude.Response.Init _ -> 38 41 (* Init messages are already logged by the library *) 39 42 () ··· 51 54 in 52 55 53 56 let client = 54 54 - Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ~clock:env#clock () 57 57 + Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr 58 58 + ~clock:env#clock () 55 59 in 56 60 57 61 Claude.Client.query client prompt;

+5 -5

test/discovery_demo.ml

··· 23 23 String.sub content 0 100 ^ "..." 24 24 else content)) 25 25 | Claude.Response.Tool_use t -> 26 26 - Log.info (fun m -> 27 27 - m "Tool use: %s" (Claude.Response.Tool_use.name t)) 26 26 + Log.info (fun m -> m "Tool use: %s" (Claude.Response.Tool_use.name t)) 28 27 | Claude.Response.Error err -> 29 28 Log.err (fun m -> m "Error: %s" (Claude.Response.Error.message err)) 30 30 - | Claude.Response.Complete result -> 31 31 - (match Claude.Response.Complete.total_cost_usd result with 29 29 + | Claude.Response.Complete result -> ( 30 30 + match Claude.Response.Complete.total_cost_usd result with 32 31 | Some cost -> Log.info (fun m -> m "Cost: $%.6f" cost) 33 32 | None -> ()) 34 33 | _ -> ()) ··· 45 44 |> Claude.Options.with_model (Claude.Proto.Model.of_string "sonnet") 46 45 in 47 46 let client = 48 48 - Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ~clock:env#clock () 47 47 + Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr 48 48 + ~clock:env#clock () 49 49 in 50 50 Claude.Client.enable_permission_discovery client; 51 51

+1

test/dune

··· 4 4 (libraries jsont jsont.bytesrw)) 5 5 6 6 ; Consolidated unit test suite using alcotest 7 7 + 7 8 (test 8 9 (name test_claude) 9 10 (modules test_claude)

+10 -7

test/hooks_example.ml

··· 12 12 (* Example 1: Block dangerous bash commands *) 13 13 let block_dangerous_bash input = 14 14 if input.Claude.Hooks.PreToolUse.tool_name = "Bash" then 15 15 - match Claude.Tool_input.get_string input.Claude.Hooks.PreToolUse.tool_input "command" with 15 15 + match 16 16 + Claude.Tool_input.get_string input.Claude.Hooks.PreToolUse.tool_input 17 17 + "command" 18 18 + with 16 19 | Some command -> 17 20 if String.length command >= 6 && String.sub command 0 6 = "rm -rf" then begin 18 21 Log.app (fun m -> m "🚫 Blocked dangerous command: %s" command); ··· 25 28 26 29 (* Example 2: Log all tool usage *) 27 30 let log_tool_usage input = 28 28 - Log.app (fun m -> m "📝 Tool %s called" input.Claude.Hooks.PreToolUse.tool_name); 31 31 + Log.app (fun m -> 32 32 + m "📝 Tool %s called" input.Claude.Hooks.PreToolUse.tool_name); 29 33 Claude.Hooks.PreToolUse.continue () 30 34 31 35 let run_example ~sw ~env = ··· 46 50 in 47 51 48 52 let client = 49 49 - Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ~clock:env#clock () 53 53 + Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr 54 54 + ~clock:env#clock () 50 55 in 51 56 52 57 (* Test 1: Safe command (should work) *) ··· 61 66 let content = Claude.Response.Text.content text in 62 67 if String.length content > 0 then 63 68 Log.app (fun m -> m "Claude: %s" content) 64 64 - | Claude.Response.Complete _ -> 65 65 - Log.app (fun m -> m "✅ Test 1 complete\n") 69 69 + | Claude.Response.Complete _ -> Log.app (fun m -> m "✅ Test 1 complete\n") 66 70 | Claude.Response.Error err -> 67 71 Log.err (fun m -> m "❌ Error: %s" (Claude.Response.Error.message err)) 68 72 | _ -> ()) ··· 80 84 let content = Claude.Response.Text.content text in 81 85 if String.length content > 0 then 82 86 Log.app (fun m -> m "Claude: %s" content) 83 83 - | Claude.Response.Complete _ -> 84 84 - Log.app (fun m -> m "✅ Test 2 complete") 87 87 + | Claude.Response.Complete _ -> Log.app (fun m -> m "✅ Test 2 complete") 85 88 | Claude.Response.Error err -> 86 89 Log.err (fun m -> m "❌ Error: %s" (Claude.Response.Error.message err)) 87 90 | _ -> ())

+6 -3

test/permission_demo.ml

··· 46 46 47 47 (* Log the full input for debugging *) 48 48 let input_json = Claude.Tool_input.to_json input in 49 49 - Log.info (fun m -> m "Full input JSON: %s" (Test_json_utils.to_string input_json)); 49 49 + Log.info (fun m -> 50 50 + m "Full input JSON: %s" (Test_json_utils.to_string input_json)); 50 51 51 52 (* Show input details *) 52 53 (* Try to extract key information from the input *) ··· 80 81 | Some path -> Log.app (fun m -> m "Path: %s" path) 81 82 | None -> Log.app (fun m -> m "Path: (current directory)")) 82 83 | None -> ()) 83 83 - | _ -> Log.app (fun m -> m "Input: %s" (Test_json_utils.to_string input_json)) 84 84 + | _ -> 85 85 + Log.app (fun m -> m "Input: %s" (Test_json_utils.to_string input_json)) 84 86 with exn -> 85 87 Log.info (fun m -> 86 88 m "Failed to parse input details: %s" (Printexc.to_string exn))); ··· 159 161 in 160 162 161 163 let client = 162 162 - Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ~clock:env#clock () 164 164 + Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr 165 165 + ~clock:env#clock () 163 166 in 164 167 165 168 (* First prompt - Claude will need to request Read permission for ../lib *)

+12 -5

test/simple_permission_test.ml

··· 13 13 let auto_allow_callback ctx = 14 14 Log.app (fun m -> m "\n🔐 Permission callback invoked!"); 15 15 Log.app (fun m -> m " Tool: %s" ctx.Claude.Permissions.tool_name); 16 16 - Log.app (fun m -> m " Input: %s" (Test_json_utils.to_string (Claude.Tool_input.to_json ctx.Claude.Permissions.input))); 16 16 + Log.app (fun m -> 17 17 + m " Input: %s" 18 18 + (Test_json_utils.to_string 19 19 + (Claude.Tool_input.to_json ctx.Claude.Permissions.input))); 17 20 Log.app (fun m -> m " ✅ Auto-allowing"); 18 21 Claude.Permissions.Decision.allow () 19 22 ··· 30 33 31 34 Log.app (fun m -> m "Creating client with permission callback..."); 32 35 let client = 33 33 - Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ~clock:env#clock () 36 36 + Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr 37 37 + ~clock:env#clock () 34 38 in 35 39 36 40 (* Query that should trigger Write tool *) ··· 67 71 Log.app (fun m -> m "\n⚠️ Tool result error for %s:" tool_use_id); 68 72 match Claude.Content_block.Tool_result.content r with 69 73 | Some json -> 70 70 - let s = match Jsont_bytesrw.encode_string' Jsont.json json with 74 74 + let s = 75 75 + match Jsont_bytesrw.encode_string' Jsont.json json with 71 76 | Ok str -> str 72 77 | Error _ -> "<encoding error>" 73 78 in ··· 80 85 | Some cost -> Log.app (fun m -> m "💰 Cost: $%.6f" cost) 81 86 | None -> ()); 82 87 Log.app (fun m -> 83 83 - m "⏱️ Duration: %dms" (Claude.Response.Complete.duration_ms result)) 88 88 + m "⏱️ Duration: %dms" 89 89 + (Claude.Response.Complete.duration_ms result)) 84 90 | Claude.Response.Error err -> 85 85 - Log.err (fun m -> m "\n❌ Error: %s" (Claude.Response.Error.message err)) 91 91 + Log.err (fun m -> 92 92 + m "\n❌ Error: %s" (Claude.Response.Error.message err)) 86 93 | _ -> ()) 87 94 messages; 88 95

+3 -12

test/simulated_permissions.ml

··· 88 88 ~interrupt:false 89 89 | _ -> 90 90 Log.app (fun m -> m " → Denied (invalid response)"); 91 91 - Decision.deny ~message:"Invalid permission response" 92 92 - ~interrupt:false 91 91 + Decision.deny ~message:"Invalid permission response" ~interrupt:false 93 92 end 94 93 95 94 (* Demonstrate the permission system *) ··· 117 116 let tool_input = Claude.Tool_input.of_json input in 118 117 let ctx = 119 118 Claude.Permissions. 120 120 - { 121 121 - tool_name; 122 122 - input = tool_input; 123 123 - suggested_rules = []; 124 124 - } 119 119 + { tool_name; input = tool_input; suggested_rules = [] } 125 120 in 126 121 let decision = example_permission_callback ctx in 127 122 ··· 175 170 let tool_input = Claude.Tool_input.of_json input in 176 171 let ctx = 177 172 Claude.Permissions. 178 178 - { 179 179 - tool_name; 180 180 - input = tool_input; 181 181 - suggested_rules = []; 182 182 - } 173 173 + { tool_name; input = tool_input; suggested_rules = [] } 183 174 in 184 175 let _ = callback ctx in 185 176 ())

+8 -3

test/structured_output_demo.ml

··· 105 105 in 106 106 107 107 (* Create structured output format from the schema *) 108 108 - let output_format = Claude.Proto.Structured_output.of_json_schema analysis_schema in 108 108 + let output_format = 109 109 + Claude.Proto.Structured_output.of_json_schema analysis_schema 110 110 + in 109 111 110 112 (* Configure Claude with structured output *) 111 113 let options = ··· 148 150 Printf.printf " Using tool: %s\n" (C.Response.Tool_use.name tool) 149 151 | C.Response.Complete result -> ( 150 152 Printf.printf "\n=== Result ===\n"; 151 151 - Printf.printf "Duration: %dms\n" (C.Response.Complete.duration_ms result); 153 153 + Printf.printf "Duration: %dms\n" 154 154 + (C.Response.Complete.duration_ms result); 152 155 Printf.printf "Cost: $%.4f\n" 153 153 - (Option.value (C.Response.Complete.total_cost_usd result) ~default:0.0); 156 156 + (Option.value 157 157 + (C.Response.Complete.total_cost_usd result) 158 158 + ~default:0.0); 154 159 155 160 (* Extract and display structured output *) 156 161 match C.Response.Complete.structured_output result with

+3 -1

test/structured_output_simple.ml

··· 49 49 Meta.none ) 50 50 in 51 51 52 52 - let output_format = Claude.Proto.Structured_output.of_json_schema person_schema in 52 52 + let output_format = 53 53 + Claude.Proto.Structured_output.of_json_schema person_schema 54 54 + in 53 55 54 56 let options = 55 57 C.Options.default

+321 -221

test/test_claude.ml

··· 68 68 | Claude.Proto.Control.Response.Error e -> 69 69 Alcotest.(check string) "request_id" "test-req-2" e.request_id; 70 70 Alcotest.(check int) "error code" (-32603) e.error.code; 71 71 - Alcotest.(check string) "error message" "Something went wrong" e.error.message 71 71 + Alcotest.(check string) 72 72 + "error message" "Something went wrong" e.error.message 72 73 | Claude.Proto.Control.Response.Success _ -> 73 74 Alcotest.fail "Got success response instead of error") 74 75 | Ok _ -> Alcotest.fail "Wrong message type decoded" 75 76 | Error err -> Alcotest.fail (Jsont.Error.to_string err) 76 77 77 77 - let protocol_tests = [ 78 78 - Alcotest.test_case "decode user message" `Quick test_decode_user_message; 79 79 - Alcotest.test_case "decode assistant message" `Quick test_decode_assistant_message; 80 80 - Alcotest.test_case "decode system message" `Quick test_decode_system_message; 81 81 - Alcotest.test_case "decode control response success" `Quick test_decode_control_response_success; 82 82 - Alcotest.test_case "decode control response error" `Quick test_decode_control_response_error; 83 83 - ] 78 78 + let protocol_tests = 79 79 + [ 80 80 + Alcotest.test_case "decode user message" `Quick test_decode_user_message; 81 81 + Alcotest.test_case "decode assistant message" `Quick 82 82 + test_decode_assistant_message; 83 83 + Alcotest.test_case "decode system message" `Quick test_decode_system_message; 84 84 + Alcotest.test_case "decode control response success" `Quick 85 85 + test_decode_control_response_success; 86 86 + Alcotest.test_case "decode control response error" `Quick 87 87 + test_decode_control_response_error; 88 88 + ] 84 89 85 90 (* ============================================ 86 91 Tool Module Tests 87 92 ============================================ *) 88 93 89 89 - let json_testable = Alcotest.testable 90 90 - (fun fmt json -> 91 91 - match Jsont_bytesrw.encode_string' Jsont.json json with 92 92 - | Ok s -> Format.pp_print_string fmt s 93 93 - | Error e -> Format.pp_print_string fmt (Jsont.Error.to_string e)) 94 94 - (fun a b -> 95 95 - match Jsont_bytesrw.encode_string' Jsont.json a, Jsont_bytesrw.encode_string' Jsont.json b with 96 96 - | Ok sa, Ok sb -> String.equal sa sb 97 97 - | _ -> false) 94 94 + let json_testable = 95 95 + Alcotest.testable 96 96 + (fun fmt json -> 97 97 + match Jsont_bytesrw.encode_string' Jsont.json json with 98 98 + | Ok s -> Format.pp_print_string fmt s 99 99 + | Error e -> Format.pp_print_string fmt (Jsont.Error.to_string e)) 100 100 + (fun a b -> 101 101 + match 102 102 + ( Jsont_bytesrw.encode_string' Jsont.json a, 103 103 + Jsont_bytesrw.encode_string' Jsont.json b ) 104 104 + with 105 105 + | Ok sa, Ok sb -> String.equal sa sb 106 106 + | _ -> false) 98 107 99 108 let test_tool_schema_string () = 100 109 let schema = Claude.Tool.schema_string in 101 101 - let expected = J.object' [J.mem (J.name "type") (J.string "string")] in 110 110 + let expected = J.object' [ J.mem (J.name "type") (J.string "string") ] in 102 111 Alcotest.check json_testable "schema_string" expected schema 103 112 104 113 let test_tool_schema_int () = 105 114 let schema = Claude.Tool.schema_int in 106 106 - let expected = J.object' [J.mem (J.name "type") (J.string "integer")] in 115 115 + let expected = J.object' [ J.mem (J.name "type") (J.string "integer") ] in 107 116 Alcotest.check json_testable "schema_int" expected schema 108 117 109 118 let test_tool_schema_number () = 110 119 let schema = Claude.Tool.schema_number in 111 111 - let expected = J.object' [J.mem (J.name "type") (J.string "number")] in 120 120 + let expected = J.object' [ J.mem (J.name "type") (J.string "number") ] in 112 121 Alcotest.check json_testable "schema_number" expected schema 113 122 114 123 let test_tool_schema_bool () = 115 124 let schema = Claude.Tool.schema_bool in 116 116 - let expected = J.object' [J.mem (J.name "type") (J.string "boolean")] in 125 125 + let expected = J.object' [ J.mem (J.name "type") (J.string "boolean") ] in 117 126 Alcotest.check json_testable "schema_bool" expected schema 118 127 119 128 let test_tool_schema_array () = 120 129 let schema = Claude.Tool.schema_array Claude.Tool.schema_string in 121 121 - let expected = J.object' [ 122 122 - J.mem (J.name "type") (J.string "array"); 123 123 - J.mem (J.name "items") (J.object' [J.mem (J.name "type") (J.string "string")]) 124 124 - ] in 130 130 + let expected = 131 131 + J.object' 132 132 + [ 133 133 + J.mem (J.name "type") (J.string "array"); 134 134 + J.mem (J.name "items") 135 135 + (J.object' [ J.mem (J.name "type") (J.string "string") ]); 136 136 + ] 137 137 + in 125 138 Alcotest.check json_testable "schema_array" expected schema 126 139 127 140 let test_tool_schema_string_enum () = 128 128 - let schema = Claude.Tool.schema_string_enum ["foo"; "bar"; "baz"] in 129 129 - let expected = J.object' [ 130 130 - J.mem (J.name "type") (J.string "string"); 131 131 - J.mem (J.name "enum") (J.list [J.string "foo"; J.string "bar"; J.string "baz"]) 132 132 - ] in 141 141 + let schema = Claude.Tool.schema_string_enum [ "foo"; "bar"; "baz" ] in 142 142 + let expected = 143 143 + J.object' 144 144 + [ 145 145 + J.mem (J.name "type") (J.string "string"); 146 146 + J.mem (J.name "enum") 147 147 + (J.list [ J.string "foo"; J.string "bar"; J.string "baz" ]); 148 148 + ] 149 149 + in 133 150 Alcotest.check json_testable "schema_string_enum" expected schema 134 151 135 152 let test_tool_schema_object () = 136 136 - let schema = Claude.Tool.schema_object 137 137 - [("name", Claude.Tool.schema_string); ("age", Claude.Tool.schema_int)] 138 138 - ~required:["name"] 153 153 + let schema = 154 154 + Claude.Tool.schema_object 155 155 + [ ("name", Claude.Tool.schema_string); ("age", Claude.Tool.schema_int) ] 156 156 + ~required:[ "name" ] 139 157 in 140 140 - let expected = J.object' [ 141 141 - J.mem (J.name "type") (J.string "object"); 142 142 - J.mem (J.name "properties") (J.object' [ 143 143 - J.mem (J.name "name") (J.object' [J.mem (J.name "type") (J.string "string")]); 144 144 - J.mem (J.name "age") (J.object' [J.mem (J.name "type") (J.string "integer")]) 145 145 - ]); 146 146 - J.mem (J.name "required") (J.list [J.string "name"]) 147 147 - ] in 158 158 + let expected = 159 159 + J.object' 160 160 + [ 161 161 + J.mem (J.name "type") (J.string "object"); 162 162 + J.mem (J.name "properties") 163 163 + (J.object' 164 164 + [ 165 165 + J.mem (J.name "name") 166 166 + (J.object' [ J.mem (J.name "type") (J.string "string") ]); 167 167 + J.mem (J.name "age") 168 168 + (J.object' [ J.mem (J.name "type") (J.string "integer") ]); 169 169 + ]); 170 170 + J.mem (J.name "required") (J.list [ J.string "name" ]); 171 171 + ] 172 172 + in 148 173 Alcotest.check json_testable "schema_object" expected schema 149 174 150 175 let test_tool_text_result () = 151 176 let result = Claude.Tool.text_result "Hello, world!" in 152 152 - let expected = J.list [J.object' [ 153 153 - J.mem (J.name "type") (J.string "text"); 154 154 - J.mem (J.name "text") (J.string "Hello, world!") 155 155 - ]] in 177 177 + let expected = 178 178 + J.list 179 179 + [ 180 180 + J.object' 181 181 + [ 182 182 + J.mem (J.name "type") (J.string "text"); 183 183 + J.mem (J.name "text") (J.string "Hello, world!"); 184 184 + ]; 185 185 + ] 186 186 + in 156 187 Alcotest.check json_testable "text_result" expected result 157 188 158 189 let test_tool_error_result () = 159 190 let result = Claude.Tool.error_result "Something went wrong" in 160 160 - let expected = J.list [J.object' [ 161 161 - J.mem (J.name "type") (J.string "text"); 162 162 - J.mem (J.name "text") (J.string "Something went wrong"); 163 163 - J.mem (J.name "is_error") (J.bool true) 164 164 - ]] in 191 191 + let expected = 192 192 + J.list 193 193 + [ 194 194 + J.object' 195 195 + [ 196 196 + J.mem (J.name "type") (J.string "text"); 197 197 + J.mem (J.name "text") (J.string "Something went wrong"); 198 198 + J.mem (J.name "is_error") (J.bool true); 199 199 + ]; 200 200 + ] 201 201 + in 165 202 Alcotest.check json_testable "error_result" expected result 166 203 167 204 let test_tool_create_and_call () = 168 168 - let greet = Claude.Tool.create 169 169 - ~name:"greet" 170 170 - ~description:"Greet a user" 171 171 - ~input_schema:(Claude.Tool.schema_object 172 172 - [("name", Claude.Tool.schema_string)] 173 173 - ~required:["name"]) 174 174 - ~handler:(fun args -> 175 175 - match Claude.Tool_input.get_string args "name" with 176 176 - | Some name -> Ok (Claude.Tool.text_result ("Hello, " ^ name ^ "!")) 177 177 - | None -> Error "Missing name parameter") 205 205 + let greet = 206 206 + Claude.Tool.create ~name:"greet" ~description:"Greet a user" 207 207 + ~input_schema: 208 208 + (Claude.Tool.schema_object 209 209 + [ ("name", Claude.Tool.schema_string) ] 210 210 + ~required:[ "name" ]) 211 211 + ~handler:(fun args -> 212 212 + match Claude.Tool_input.get_string args "name" with 213 213 + | Some name -> Ok (Claude.Tool.text_result ("Hello, " ^ name ^ "!")) 214 214 + | None -> Error "Missing name parameter") 178 215 in 179 216 Alcotest.(check string) "tool name" "greet" (Claude.Tool.name greet); 180 180 - Alcotest.(check string) "tool description" "Greet a user" (Claude.Tool.description greet); 217 217 + Alcotest.(check string) 218 218 + "tool description" "Greet a user" 219 219 + (Claude.Tool.description greet); 181 220 182 221 (* Test successful call *) 183 183 - let input_json = J.object' [J.mem (J.name "name") (J.string "Alice")] in 222 222 + let input_json = J.object' [ J.mem (J.name "name") (J.string "Alice") ] in 184 223 let input = Claude.Tool_input.of_json input_json in 185 224 match Claude.Tool.call greet input with 186 225 | Ok result -> 187 226 let expected = Claude.Tool.text_result "Hello, Alice!" in 188 227 Alcotest.check json_testable "call result" expected result 189 189 - | Error msg -> 190 190 - Alcotest.fail msg 228 228 + | Error msg -> Alcotest.fail msg 191 229 192 230 let test_tool_call_error () = 193 193 - let tool = Claude.Tool.create 194 194 - ~name:"fail" 195 195 - ~description:"Always fails" 196 196 - ~input_schema:(Claude.Tool.schema_object [] ~required:[]) 197 197 - ~handler:(fun _ -> Error "Intentional failure") 231 231 + let tool = 232 232 + Claude.Tool.create ~name:"fail" ~description:"Always fails" 233 233 + ~input_schema:(Claude.Tool.schema_object [] ~required:[]) 234 234 + ~handler:(fun _ -> Error "Intentional failure") 198 235 in 199 236 let input = Claude.Tool_input.of_json (J.object' []) in 200 237 match Claude.Tool.call tool input with 201 238 | Ok _ -> Alcotest.fail "Expected error" 202 202 - | Error msg -> Alcotest.(check string) "error message" "Intentional failure" msg 239 239 + | Error msg -> 240 240 + Alcotest.(check string) "error message" "Intentional failure" msg 203 241 204 204 - let tool_tests = [ 205 205 - Alcotest.test_case "schema_string" `Quick test_tool_schema_string; 206 206 - Alcotest.test_case "schema_int" `Quick test_tool_schema_int; 207 207 - Alcotest.test_case "schema_number" `Quick test_tool_schema_number; 208 208 - Alcotest.test_case "schema_bool" `Quick test_tool_schema_bool; 209 209 - Alcotest.test_case "schema_array" `Quick test_tool_schema_array; 210 210 - Alcotest.test_case "schema_string_enum" `Quick test_tool_schema_string_enum; 211 211 - Alcotest.test_case "schema_object" `Quick test_tool_schema_object; 212 212 - Alcotest.test_case "text_result" `Quick test_tool_text_result; 213 213 - Alcotest.test_case "error_result" `Quick test_tool_error_result; 214 214 - Alcotest.test_case "create and call" `Quick test_tool_create_and_call; 215 215 - Alcotest.test_case "call error" `Quick test_tool_call_error; 216 216 - ] 242 242 + let tool_tests = 243 243 + [ 244 244 + Alcotest.test_case "schema_string" `Quick test_tool_schema_string; 245 245 + Alcotest.test_case "schema_int" `Quick test_tool_schema_int; 246 246 + Alcotest.test_case "schema_number" `Quick test_tool_schema_number; 247 247 + Alcotest.test_case "schema_bool" `Quick test_tool_schema_bool; 248 248 + Alcotest.test_case "schema_array" `Quick test_tool_schema_array; 249 249 + Alcotest.test_case "schema_string_enum" `Quick test_tool_schema_string_enum; 250 250 + Alcotest.test_case "schema_object" `Quick test_tool_schema_object; 251 251 + Alcotest.test_case "text_result" `Quick test_tool_text_result; 252 252 + Alcotest.test_case "error_result" `Quick test_tool_error_result; 253 253 + Alcotest.test_case "create and call" `Quick test_tool_create_and_call; 254 254 + Alcotest.test_case "call error" `Quick test_tool_call_error; 255 255 + ] 217 256 218 257 (* ============================================ 219 258 Mcp_server Module Tests 220 259 ============================================ *) 221 260 222 261 let test_mcp_server_create () = 223 223 - let tool = Claude.Tool.create 224 224 - ~name:"echo" 225 225 - ~description:"Echo input" 226 226 - ~input_schema:(Claude.Tool.schema_object [("text", Claude.Tool.schema_string)] ~required:["text"]) 227 227 - ~handler:(fun args -> 228 228 - match Claude.Tool_input.get_string args "text" with 229 229 - | Some text -> Ok (Claude.Tool.text_result text) 230 230 - | None -> Error "Missing text") 262 262 + let tool = 263 263 + Claude.Tool.create ~name:"echo" ~description:"Echo input" 264 264 + ~input_schema: 265 265 + (Claude.Tool.schema_object 266 266 + [ ("text", Claude.Tool.schema_string) ] 267 267 + ~required:[ "text" ]) 268 268 + ~handler:(fun args -> 269 269 + match Claude.Tool_input.get_string args "text" with 270 270 + | Some text -> Ok (Claude.Tool.text_result text) 271 271 + | None -> Error "Missing text") 231 272 in 232 232 - let server = Claude.Mcp_server.create ~name:"test-server" ~version:"2.0.0" ~tools:[tool] () in 233 233 - Alcotest.(check string) "server name" "test-server" (Claude.Mcp_server.name server); 234 234 - Alcotest.(check string) "server version" "2.0.0" (Claude.Mcp_server.version server); 235 235 - Alcotest.(check int) "tools count" 1 (List.length (Claude.Mcp_server.tools server)) 273 273 + let server = 274 274 + Claude.Mcp_server.create ~name:"test-server" ~version:"2.0.0" 275 275 + ~tools:[ tool ] () 276 276 + in 277 277 + Alcotest.(check string) 278 278 + "server name" "test-server" 279 279 + (Claude.Mcp_server.name server); 280 280 + Alcotest.(check string) 281 281 + "server version" "2.0.0" 282 282 + (Claude.Mcp_server.version server); 283 283 + Alcotest.(check int) 284 284 + "tools count" 1 285 285 + (List.length (Claude.Mcp_server.tools server)) 236 286 237 287 let test_mcp_server_initialize () = 238 288 let server = Claude.Mcp_server.create ~name:"init-test" ~tools:[] () in 239 239 - let request = J.object' [ 240 240 - J.mem (J.name "jsonrpc") (J.string "2.0"); 241 241 - J.mem (J.name "id") (J.number 1.0); 242 242 - J.mem (J.name "method") (J.string "initialize"); 243 243 - J.mem (J.name "params") (J.object' []) 244 244 - ] in 289 289 + let request = 290 290 + J.object' 291 291 + [ 292 292 + J.mem (J.name "jsonrpc") (J.string "2.0"); 293 293 + J.mem (J.name "id") (J.number 1.0); 294 294 + J.mem (J.name "method") (J.string "initialize"); 295 295 + J.mem (J.name "params") (J.object' []); 296 296 + ] 297 297 + in 245 298 let response = Claude.Mcp_server.handle_json_message server request in 246 299 (* Check it's a success response with serverInfo *) 247 300 match response with ··· 251 304 | _ -> Alcotest.fail "Expected object response" 252 305 253 306 let test_mcp_server_tools_list () = 254 254 - let tool = Claude.Tool.create 255 255 - ~name:"my_tool" 256 256 - ~description:"My test tool" 257 257 - ~input_schema:(Claude.Tool.schema_object [] ~required:[]) 258 258 - ~handler:(fun _ -> Ok (Claude.Tool.text_result "ok")) 307 307 + let tool = 308 308 + Claude.Tool.create ~name:"my_tool" ~description:"My test tool" 309 309 + ~input_schema:(Claude.Tool.schema_object [] ~required:[]) 310 310 + ~handler:(fun _ -> Ok (Claude.Tool.text_result "ok")) 259 311 in 260 260 - let server = Claude.Mcp_server.create ~name:"list-test" ~tools:[tool] () in 261 261 - let request = J.object' [ 262 262 - J.mem (J.name "jsonrpc") (J.string "2.0"); 263 263 - J.mem (J.name "id") (J.number 2.0); 264 264 - J.mem (J.name "method") (J.string "tools/list"); 265 265 - J.mem (J.name "params") (J.object' []) 266 266 - ] in 312 312 + let server = Claude.Mcp_server.create ~name:"list-test" ~tools:[ tool ] () in 313 313 + let request = 314 314 + J.object' 315 315 + [ 316 316 + J.mem (J.name "jsonrpc") (J.string "2.0"); 317 317 + J.mem (J.name "id") (J.number 2.0); 318 318 + J.mem (J.name "method") (J.string "tools/list"); 319 319 + J.mem (J.name "params") (J.object' []); 320 320 + ] 321 321 + in 267 322 let response = Claude.Mcp_server.handle_json_message server request in 268 323 match response with 269 324 | Jsont.Object (mems, _) -> ( ··· 277 332 | _ -> Alcotest.fail "Expected object response" 278 333 279 334 let test_mcp_server_tools_call () = 280 280 - let tool = Claude.Tool.create 281 281 - ~name:"uppercase" 282 282 - ~description:"Convert to uppercase" 283 283 - ~input_schema:(Claude.Tool.schema_object [("text", Claude.Tool.schema_string)] ~required:["text"]) 284 284 - ~handler:(fun args -> 285 285 - match Claude.Tool_input.get_string args "text" with 286 286 - | Some text -> Ok (Claude.Tool.text_result (String.uppercase_ascii text)) 287 287 - | None -> Error "Missing text") 335 335 + let tool = 336 336 + Claude.Tool.create ~name:"uppercase" ~description:"Convert to uppercase" 337 337 + ~input_schema: 338 338 + (Claude.Tool.schema_object 339 339 + [ ("text", Claude.Tool.schema_string) ] 340 340 + ~required:[ "text" ]) 341 341 + ~handler:(fun args -> 342 342 + match Claude.Tool_input.get_string args "text" with 343 343 + | Some text -> 344 344 + Ok (Claude.Tool.text_result (String.uppercase_ascii text)) 345 345 + | None -> Error "Missing text") 288 346 in 289 289 - let server = Claude.Mcp_server.create ~name:"call-test" ~tools:[tool] () in 290 290 - let request = J.object' [ 291 291 - J.mem (J.name "jsonrpc") (J.string "2.0"); 292 292 - J.mem (J.name "id") (J.number 3.0); 293 293 - J.mem (J.name "method") (J.string "tools/call"); 294 294 - J.mem (J.name "params") (J.object' [ 295 295 - J.mem (J.name "name") (J.string "uppercase"); 296 296 - J.mem (J.name "arguments") (J.object' [ 297 297 - J.mem (J.name "text") (J.string "hello") 298 298 - ]) 299 299 - ]) 300 300 - ] in 347 347 + let server = Claude.Mcp_server.create ~name:"call-test" ~tools:[ tool ] () in 348 348 + let request = 349 349 + J.object' 350 350 + [ 351 351 + J.mem (J.name "jsonrpc") (J.string "2.0"); 352 352 + J.mem (J.name "id") (J.number 3.0); 353 353 + J.mem (J.name "method") (J.string "tools/call"); 354 354 + J.mem (J.name "params") 355 355 + (J.object' 356 356 + [ 357 357 + J.mem (J.name "name") (J.string "uppercase"); 358 358 + J.mem (J.name "arguments") 359 359 + (J.object' [ J.mem (J.name "text") (J.string "hello") ]); 360 360 + ]); 361 361 + ] 362 362 + in 301 363 let response = Claude.Mcp_server.handle_json_message server request in 302 364 (* Verify it contains the expected uppercase result *) 303 303 - let response_str = match Jsont_bytesrw.encode_string' Jsont.json response with 304 304 - | Ok s -> s | Error _ -> "" 365 365 + let response_str = 366 366 + match Jsont_bytesrw.encode_string' Jsont.json response with 367 367 + | Ok s -> s 368 368 + | Error _ -> "" 305 369 in 306 370 (* Simple substring check for HELLO in response *) 307 371 let contains_hello = ··· 309 373 if i + 5 > String.length response_str then false 310 374 else if String.sub response_str i 5 = "HELLO" then true 311 375 else check (i + 1) 312 312 - in check 0 376 376 + in 377 377 + check 0 313 378 in 314 379 Alcotest.(check bool) "contains HELLO" true contains_hello 315 380 316 381 let test_mcp_server_tool_not_found () = 317 382 let server = Claude.Mcp_server.create ~name:"notfound-test" ~tools:[] () in 318 318 - let request = J.object' [ 319 319 - J.mem (J.name "jsonrpc") (J.string "2.0"); 320 320 - J.mem (J.name "id") (J.number 4.0); 321 321 - J.mem (J.name "method") (J.string "tools/call"); 322 322 - J.mem (J.name "params") (J.object' [ 323 323 - J.mem (J.name "name") (J.string "nonexistent") 324 324 - ]) 325 325 - ] in 383 383 + let request = 384 384 + J.object' 385 385 + [ 386 386 + J.mem (J.name "jsonrpc") (J.string "2.0"); 387 387 + J.mem (J.name "id") (J.number 4.0); 388 388 + J.mem (J.name "method") (J.string "tools/call"); 389 389 + J.mem (J.name "params") 390 390 + (J.object' [ J.mem (J.name "name") (J.string "nonexistent") ]); 391 391 + ] 392 392 + in 326 393 let response = Claude.Mcp_server.handle_json_message server request in 327 394 (* Should return an error response *) 328 395 match response with ··· 332 399 | _ -> Alcotest.fail "Expected object response" 333 400 334 401 let test_mcp_server_method_not_found () = 335 335 - let server = Claude.Mcp_server.create ~name:"method-notfound-test" ~tools:[] () in 336 336 - let request = J.object' [ 337 337 - J.mem (J.name "jsonrpc") (J.string "2.0"); 338 338 - J.mem (J.name "id") (J.number 5.0); 339 339 - J.mem (J.name "method") (J.string "unknown/method"); 340 340 - J.mem (J.name "params") (J.object' []) 341 341 - ] in 402 402 + let server = 403 403 + Claude.Mcp_server.create ~name:"method-notfound-test" ~tools:[] () 404 404 + in 405 405 + let request = 406 406 + J.object' 407 407 + [ 408 408 + J.mem (J.name "jsonrpc") (J.string "2.0"); 409 409 + J.mem (J.name "id") (J.number 5.0); 410 410 + J.mem (J.name "method") (J.string "unknown/method"); 411 411 + J.mem (J.name "params") (J.object' []); 412 412 + ] 413 413 + in 342 414 let response = Claude.Mcp_server.handle_json_message server request in 343 415 match response with 344 416 | Jsont.Object (mems, _) -> ··· 346 418 Alcotest.(check bool) "has error" true has_error 347 419 | _ -> Alcotest.fail "Expected object response" 348 420 349 349 - let mcp_server_tests = [ 350 350 - Alcotest.test_case "create server" `Quick test_mcp_server_create; 351 351 - Alcotest.test_case "initialize" `Quick test_mcp_server_initialize; 352 352 - Alcotest.test_case "tools/list" `Quick test_mcp_server_tools_list; 353 353 - Alcotest.test_case "tools/call" `Quick test_mcp_server_tools_call; 354 354 - Alcotest.test_case "tool not found" `Quick test_mcp_server_tool_not_found; 355 355 - Alcotest.test_case "method not found" `Quick test_mcp_server_method_not_found; 356 356 - ] 421 421 + let mcp_server_tests = 422 422 + [ 423 423 + Alcotest.test_case "create server" `Quick test_mcp_server_create; 424 424 + Alcotest.test_case "initialize" `Quick test_mcp_server_initialize; 425 425 + Alcotest.test_case "tools/list" `Quick test_mcp_server_tools_list; 426 426 + Alcotest.test_case "tools/call" `Quick test_mcp_server_tools_call; 427 427 + Alcotest.test_case "tool not found" `Quick test_mcp_server_tool_not_found; 428 428 + Alcotest.test_case "method not found" `Quick 429 429 + test_mcp_server_method_not_found; 430 430 + ] 357 431 358 432 (* ============================================ 359 433 Structured Error Tests 360 434 ============================================ *) 361 435 362 436 let test_error_detail_creation () = 363 363 - let error = Claude.Proto.Control.Response.error_detail 364 364 - ~code:`Method_not_found 365 365 - ~message:"Method not found" 366 366 - () 437 437 + let error = 438 438 + Claude.Proto.Control.Response.error_detail ~code:`Method_not_found 439 439 + ~message:"Method not found" () 367 440 in 368 441 Alcotest.(check int) "error code" (-32601) error.code; 369 442 Alcotest.(check string) "error message" "Method not found" error.message 370 443 371 444 let test_error_code_conventions () = 372 372 - let codes = [ 373 373 - (`Parse_error, -32700); 374 374 - (`Invalid_request, -32600); 375 375 - (`Method_not_found, -32601); 376 376 - (`Invalid_params, -32602); 377 377 - (`Internal_error, -32603); 378 378 - (`Custom 1, 1); 379 379 - ] in 380 380 - List.iter (fun (code, expected_int) -> 381 381 - let err = Claude.Proto.Control.Response.error_detail ~code ~message:"test" () in 382 382 - Alcotest.(check int) "error code value" expected_int err.code 383 383 - ) codes 445 445 + let codes = 446 446 + [ 447 447 + (`Parse_error, -32700); 448 448 + (`Invalid_request, -32600); 449 449 + (`Method_not_found, -32601); 450 450 + (`Invalid_params, -32602); 451 451 + (`Internal_error, -32603); 452 452 + (`Custom 1, 1); 453 453 + ] 454 454 + in 455 455 + List.iter 456 456 + (fun (code, expected_int) -> 457 457 + let err = 458 458 + Claude.Proto.Control.Response.error_detail ~code ~message:"test" () 459 459 + in 460 460 + Alcotest.(check int) "error code value" expected_int err.code) 461 461 + codes 384 462 385 463 let test_error_response_encoding () = 386 386 - let error_detail = Claude.Proto.Control.Response.error_detail 387 387 - ~code:`Invalid_params 388 388 - ~message:"Invalid parameters" 389 389 - () 464 464 + let error_detail = 465 465 + Claude.Proto.Control.Response.error_detail ~code:`Invalid_params 466 466 + ~message:"Invalid parameters" () 390 467 in 391 391 - let error_resp = Claude.Proto.Control.Response.error 392 392 - ~request_id:"test-123" 393 393 - ~error:error_detail 394 394 - () 468 468 + let error_resp = 469 469 + Claude.Proto.Control.Response.error ~request_id:"test-123" 470 470 + ~error:error_detail () 395 471 in 396 472 match Jsont.Json.encode Claude.Proto.Control.Response.jsont error_resp with 397 473 | Ok json -> ( ··· 399 475 | Ok (Claude.Proto.Control.Response.Error decoded) -> 400 476 Alcotest.(check string) "request_id" "test-123" decoded.request_id; 401 477 Alcotest.(check int) "error code" (-32602) decoded.error.code; 402 402 - Alcotest.(check string) "error message" "Invalid parameters" decoded.error.message 478 478 + Alcotest.(check string) 479 479 + "error message" "Invalid parameters" decoded.error.message 403 480 | Ok _ -> Alcotest.fail "Wrong response type decoded" 404 481 | Error e -> Alcotest.fail e) 405 482 | Error e -> Alcotest.fail e 406 483 407 407 - let structured_error_tests = [ 408 408 - Alcotest.test_case "error detail creation" `Quick test_error_detail_creation; 409 409 - Alcotest.test_case "error code conventions" `Quick test_error_code_conventions; 410 410 - Alcotest.test_case "error response encoding" `Quick test_error_response_encoding; 411 411 - ] 484 484 + let structured_error_tests = 485 485 + [ 486 486 + Alcotest.test_case "error detail creation" `Quick test_error_detail_creation; 487 487 + Alcotest.test_case "error code conventions" `Quick 488 488 + test_error_code_conventions; 489 489 + Alcotest.test_case "error response encoding" `Quick 490 490 + test_error_response_encoding; 491 491 + ] 412 492 413 493 (* ============================================ 414 494 Tool_input Tests 415 495 ============================================ *) 416 496 417 497 let test_tool_input_get_string () = 418 418 - let json = J.object' [J.mem (J.name "foo") (J.string "bar")] in 498 498 + let json = J.object' [ J.mem (J.name "foo") (J.string "bar") ] in 419 499 let input = Claude.Tool_input.of_json json in 420 420 - Alcotest.(check (option string)) "get_string foo" (Some "bar") (Claude.Tool_input.get_string input "foo"); 421 421 - Alcotest.(check (option string)) "get_string missing" None (Claude.Tool_input.get_string input "missing") 500 500 + Alcotest.(check (option string)) 501 501 + "get_string foo" (Some "bar") 502 502 + (Claude.Tool_input.get_string input "foo"); 503 503 + Alcotest.(check (option string)) 504 504 + "get_string missing" None 505 505 + (Claude.Tool_input.get_string input "missing") 422 506 423 507 let test_tool_input_get_int () = 424 424 - let json = J.object' [J.mem (J.name "count") (J.number 42.0)] in 508 508 + let json = J.object' [ J.mem (J.name "count") (J.number 42.0) ] in 425 509 let input = Claude.Tool_input.of_json json in 426 426 - Alcotest.(check (option int)) "get_int count" (Some 42) (Claude.Tool_input.get_int input "count") 510 510 + Alcotest.(check (option int)) 511 511 + "get_int count" (Some 42) 512 512 + (Claude.Tool_input.get_int input "count") 427 513 428 514 let test_tool_input_get_float () = 429 429 - let json = J.object' [J.mem (J.name "pi") (J.number 3.14159)] in 515 515 + let json = J.object' [ J.mem (J.name "pi") (J.number 3.14159) ] in 430 516 let input = Claude.Tool_input.of_json json in 431 517 match Claude.Tool_input.get_float input "pi" with 432 432 - | Some f -> Alcotest.(check bool) "get_float pi approx" true (abs_float (f -. 3.14159) < 0.0001) 518 518 + | Some f -> 519 519 + Alcotest.(check bool) 520 520 + "get_float pi approx" true 521 521 + (abs_float (f -. 3.14159) < 0.0001) 433 522 | None -> Alcotest.fail "Expected float" 434 523 435 524 let test_tool_input_get_bool () = 436 436 - let json = J.object' [ 437 437 - J.mem (J.name "yes") (J.bool true); 438 438 - J.mem (J.name "no") (J.bool false) 439 439 - ] in 525 525 + let json = 526 526 + J.object' 527 527 + [ J.mem (J.name "yes") (J.bool true); J.mem (J.name "no") (J.bool false) ] 528 528 + in 440 529 let input = Claude.Tool_input.of_json json in 441 441 - Alcotest.(check (option bool)) "get_bool yes" (Some true) (Claude.Tool_input.get_bool input "yes"); 442 442 - Alcotest.(check (option bool)) "get_bool no" (Some false) (Claude.Tool_input.get_bool input "no") 530 530 + Alcotest.(check (option bool)) 531 531 + "get_bool yes" (Some true) 532 532 + (Claude.Tool_input.get_bool input "yes"); 533 533 + Alcotest.(check (option bool)) 534 534 + "get_bool no" (Some false) 535 535 + (Claude.Tool_input.get_bool input "no") 443 536 444 537 let test_tool_input_get_string_list () = 445 445 - let json = J.object' [ 446 446 - J.mem (J.name "items") (J.list [J.string "a"; J.string "b"; J.string "c"]) 447 447 - ] in 538 538 + let json = 539 539 + J.object' 540 540 + [ 541 541 + J.mem (J.name "items") 542 542 + (J.list [ J.string "a"; J.string "b"; J.string "c" ]); 543 543 + ] 544 544 + in 448 545 let input = Claude.Tool_input.of_json json in 449 449 - Alcotest.(check (option (list string))) "get_string_list" 450 450 - (Some ["a"; "b"; "c"]) 546 546 + Alcotest.(check (option (list string))) 547 547 + "get_string_list" 548 548 + (Some [ "a"; "b"; "c" ]) 451 549 (Claude.Tool_input.get_string_list input "items") 452 550 453 453 - let tool_input_tests = [ 454 454 - Alcotest.test_case "get_string" `Quick test_tool_input_get_string; 455 455 - Alcotest.test_case "get_int" `Quick test_tool_input_get_int; 456 456 - Alcotest.test_case "get_float" `Quick test_tool_input_get_float; 457 457 - Alcotest.test_case "get_bool" `Quick test_tool_input_get_bool; 458 458 - Alcotest.test_case "get_string_list" `Quick test_tool_input_get_string_list; 459 459 - ] 551 551 + let tool_input_tests = 552 552 + [ 553 553 + Alcotest.test_case "get_string" `Quick test_tool_input_get_string; 554 554 + Alcotest.test_case "get_int" `Quick test_tool_input_get_int; 555 555 + Alcotest.test_case "get_float" `Quick test_tool_input_get_float; 556 556 + Alcotest.test_case "get_bool" `Quick test_tool_input_get_bool; 557 557 + Alcotest.test_case "get_string_list" `Quick test_tool_input_get_string_list; 558 558 + ] 460 559 461 560 (* ============================================ 462 561 Main test runner 463 562 ============================================ *) 464 563 465 564 let () = 466 466 - Alcotest.run "Claude SDK" [ 467 467 - "Protocol", protocol_tests; 468 468 - "Tool", tool_tests; 469 469 - "Mcp_server", mcp_server_tests; 470 470 - "Structured errors", structured_error_tests; 471 471 - "Tool_input", tool_input_tests; 472 472 - ] 565 565 + Alcotest.run "Claude SDK" 566 566 + [ 567 567 + ("Protocol", protocol_tests); 568 568 + ("Tool", tool_tests); 569 569 + ("Mcp_server", mcp_server_tests); 570 570 + ("Structured errors", structured_error_tests); 571 571 + ("Tool_input", tool_input_tests); 572 572 + ]

+4 -3

test/test_incoming.ml

··· 65 65 | Ok (Proto.Incoming.Control_response resp) -> ( 66 66 match resp.response with 67 67 | Proto.Control.Response.Error e -> 68 68 - if e.request_id = "test-req-2" 69 69 - && e.error.code = -32603 70 70 - && e.error.message = "Something went wrong" 68 68 + if 69 69 + e.request_id = "test-req-2" 70 70 + && e.error.code = -32603 71 71 + && e.error.message = "Something went wrong" 71 72 then print_endline "✓ Decoded control error response successfully" 72 73 else Printf.printf "✗ Wrong error content\n" 73 74 | Proto.Control.Response.Success _ ->

+4 -2

test/test_permissions.ml

··· 11 11 12 12 (* Simple auto-allow permission callback *) 13 13 let auto_allow_callback ctx = 14 14 - Log.app (fun m -> m "✅ Auto-allowing tool: %s" ctx.Claude.Permissions.tool_name); 14 14 + Log.app (fun m -> 15 15 + m "✅ Auto-allowing tool: %s" ctx.Claude.Permissions.tool_name); 15 16 Claude.Permissions.Decision.allow () 16 17 17 18 let run_test ~sw ~env = ··· 27 28 28 29 Log.app (fun m -> m "Creating client with permission callback..."); 29 30 let client = 30 30 - Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ~clock:env#clock () 31 31 + Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr 32 32 + ~clock:env#clock () 31 33 in 32 34 33 35 (* Simple query that will trigger tool use *)

+82 -74

test/test_structured_error.ml

··· 11 11 print_endline "\nTesting structured error creation..."; 12 12 13 13 (* Create a simple error *) 14 14 - let error1 = Proto.Control.Response.error_detail 15 15 - ~code:`Method_not_found 16 16 - ~message:"Method not found" 17 17 - () 14 14 + let error1 = 15 15 + Proto.Control.Response.error_detail ~code:`Method_not_found 16 16 + ~message:"Method not found" () 18 17 in 19 18 Printf.printf "✓ Created error: [%d] %s\n" error1.code error1.message; 20 19 21 20 (* Create an error without additional data for simplicity *) 22 22 - let error2 = Proto.Control.Response.error_detail 23 23 - ~code:`Invalid_params 24 24 - ~message:"Invalid parameters" 25 25 - () 21 21 + let error2 = 22 22 + Proto.Control.Response.error_detail ~code:`Invalid_params 23 23 + ~message:"Invalid parameters" () 26 24 in 27 25 Printf.printf "✓ Created error: [%d] %s\n" error2.code error2.message; 28 26 29 27 (* Encode and decode an error response *) 30 30 - let error_resp = Proto.Control.Response.error 31 31 - ~request_id:"test-123" 32 32 - ~error:error2 33 33 - () 28 28 + let error_resp = 29 29 + Proto.Control.Response.error ~request_id:"test-123" ~error:error2 () 34 30 in 35 31 36 32 match Jsont.Json.encode Proto.Control.Response.jsont error_resp with 37 37 - | Ok json -> 38 38 - let json_str = match Jsont_bytesrw.encode_string' Jsont.json json with 33 33 + | Ok json -> ( 34 34 + let json_str = 35 35 + match Jsont_bytesrw.encode_string' Jsont.json json with 39 36 | Ok s -> s 40 37 | Error e -> Jsont.Error.to_string e 41 38 in 42 39 Printf.printf "✓ Encoded error response: %s\n" json_str; 43 40 44 41 (* Decode it back *) 45 45 - (match Jsont.Json.decode Proto.Control.Response.jsont json with 42 42 + match Jsont.Json.decode Proto.Control.Response.jsont json with 46 43 | Ok (Proto.Control.Response.Error decoded) -> 47 47 - Printf.printf "✓ Decoded error: [%d] %s\n" 48 48 - decoded.error.code decoded.error.message 44 44 + Printf.printf "✓ Decoded error: [%d] %s\n" decoded.error.code 45 45 + decoded.error.message 49 46 | Ok _ -> print_endline "✗ Wrong response type" 50 47 | Error e -> Printf.printf "✗ Decode failed: %s\n" e) 51 51 - | Error e -> 52 52 - Printf.printf "✗ Encode failed: %s\n" e 48 48 + | Error e -> Printf.printf "✗ Encode failed: %s\n" e 53 49 54 50 let test_error_code_conventions () = 55 51 print_endline "\nTesting JSON-RPC error code conventions..."; 56 52 57 53 (* Standard JSON-RPC errors using the typed API with polymorphic variants *) 58 58 - let errors = [ 59 59 - (`Parse_error, "Parse error"); 60 60 - (`Invalid_request, "Invalid request"); 61 61 - (`Method_not_found, "Method not found"); 62 62 - (`Invalid_params, "Invalid params"); 63 63 - (`Internal_error, "Internal error"); 64 64 - (`Custom 1, "Application error"); 65 65 - ] in 54 54 + let errors = 55 55 + [ 56 56 + (`Parse_error, "Parse error"); 57 57 + (`Invalid_request, "Invalid request"); 58 58 + (`Method_not_found, "Method not found"); 59 59 + (`Invalid_params, "Invalid params"); 60 60 + (`Internal_error, "Internal error"); 61 61 + (`Custom 1, "Application error"); 62 62 + ] 63 63 + in 66 64 67 67 - List.iter (fun (code, msg) -> 68 68 - let err = Proto.Control.Response.error_detail ~code ~message:msg () in 69 69 - Printf.printf "✓ Error [%d]: %s (typed)\n" err.code err.message 70 70 - ) errors 65 65 + List.iter 66 66 + (fun (code, msg) -> 67 67 + let err = Proto.Control.Response.error_detail ~code ~message:msg () in 68 68 + Printf.printf "✓ Error [%d]: %s (typed)\n" err.code err.message) 69 69 + errors 71 70 72 71 let test_provoke_api_error ~sw ~env = 73 72 print_endline "\nTesting API error from Claude..."; ··· 75 74 (* Configure client with an invalid model to provoke an API error *) 76 75 let options = 77 76 Claude.Options.default 78 78 - |> Claude.Options.with_model (Claude.Model.of_string "invalid-model-that-does-not-exist") 77 77 + |> Claude.Options.with_model 78 78 + (Claude.Model.of_string "invalid-model-that-does-not-exist") 79 79 in 80 80 81 81 Printf.printf "Creating client with invalid model...\n"; 82 82 83 83 try 84 84 let client = 85 85 - Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ~clock:env#clock () 85 85 + Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr 86 86 + ~clock:env#clock () 86 87 in 87 88 88 89 Printf.printf "Sending query to provoke API error...\n"; 89 89 - Claude.Client.query client "Hello, this should fail with an invalid model error"; 90 90 + Claude.Client.query client 91 91 + "Hello, this should fail with an invalid model error"; 90 92 91 93 (* Process responses to see if we get an error *) 92 94 let messages = Claude.Client.receive_all client in ··· 106 108 (Claude.Response.Error.is_assistant_error err) 107 109 | Claude.Response.Text text -> 108 110 let content = Claude.Response.Text.content text in 109 109 - if String.length content > 0 && 110 110 - (String.contains content '4' || String.contains content 'e') then begin 111 111 + if 112 112 + String.length content > 0 113 113 + && (String.contains content '4' || String.contains content 'e') 114 114 + then begin 111 115 text_error_found := true; 112 116 Printf.printf "✓ Received error as text: %s\n" content 113 117 end ··· 121 125 Printf.printf "✓ Successfully caught structured error response\n" 122 126 else if !text_error_found then 123 127 Printf.printf "✓ Successfully caught error (returned as text)\n" 124 124 - else 125 125 - Printf.printf "✗ No error was returned (unexpected)\n" 126 126 - 128 128 + else Printf.printf "✗ No error was returned (unexpected)\n" 127 129 with 128 130 | Claude.Transport.Connection_error msg -> 129 131 Printf.printf "✓ Connection error as expected: %s\n" msg ··· 135 137 print_endline "\nTesting control protocol error encoding/decoding..."; 136 138 137 139 (* Test that we can create and encode a control protocol error using polymorphic variant codes *) 138 138 - let error_detail = Proto.Control.Response.error_detail 139 139 - ~code:`Invalid_params 140 140 - ~message:"Invalid params for permission request" 141 141 - ~data:(Jsont.Object ([ 142 142 - (("tool_name", Jsont.Meta.none), Jsont.String ("Write", Jsont.Meta.none)); 143 143 - (("reason", Jsont.Meta.none), Jsont.String ("Missing required file_path parameter", Jsont.Meta.none)); 144 144 - ], Jsont.Meta.none)) 145 145 - () 140 140 + let error_detail = 141 141 + Proto.Control.Response.error_detail ~code:`Invalid_params 142 142 + ~message:"Invalid params for permission request" 143 143 + ~data: 144 144 + (Jsont.Object 145 145 + ( [ 146 146 + ( ("tool_name", Jsont.Meta.none), 147 147 + Jsont.String ("Write", Jsont.Meta.none) ); 148 148 + ( ("reason", Jsont.Meta.none), 149 149 + Jsont.String 150 150 + ("Missing required file_path parameter", Jsont.Meta.none) ); 151 151 + ], 152 152 + Jsont.Meta.none )) 153 153 + () 146 154 in 147 155 148 148 - let error_response = Proto.Control.Response.error 149 149 - ~request_id:"test-req-456" 150 150 - ~error:error_detail 151 151 - () 156 156 + let error_response = 157 157 + Proto.Control.Response.error ~request_id:"test-req-456" ~error:error_detail 158 158 + () 152 159 in 153 160 154 161 match Jsont.Json.encode Proto.Control.Response.jsont error_response with 155 155 - | Ok json -> 156 156 - let json_str = match Jsont_bytesrw.encode_string' Jsont.json json with 162 162 + | Ok json -> ( 163 163 + let json_str = 164 164 + match Jsont_bytesrw.encode_string' Jsont.json json with 157 165 | Ok s -> s 158 166 | Error e -> Jsont.Error.to_string e 159 167 in 160 168 Printf.printf "✓ Encoded control error with data:\n %s\n" json_str; 161 169 162 170 (* Verify we can decode it back *) 163 163 - (match Jsont.Json.decode Proto.Control.Response.jsont json with 164 164 - | Ok (Proto.Control.Response.Error decoded) -> 171 171 + match Jsont.Json.decode Proto.Control.Response.jsont json with 172 172 + | Ok (Proto.Control.Response.Error decoded) -> ( 165 173 Printf.printf "✓ Decoded control error:\n"; 166 174 Printf.printf " Code: %d\n" decoded.error.code; 167 175 Printf.printf " Message: %s\n" decoded.error.message; 168 176 Printf.printf " Has data: %b\n" (Option.is_some decoded.error.data); 169 169 - (match decoded.error.data with 177 177 + match decoded.error.data with 170 178 | Some data -> 171 171 - let data_str = match Jsont_bytesrw.encode_string' Jsont.json data with 179 179 + let data_str = 180 180 + match Jsont_bytesrw.encode_string' Jsont.json data with 172 181 | Ok s -> s 173 182 | Error e -> Jsont.Error.to_string e 174 183 in ··· 176 185 | None -> ()) 177 186 | Ok _ -> print_endline "✗ Wrong response type" 178 187 | Error e -> Printf.printf "✗ Decode failed: %s\n" e) 179 179 - | Error e -> 180 180 - Printf.printf "✗ Encode failed: %s\n" e 188 188 + | Error e -> Printf.printf "✗ Encode failed: %s\n" e 181 189 182 190 let test_hook_error ~sw ~env = 183 191 print_endline "\nTesting hook callback errors trigger JSON-RPC error codes..."; 184 192 185 193 (* Create a hook that will throw an exception *) 186 194 let failing_hook input = 187 187 - Printf.printf "✓ Hook called for tool: %s\n" input.Claude.Hooks.PreToolUse.tool_name; 195 195 + Printf.printf "✓ Hook called for tool: %s\n" 196 196 + input.Claude.Hooks.PreToolUse.tool_name; 188 197 failwith "Intentional hook failure to test error handling" 189 198 in 190 199 ··· 204 213 205 214 try 206 215 let client = 207 207 - Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ~clock:env#clock () 216 216 + Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr 217 217 + ~clock:env#clock () 208 218 in 209 219 210 210 - Printf.printf "Asking Claude to write a file (should trigger failing hook)...\n"; 220 220 + Printf.printf 221 221 + "Asking Claude to write a file (should trigger failing hook)...\n"; 211 222 Claude.Client.query client "Write 'test' to /tmp/test_hook_error.txt"; 212 223 213 224 (* Process responses *) ··· 226 237 end 227 238 | Claude.Response.Error err -> 228 239 error_found := true; 229 229 - Printf.printf " Error response: %s\n" (Claude.Response.Error.message err) 230 230 - | Claude.Response.Complete _ -> 231 231 - Printf.printf " Query completed\n" 240 240 + Printf.printf " Error response: %s\n" 241 241 + (Claude.Response.Error.message err) 242 242 + | Claude.Response.Complete _ -> Printf.printf " Query completed\n" 232 243 | _ -> ()) 233 244 messages; 234 245 235 246 if !hook_called then 236 247 Printf.printf "✓ Hook was triggered, exception caught by SDK\n" 237 248 else 238 238 - Printf.printf " Note: Hook may not have been called if query didn't use Write tool\n"; 249 249 + Printf.printf 250 250 + " Note: Hook may not have been called if query didn't use Write tool\n"; 239 251 240 252 Printf.printf "✓ Test completed (SDK sent -32603 Internal Error to CLI)\n" 241 241 - 242 242 - with 243 243 - | exn -> 244 244 - Printf.printf "Exception during test: %s\n" (Printexc.to_string exn); 245 245 - Printexc.print_backtrace stdout 253 253 + with exn -> 254 254 + Printf.printf "Exception during test: %s\n" (Printexc.to_string exn); 255 255 + Printexc.print_backtrace stdout 246 256 247 257 let run_all_tests env = 248 258 print_endline "=== Structured Error Tests ==="; ··· 262 272 263 273 let () = 264 274 Eio_main.run @@ fun env -> 265 265 - try 266 266 - run_all_tests env 267 267 - with 275 275 + try run_all_tests env with 268 276 | Claude.Transport.CLI_not_found msg -> 269 277 Printf.eprintf "Error: Claude CLI not found\n%s\n" msg; 270 278 Printf.eprintf "Make sure 'claude' is installed and in your PATH\n";