Add MCP-based custom tool architecture · anil.recoil.org/ocaml-claudeio@de12298

+990

ARCHITECTURE.md

··· 1 + # Claude OCaml SDK Architecture (v2) 2 + 3 + This document describes the rearchitected OCaml SDK, aligned with the Python Claude Agent SDK while maintaining idiomatic OCaml/Eio patterns. 4 + 5 + ## Core Design Principles 6 + 7 + ### 1. MCP for Custom Tools (Python SDK Pattern) 8 + 9 + The Python SDK's key insight: **built-in tools are handled by Claude CLI, custom tools via MCP**. 10 + 11 + ``` 12 + Claude CLI SDK (OCaml Process) 13 + | | 14 + |--[tool_use Read]--->| (CLI handles internally) 15 + | | 16 + |<--[tool_result]----| 17 + | | 18 + |--[mcp_request]----->| (SDK handles via in-process MCP) 19 + |<--[mcp_response]----| 20 + ``` 21 + 22 + This eliminates the current problem where the OCaml SDK intercepts ALL tool_use events. 23 + 24 + ### 2. Hooks Intercept, Don't Execute 25 + 26 + Hooks provide interception points for **observation and control**, not execution: 27 + - PreToolUse: Allow/Deny/Modify before execution (by CLI or MCP) 28 + - PostToolUse: Observe/Modify after execution 29 + - Other lifecycle hooks remain the same 30 + 31 + ### 3. Two-Level API 32 + 33 + Like Python, provide both simple and advanced interfaces: 34 + - `Claude.query`: One-shot queries, simple async iterator 35 + - `Claude.Client`: Full bidirectional, multi-turn, custom tools 36 + 37 + --- 38 + 39 + ## Module Structure 40 + 41 + ``` 42 + lib/ 43 + ├── claude.ml # Main module, re-exports public API 44 + ├── claude.mli 45 + │ 46 + ├── client.ml # Bidirectional client 47 + ├── client.mli 48 + │ 49 + ├── tool.ml # Custom tool definition 50 + ├── tool.mli 51 + │ 52 + ├── mcp_server.ml # In-process MCP server 53 + ├── mcp_server.mli 54 + │ 55 + ├── hook.ml # Hook types and matchers 56 + ├── hook.mli 57 + │ 58 + ├── options.ml # Configuration 59 + ├── options.mli 60 + │ 61 + ├── message.ml # Message types 62 + ├── message.mli 63 + │ 64 + ├── response.ml # Response events 65 + ├── response.mli 66 + │ 67 + ├── model.ml # Model identifiers 68 + ├── model.mli 69 + │ 70 + ├── permission_mode.ml # Permission modes 71 + ├── permission_mode.mli 72 + │ 73 + ├── server_info.ml # Server metadata 74 + ├── server_info.mli 75 + │ 76 + ├── err.ml # Error types 77 + ├── err.mli 78 + │ 79 + └── internal/ 80 + ├── process.ml # CLI process management 81 + ├── protocol.ml # JSON wire protocol 82 + └── mcp_handler.ml # MCP message routing 83 + ``` 84 + 85 + --- 86 + 87 + ## Core Types 88 + 89 + ### Tool Definition 90 + 91 + ```ocaml 92 + (* tool.mli *) 93 + 94 + (** Custom tool for MCP servers. 95 + 96 + Tools are functions that Claude can invoke. They run in-process 97 + within your OCaml application via MCP protocol. 98 + 99 + {[ 100 + let greet = Tool.create 101 + ~name:"greet" 102 + ~description:"Greet a user by name" 103 + ~input_schema:(`O ["name", `String "string"]) 104 + ~handler:(fun args -> 105 + match Jsont.find_string "name" args with 106 + | Some name -> Ok (`String (Printf.sprintf "Hello, %s!" name)) 107 + | None -> Error "Missing 'name' parameter") 108 + ]} *) 109 + 110 + type t 111 + 112 + val create : 113 + name:string -> 114 + description:string -> 115 + input_schema:Jsont.json -> 116 + handler:(Jsont.json -> (Jsont.json, string) result) -> 117 + t 118 + (** [create ~name ~description ~input_schema ~handler] creates a custom tool. 119 + 120 + @param name Unique tool identifier. Claude uses this in function calls. 121 + @param description Human-readable description for Claude. 122 + @param input_schema JSON Schema for input validation. 123 + @param handler Function that executes the tool and returns result or error. *) 124 + 125 + val name : t -> string 126 + val description : t -> string 127 + val input_schema : t -> Jsont.json 128 + val call : t -> Jsont.json -> (Jsont.json, string) result 129 + 130 + (** {2 Async Tools} 131 + 132 + For tools that need Eio concurrency: *) 133 + 134 + type async_t 135 + 136 + val create_async : 137 + name:string -> 138 + description:string -> 139 + input_schema:Jsont.json -> 140 + handler:(sw:Eio.Switch.t -> Jsont.json -> (Jsont.json, string) result) -> 141 + async_t 142 + (** Create a tool that runs under an Eio switch for async operations. *) 143 + ``` 144 + 145 + ### MCP Server 146 + 147 + ```ocaml 148 + (* mcp_server.mli *) 149 + 150 + (** In-process MCP server. 151 + 152 + SDK MCP servers run directly in your OCaml application, eliminating 153 + subprocess overhead. They handle tools/list and tools/call requests. 154 + 155 + {[ 156 + let server = Mcp_server.create 157 + ~name:"my-tools" 158 + ~tools:[greet_tool; calculate_tool] 159 + () 160 + 161 + let options = Options.default 162 + |> Options.with_mcp_server ~name:"tools" server 163 + |> Options.with_allowed_tools ["mcp__tools__greet"] 164 + ]} *) 165 + 166 + type t 167 + 168 + val create : 169 + name:string -> 170 + ?version:string -> 171 + tools:Tool.t list -> 172 + unit -> 173 + t 174 + (** [create ~name ?version ~tools ()] creates an in-process MCP server. 175 + 176 + @param name Server identifier. Tools are accessed as [mcp__<name>__<tool>]. 177 + @param version Server version (default "1.0.0"). 178 + @param tools List of tools this server provides. *) 179 + 180 + val name : t -> string 181 + val version : t -> string 182 + val tools : t -> Tool.t list 183 + 184 + (** {2 MCP Protocol Handling} *) 185 + 186 + val handle_request : 187 + t -> 188 + method_:string -> 189 + params:Jsont.json -> 190 + (Jsont.json, string) result 191 + (** [handle_request t ~method_ ~params] handles MCP JSONRPC requests. 192 + 193 + Supports: 194 + - [initialize]: Returns server capabilities 195 + - [tools/list]: Returns available tools 196 + - [tools/call]: Executes a tool *) 197 + ``` 198 + 199 + ### Hooks 200 + 201 + ```ocaml 202 + (* hook.mli *) 203 + 204 + (** Hook callbacks for event interception. 205 + 206 + Hooks intercept events in the Claude agent loop. They can observe, 207 + allow, deny, or modify tool execution. 208 + 209 + {b Key difference from tool execution}: Hooks don't execute built-in 210 + tools - Claude CLI handles those. Hooks only intercept for control. 211 + 212 + {[ 213 + let block_rm = Hook.PreToolUse.handler (fun input -> 214 + if input.tool_name = "Bash" then 215 + match Tool_input.get_string input.tool_input "command" with 216 + | Some cmd when String.is_substring cmd ~substring:"rm -rf" -> 217 + Hook.PreToolUse.deny ~reason:"Dangerous command" 218 + | _ -> Hook.PreToolUse.allow () 219 + else Hook.PreToolUse.allow ()) 220 + 221 + let hooks = Hook.Config.empty 222 + |> Hook.Config.on_pre_tool_use ~pattern:"Bash" block_rm 223 + ]} *) 224 + 225 + type context = { 226 + session_id : string option; 227 + transcript_path : string option; 228 + } 229 + (** Context provided to all hooks. *) 230 + 231 + (** {1 PreToolUse Hook} 232 + 233 + Fires before any tool execution (built-in or MCP). *) 234 + module PreToolUse : sig 235 + type input = { 236 + tool_name : string; 237 + tool_input : Tool_input.t; 238 + context : context; 239 + } 240 + 241 + type decision = 242 + | Allow 243 + | Deny of { reason : string } 244 + | Modify of { input : Tool_input.t } 245 + | Ask of { reason : string option } 246 + 247 + val allow : ?updated_input:Tool_input.t -> unit -> decision 248 + val deny : reason:string -> decision 249 + val ask : ?reason:string -> unit -> decision 250 + val modify : input:Tool_input.t -> decision 251 + 252 + type handler = input -> decision 253 + 254 + val handler : (input -> decision) -> handler 255 + end 256 + 257 + (** {1 PostToolUse Hook} 258 + 259 + Fires after tool execution completes. *) 260 + module PostToolUse : sig 261 + type input = { 262 + tool_name : string; 263 + tool_input : Tool_input.t; 264 + tool_result : Jsont.json; 265 + context : context; 266 + } 267 + 268 + type decision = 269 + | Continue 270 + | Block of { reason : string option } 271 + | AddContext of { context : string } 272 + 273 + val continue : unit -> decision 274 + val block : ?reason:string -> unit -> decision 275 + val add_context : string -> decision 276 + 277 + type handler = input -> decision 278 + end 279 + 280 + (** {1 Other Hooks} *) 281 + module UserPromptSubmit : sig 282 + type input = { prompt : string; context : context } 283 + type decision = Continue | Block of { reason : string option } 284 + type handler = input -> decision 285 + end 286 + 287 + module Stop : sig 288 + type input = { stop_hook_active : bool; context : context } 289 + type decision = Continue | Block of { reason : string option } 290 + type handler = input -> decision 291 + end 292 + 293 + module PreCompact : sig 294 + type input = { context : context } 295 + type handler = input -> unit (* Notification only *) 296 + end 297 + 298 + (** {1 Hook Configuration} *) 299 + module Config : sig 300 + type t 301 + 302 + val empty : t 303 + 304 + val on_pre_tool_use : ?pattern:string -> PreToolUse.handler -> t -> t 305 + val on_post_tool_use : ?pattern:string -> PostToolUse.handler -> t -> t 306 + val on_user_prompt_submit : UserPromptSubmit.handler -> t -> t 307 + val on_stop : Stop.handler -> t -> t 308 + val on_pre_compact : PreCompact.handler -> t -> t 309 + end 310 + ``` 311 + 312 + ### Options 313 + 314 + ```ocaml 315 + (* options.mli *) 316 + 317 + (** Configuration options for Claude sessions. 318 + 319 + {[ 320 + let options = Options.default 321 + |> Options.with_model Model.opus 322 + |> Options.with_mcp_server ~name:"tools" my_server 323 + |> Options.with_allowed_tools ["mcp__tools__greet"; "Read"; "Write"] 324 + |> Options.with_hooks my_hooks 325 + |> Options.with_max_budget_usd 1.0 326 + ]} *) 327 + 328 + type t 329 + 330 + val default : t 331 + 332 + (** {1 Builder Pattern} *) 333 + 334 + val with_system_prompt : string -> t -> t 335 + val with_append_system_prompt : string -> t -> t 336 + val with_model : Model.t -> t -> t 337 + val with_fallback_model : Model.t -> t -> t 338 + val with_max_turns : int -> t -> t 339 + val with_max_thinking_tokens : int -> t -> t 340 + val with_max_budget_usd : float -> t -> t 341 + 342 + val with_allowed_tools : string list -> t -> t 343 + val with_disallowed_tools : string list -> t -> t 344 + val with_permission_mode : Permission_mode.t -> t -> t 345 + 346 + val with_cwd : [> Eio.Fs.dir_ty ] Eio.Path.t -> t -> t 347 + val with_env : (string * string) list -> t -> t 348 + 349 + val with_mcp_server : name:string -> Mcp_server.t -> t -> t 350 + (** Add an in-process MCP server. Multiple servers can be added. *) 351 + 352 + val with_hooks : Hook.Config.t -> t -> t 353 + 354 + val with_no_settings : t -> t 355 + val with_cli_path : string -> t -> t 356 + 357 + (** {1 Accessors} *) 358 + 359 + val system_prompt : t -> string option 360 + val model : t -> Model.t option 361 + val mcp_servers : t -> (string * Mcp_server.t) list 362 + val hooks : t -> Hook.Config.t option 363 + (* ... other accessors ... *) 364 + ``` 365 + 366 + ### Permission Mode 367 + 368 + ```ocaml 369 + (* permission_mode.mli *) 370 + 371 + (** Permission modes for tool authorization. *) 372 + 373 + type t = 374 + | Default (** Prompt for all permissions *) 375 + | Accept_edits (** Auto-accept file edits *) 376 + | Plan (** Planning mode - restricted execution *) 377 + | Bypass (** Skip all permission checks - DANGEROUS *) 378 + 379 + val to_string : t -> string 380 + val of_string : string -> t option 381 + ``` 382 + 383 + ### Model 384 + 385 + ```ocaml 386 + (* model.mli *) 387 + 388 + (** Claude AI model identifiers. *) 389 + 390 + type t = 391 + | Sonnet_4_5 392 + | Opus_4 393 + | Haiku_4 394 + | Custom of string 395 + 396 + val sonnet : t 397 + val opus : t 398 + val haiku : t 399 + 400 + val to_string : t -> string 401 + val of_string : string -> t 402 + ``` 403 + 404 + ### Messages and Responses 405 + 406 + ```ocaml 407 + (* message.mli *) 408 + 409 + (** Messages exchanged with Claude. *) 410 + 411 + module Content_block : sig 412 + type t = 413 + | Text of { text : string } 414 + | Tool_use of { id : string; name : string; input : Jsont.json } 415 + | Tool_result of { tool_use_id : string; content : Jsont.json; is_error : bool } 416 + | Thinking of { text : string } 417 + end 418 + 419 + module User : sig 420 + type t 421 + val of_string : string -> t 422 + val of_blocks : Content_block.t list -> t 423 + val of_tool_results : (string * Jsont.json * bool) list -> t 424 + end 425 + 426 + module Assistant : sig 427 + type t 428 + val content : t -> Content_block.t list 429 + val text : t -> string (* Concatenated text blocks *) 430 + end 431 + 432 + type t = 433 + | User of User.t 434 + | Assistant of Assistant.t 435 + | System of { session_id : string option } 436 + | Result of { text : string } 437 + 438 + 439 + (* response.mli *) 440 + 441 + (** Response events from Claude. *) 442 + 443 + module Text : sig 444 + type t 445 + val content : t -> string 446 + end 447 + 448 + module Tool_use : sig 449 + type t 450 + val id : t -> string 451 + val name : t -> string 452 + val input : t -> Jsont.json 453 + end 454 + 455 + module Thinking : sig 456 + type t 457 + val content : t -> string 458 + end 459 + 460 + module Complete : sig 461 + type t 462 + val total_cost_usd : t -> float option 463 + val input_tokens : t -> int 464 + val output_tokens : t -> int 465 + val duration_ms : t -> int option 466 + end 467 + 468 + module Init : sig 469 + type t 470 + val session_id : t -> string option 471 + end 472 + 473 + module Error : sig 474 + type t 475 + val message : t -> string 476 + val code : t -> string option 477 + end 478 + 479 + type t = 480 + | Text of Text.t 481 + | Tool_use of Tool_use.t 482 + | Thinking of Thinking.t 483 + | Init of Init.t 484 + | Error of Error.t 485 + | Complete of Complete.t 486 + ``` 487 + 488 + --- 489 + 490 + ## Client Interface 491 + 492 + ```ocaml 493 + (* client.mli *) 494 + 495 + (** Bidirectional client for Claude interactions. 496 + 497 + The client handles: 498 + - Message streaming via Eio 499 + - MCP routing for custom tools 500 + - Hook callbacks 501 + - Permission requests 502 + - Dynamic control (model/permission changes) 503 + 504 + {2 Basic Usage} 505 + 506 + {[ 507 + Eio.Switch.run @@ fun sw -> 508 + let client = Client.create ~sw ~process_mgr ~clock () in 509 + 510 + Client.query client "What is 2+2?"; 511 + 512 + Client.receive client |> Seq.iter (function 513 + | Response.Text t -> print_endline (Response.Text.content t) 514 + | Response.Complete c -> 515 + Printf.printf "Cost: $%.4f\n" 516 + (Option.value ~default:0.0 (Response.Complete.total_cost_usd c)) 517 + | _ -> ()) 518 + ]} 519 + 520 + {2 With Custom Tools} 521 + 522 + {[ 523 + let greet = Tool.create 524 + ~name:"greet" 525 + ~description:"Greet someone" 526 + ~input_schema:(`O ["name", `String "string"]) 527 + ~handler:(fun args -> Ok (`String "Hello!")) 528 + 529 + let server = Mcp_server.create ~name:"tools" ~tools:[greet] () 530 + 531 + let options = Options.default 532 + |> Options.with_mcp_server ~name:"tools" server 533 + |> Options.with_allowed_tools ["mcp__tools__greet"] 534 + 535 + let client = Client.create ~sw ~process_mgr ~clock ~options () 536 + ]} *) 537 + 538 + type t 539 + 540 + val create : 541 + sw:Eio.Switch.t -> 542 + process_mgr:_ Eio.Process.mgr -> 543 + clock:float Eio.Time.clock_ty Eio.Resource.t -> 544 + ?options:Options.t -> 545 + unit -> 546 + t 547 + (** Create a new Claude client. *) 548 + 549 + (** {1 Querying} *) 550 + 551 + val query : t -> string -> unit 552 + (** [query t prompt] sends a text prompt to Claude. *) 553 + 554 + val send_message : t -> Message.User.t -> unit 555 + (** [send_message t msg] sends a user message (can include tool results). *) 556 + 557 + (** {1 Receiving Responses} *) 558 + 559 + val receive : t -> Response.t Seq.t 560 + (** [receive t] returns a lazy sequence of response events. 561 + 562 + Built-in tool executions happen internally (by Claude CLI). 563 + Custom tool calls are routed to MCP servers automatically. 564 + You only see the responses. *) 565 + 566 + val receive_all : t -> Response.t list 567 + (** [receive_all t] collects all responses into a list. *) 568 + 569 + (** {1 Dynamic Control} *) 570 + 571 + val set_model : t -> Model.t -> unit 572 + val set_permission_mode : t -> Permission_mode.t -> unit 573 + val get_server_info : t -> Server_info.t 574 + val interrupt : t -> unit 575 + 576 + val session_id : t -> string option 577 + (** Get session ID if available. *) 578 + ``` 579 + 580 + --- 581 + 582 + ## Simple Query API 583 + 584 + ```ocaml 585 + (* claude.mli *) 586 + 587 + (** OCaml SDK for Claude Code CLI. 588 + 589 + {1 Quick Start} 590 + 591 + {[ 592 + open Eio.Std 593 + 594 + let () = Eio_main.run @@ fun env -> 595 + Switch.run @@ fun sw -> 596 + let process_mgr = Eio.Stdenv.process_mgr env in 597 + let clock = Eio.Stdenv.clock env in 598 + 599 + (* Simple one-shot query *) 600 + let response = Claude.query_text ~sw ~process_mgr ~clock 601 + ~prompt:"What is 2+2?" () in 602 + print_endline response 603 + ]} 604 + 605 + {1 With Custom Tools} 606 + 607 + {[ 608 + let greet = Claude.Tool.create 609 + ~name:"greet" 610 + ~description:"Greet a user" 611 + ~input_schema:(`O ["name", `String "string"]) 612 + ~handler:(fun args -> 613 + Ok (`String (Printf.sprintf "Hello, %s!" 614 + (Jsont.get_string_exn "name" args)))) 615 + 616 + let server = Claude.Mcp_server.create 617 + ~name:"my-tools" 618 + ~tools:[greet] 619 + () 620 + 621 + let options = Claude.Options.default 622 + |> Claude.Options.with_mcp_server ~name:"tools" server 623 + |> Claude.Options.with_allowed_tools ["mcp__tools__greet"] 624 + 625 + let client = Claude.Client.create ~sw ~process_mgr ~clock ~options () 626 + ]} *) 627 + 628 + (** {1 Simple Query Functions} *) 629 + 630 + val query : 631 + sw:Eio.Switch.t -> 632 + process_mgr:_ Eio.Process.mgr -> 633 + clock:float Eio.Time.clock_ty Eio.Resource.t -> 634 + ?options:Options.t -> 635 + prompt:string -> 636 + unit -> 637 + Response.t Seq.t 638 + (** [query ~sw ~process_mgr ~clock ?options ~prompt ()] performs a one-shot query. 639 + 640 + Returns a lazy sequence of response events. The client is created and 641 + cleaned up automatically. *) 642 + 643 + val query_text : 644 + sw:Eio.Switch.t -> 645 + process_mgr:_ Eio.Process.mgr -> 646 + clock:float Eio.Time.clock_ty Eio.Resource.t -> 647 + ?options:Options.t -> 648 + prompt:string -> 649 + unit -> 650 + string 651 + (** [query_text ...] is like [query] but returns concatenated text response. *) 652 + 653 + (** {1 Core Modules} *) 654 + 655 + module Client = Client 656 + module Options = Options 657 + module Tool = Tool 658 + module Mcp_server = Mcp_server 659 + module Hook = Hook 660 + module Message = Message 661 + module Response = Response 662 + module Model = Model 663 + module Permission_mode = Permission_mode 664 + module Server_info = Server_info 665 + module Err = Err 666 + ``` 667 + 668 + --- 669 + 670 + ## Error Handling 671 + 672 + ```ocaml 673 + (* err.mli *) 674 + 675 + (** Structured error types. *) 676 + 677 + type t = 678 + | Cli_not_found of string 679 + | Process_error of { exit_code : int; message : string } 680 + | Protocol_error of { message : string; raw : string option } 681 + | Timeout of { operation : string } 682 + | Permission_denied of { tool : string; reason : string } 683 + | Hook_error of { hook : string; error : string } 684 + | Mcp_error of { server : string; method_ : string; error : string } 685 + 686 + exception E of t 687 + 688 + val to_string : t -> string 689 + val raise_cli_not_found : string -> 'a 690 + val raise_process_error : exit_code:int -> message:string -> 'a 691 + val raise_protocol_error : message:string -> ?raw:string -> unit -> 'a 692 + val raise_timeout : operation:string -> 'a 693 + ``` 694 + 695 + --- 696 + 697 + ## Internal Architecture 698 + 699 + ### Process Management 700 + 701 + The internal process module spawns Claude CLI and manages bidirectional communication: 702 + 703 + ```ocaml 704 + (* internal/process.ml *) 705 + 706 + type t = { 707 + proc : Eio.Process.t; 708 + stdin : Eio.Flow.sink; 709 + stdout : Eio.Flow.source; 710 + stderr : Eio.Flow.source; 711 + } 712 + 713 + val spawn : 714 + sw:Eio.Switch.t -> 715 + process_mgr:_ Eio.Process.mgr -> 716 + ?cli_path:string -> 717 + ?cwd:Eio.Fs.dir_ty Eio.Path.t -> 718 + args:string list -> 719 + unit -> 720 + t 721 + 722 + val send_line : t -> string -> unit 723 + val read_line : t -> string option 724 + val close : t -> unit 725 + ``` 726 + 727 + ### Protocol Handling 728 + 729 + The protocol module handles JSON wire format: 730 + 731 + ```ocaml 732 + (* internal/protocol.ml *) 733 + 734 + type incoming = 735 + | Message of Message.t 736 + | Control_request of { 737 + request_id : string; 738 + request : control_request; 739 + } 740 + | Control_response of { 741 + request_id : string; 742 + response : control_response; 743 + } 744 + 745 + and control_request = 746 + | Permission_request of { tool_name : string; input : Jsont.json } 747 + | Hook_callback of { callback_id : string; input : Jsont.json } 748 + | Mcp_request of { server : string; message : Jsont.json } 749 + 750 + and control_response = 751 + | Success of { response : Jsont.json option } 752 + | Error of { message : string } 753 + 754 + type outgoing = 755 + | User_message of Message.User.t 756 + | Control_request of { request : Request.t } 757 + | Control_response of { request_id : string; response : Response.t } 758 + 759 + val decode : string -> incoming 760 + val encode : outgoing -> string 761 + ``` 762 + 763 + ### MCP Handler 764 + 765 + Routes MCP requests to appropriate in-process servers: 766 + 767 + ```ocaml 768 + (* internal/mcp_handler.ml *) 769 + 770 + type t 771 + 772 + val create : servers:(string * Mcp_server.t) list -> t 773 + 774 + val handle_request : 775 + t -> 776 + server:string -> 777 + message:Jsont.json -> 778 + Jsont.json 779 + (** Handle MCP JSONRPC request and return response. *) 780 + ``` 781 + 782 + --- 783 + 784 + ## Message Flow Diagrams 785 + 786 + ### Built-in Tool Execution (passthrough) 787 + 788 + ``` 789 + User SDK Client Claude CLI Claude 790 + | | | | 791 + |--query()------>| | | 792 + | |--UserMsg------>| | 793 + | | |--API call--->| 794 + | | |<--tool_use---| 795 + | | | (Read file) | 796 + | | | | 797 + | | | [CLI executes Read internally] 798 + | | | | 799 + | | |--tool_result>| 800 + | | |<--text-------| 801 + | |<--Response-----| | 802 + |<--Response.Text| | | 803 + ``` 804 + 805 + ### Custom MCP Tool Execution 806 + 807 + ``` 808 + User SDK Client Claude CLI Claude 809 + | | | | 810 + |--query()------>| | | 811 + | |--UserMsg------>| | 812 + | | |--API call--->| 813 + | | |<--tool_use---| 814 + | | | (mcp__x__y) | 815 + | |<--mcp_request--| | 816 + | | | | 817 + | | [SDK routes to Mcp_server] | 818 + | | | | 819 + | |--mcp_response->| | 820 + | | |--tool_result>| 821 + | | |<--text-------| 822 + | |<--Response-----| | 823 + |<--Response.Text| | | 824 + ``` 825 + 826 + ### Hook Interception 827 + 828 + ``` 829 + User SDK Client Claude CLI Claude 830 + | | | | 831 + |--query()------>| | | 832 + | |--UserMsg------>| | 833 + | | |--API call--->| 834 + | | |<--tool_use---| 835 + | | | (Bash) | 836 + | |<--hook_callback| | 837 + | | [PreToolUse] | | 838 + | | | | 839 + | | [SDK runs hook, returns Deny] | 840 + | | | | 841 + | |--hook_response>| (denied) | 842 + | | |--error msg-->| 843 + | | |<--text-------| 844 + | |<--Response-----| | 845 + |<--Response.Text| | | 846 + ``` 847 + 848 + --- 849 + 850 + ## Migration from Current SDK 851 + 852 + ### Key Changes 853 + 854 + 1. **Remove explicit tool execution** 855 + - Current: SDK receives tool_use, executes tool, returns result 856 + - New: Built-in tools handled by CLI; only MCP tools executed by SDK 857 + 858 + 2. **Add MCP server support** 859 + - New: `Tool.t`, `Mcp_server.t` for custom tool definition 860 + 861 + 3. **Simplify hooks** 862 + - Current: Hooks can have complex tool execution logic 863 + - New: Hooks intercept only; execution is separate 864 + 865 + 4. **Clean up Handler module** 866 + - Current: Object-oriented handler class 867 + - New: Functional response handling via `Seq.t` 868 + 869 + ### Compatibility Notes 870 + 871 + - `Options.with_hooks` remains similar 872 + - `Client.query/receive` API stays the same 873 + - New: `Options.with_mcp_server` for custom tools 874 + - Removed: Direct tool execution callbacks 875 + 876 + --- 877 + 878 + ## Example: Complete Application 879 + 880 + ```ocaml 881 + open Eio.Std 882 + 883 + (* Define custom tools *) 884 + let calculator_add = Claude.Tool.create 885 + ~name:"add" 886 + ~description:"Add two numbers" 887 + ~input_schema:(`O [ 888 + "a", `O ["type", `String "number"]; 889 + "b", `O ["type", `String "number"]; 890 + ]) 891 + ~handler:(fun args -> 892 + match Jsont.(find_float "a" args, find_float "b" args) with 893 + | Some a, Some b -> Ok (`String (Printf.sprintf "%.2f" (a +. b))) 894 + | _ -> Error "Missing a or b parameter") 895 + 896 + let calculator_multiply = Claude.Tool.create 897 + ~name:"multiply" 898 + ~description:"Multiply two numbers" 899 + ~input_schema:(`O [ 900 + "a", `O ["type", `String "number"]; 901 + "b", `O ["type", `String "number"]; 902 + ]) 903 + ~handler:(fun args -> 904 + match Jsont.(find_float "a" args, find_float "b" args) with 905 + | Some a, Some b -> Ok (`String (Printf.sprintf "%.2f" (a *. b))) 906 + | _ -> Error "Missing a or b parameter") 907 + 908 + (* Create MCP server *) 909 + let calculator_server = Claude.Mcp_server.create 910 + ~name:"calculator" 911 + ~version:"1.0.0" 912 + ~tools:[calculator_add; calculator_multiply] 913 + () 914 + 915 + (* Define hook to block dangerous commands *) 916 + let block_dangerous_bash input = 917 + if input.Claude.Hook.PreToolUse.tool_name = "Bash" then 918 + match Claude.Tool_input.get_string input.tool_input "command" with 919 + | Some cmd when String.is_substring cmd ~substring:"rm -rf" -> 920 + Claude.Hook.PreToolUse.deny ~reason:"Dangerous command blocked" 921 + | _ -> Claude.Hook.PreToolUse.allow () 922 + else Claude.Hook.PreToolUse.allow () 923 + 924 + let hooks = Claude.Hook.Config.empty 925 + |> Claude.Hook.Config.on_pre_tool_use ~pattern:"Bash" block_dangerous_bash 926 + 927 + (* Main application *) 928 + let () = Eio_main.run @@ fun env -> 929 + Switch.run @@ fun sw -> 930 + let process_mgr = Eio.Stdenv.process_mgr env in 931 + let clock = Eio.Stdenv.clock env in 932 + 933 + let options = Claude.Options.default 934 + |> Claude.Options.with_model Claude.Model.opus 935 + |> Claude.Options.with_mcp_server ~name:"calc" calculator_server 936 + |> Claude.Options.with_allowed_tools [ 937 + "mcp__calc__add"; 938 + "mcp__calc__multiply"; 939 + "Read"; 940 + "Bash"; 941 + ] 942 + |> Claude.Options.with_hooks hooks 943 + |> Claude.Options.with_max_budget_usd 0.50 944 + in 945 + 946 + let client = Claude.Client.create ~sw ~process_mgr ~clock ~options () in 947 + 948 + (* Multi-turn conversation *) 949 + Claude.Client.query client "What is 23 + 45?"; 950 + Claude.Client.receive client |> Seq.iter (function 951 + | Claude.Response.Text t -> 952 + Printf.printf "Claude: %s\n" (Claude.Response.Text.content t) 953 + | Claude.Response.Tool_use tu -> 954 + Printf.printf "[Using tool: %s]\n" (Claude.Response.Tool_use.name tu) 955 + | Claude.Response.Complete c -> 956 + Printf.printf "[Cost: $%.4f]\n" 957 + (Option.value ~default:0.0 (Claude.Response.Complete.total_cost_usd c)) 958 + | _ -> ()); 959 + 960 + Claude.Client.query client "Now multiply that result by 2"; 961 + Claude.Client.receive_all client |> ignore 962 + ``` 963 + 964 + --- 965 + 966 + ## Implementation Priority 967 + 968 + 1. **Phase 1: Core Types** 969 + - `Tool.t`, `Mcp_server.t` 970 + - Updated `Options.t` with MCP support 971 + - `Permission_mode.t`, `Model.t` 972 + 973 + 2. **Phase 2: Internal MCP Routing** 974 + - `internal/mcp_handler.ml` 975 + - Protocol updates for MCP messages 976 + - Remove built-in tool execution from client 977 + 978 + 3. **Phase 3: Hook Simplification** 979 + - Update `Hook` module to intercept-only model 980 + - Remove tool execution from hook callbacks 981 + 982 + 4. **Phase 4: API Polish** 983 + - Simple `query` function 984 + - Documentation and examples 985 + - Error handling improvements 986 + 987 + 5. **Phase 5: Testing & Migration** 988 + - Comprehensive tests 989 + - Migration guide 990 + - Deprecation of old patterns

+4

lib/claude.ml

··· 17 17 module Transport = Transport 18 18 module Model = Model 19 19 module Proto = Proto 20 + 21 + (* New MCP-based custom tool support *) 22 + module Tool = Tool 23 + module Mcp_server = Mcp_server

+36

lib/claude.mli

··· 210 210 module Model = Model 211 211 (** Claude AI model identifiers. *) 212 212 213 + (** {1 Custom Tools (MCP)} 214 + 215 + These modules enable custom tool definitions that run in-process via MCP 216 + (Model Context Protocol). Unlike built-in tools which Claude CLI handles 217 + internally, custom tools are executed by your application. 218 + 219 + {2 Example} 220 + 221 + {[ 222 + let greet = Claude.Tool.create 223 + ~name:"greet" 224 + ~description:"Greet a user" 225 + ~input_schema:(Claude.Tool.schema_object 226 + ["name", Claude.Tool.schema_string] 227 + ~required:["name"]) 228 + ~handler:(fun args -> 229 + match Claude.Tool_input.get_string args "name" with 230 + | Some name -> Ok (Claude.Tool.text_result ("Hello, " ^ name ^ "!")) 231 + | None -> Error "Missing name") 232 + 233 + let server = Claude.Mcp_server.create 234 + ~name:"my-tools" 235 + ~tools:[greet] 236 + () 237 + 238 + let options = Claude.Options.default 239 + |> Claude.Options.with_mcp_server ~name:"tools" server 240 + |> Claude.Options.with_allowed_tools ["mcp__tools__greet"] 241 + ]} *) 242 + 243 + module Tool = Tool 244 + (** Custom tool definitions for MCP servers. *) 245 + 246 + module Mcp_server = Mcp_server 247 + (** In-process MCP servers for custom tools. *) 248 + 213 249 (** {1 Infrastructure} *) 214 250 215 251 module Transport = Transport

+76 -13

lib/client.ml

··· 60 60 control_mutex : Eio.Mutex.t; 61 61 control_condition : Eio.Condition.t; 62 62 clock : float Eio.Time.clock_ty Eio.Resource.t; 63 + (* Track tool_use_ids we've already responded to, preventing duplicates *) 64 + responded_tool_ids : (string, unit) Hashtbl.t; 65 + (* In-process MCP servers for custom tools *) 66 + mcp_servers : (string, Mcp_server.t) Hashtbl.t; 63 67 } 64 68 65 69 let session_id t = t.session_id ··· 152 156 Log.err (fun m -> m "%s" error_msg); 153 157 Transport.send t.transport 154 158 (Control_response.error ~request_id ~code:`Internal_error ~message:error_msg ())) 159 + | Sdk_control.Request.Mcp_message req -> ( 160 + (* Handle MCP request for in-process SDK servers *) 161 + let module J = Jsont.Json in 162 + let server_name = req.server_name in 163 + let message = req.message in 164 + Log.info (fun m -> m "MCP request for server '%s'" server_name); 165 + 166 + match Hashtbl.find_opt t.mcp_servers server_name with 167 + | None -> 168 + let error_msg = Printf.sprintf "MCP server '%s' not found" server_name in 169 + Log.err (fun m -> m "%s" error_msg); 170 + (* Return JSONRPC error in mcp_response format *) 171 + let mcp_error = J.object' [ 172 + J.mem (J.name "jsonrpc") (J.string "2.0"); 173 + J.mem (J.name "id") (J.null ()); 174 + J.mem (J.name "error") (J.object' [ 175 + J.mem (J.name "code") (J.number (-32601.0)); 176 + J.mem (J.name "message") (J.string error_msg) 177 + ]) 178 + ] in 179 + let response_data = J.object' [J.mem (J.name "mcp_response") mcp_error] in 180 + let response = Control_response.success ~request_id ~response:(Some response_data) in 181 + Transport.send t.transport response 182 + | Some server -> 183 + let mcp_response = Mcp_server.handle_json_message server message in 184 + Log.debug (fun m -> m "MCP response: %s" (json_to_string mcp_response)); 185 + let response_data = J.object' [J.mem (J.name "mcp_response") mcp_response] in 186 + let response = Control_response.success ~request_id ~response:(Some response_data) in 187 + Transport.send t.transport response) 155 188 | _ -> 156 189 (* Other request types not handled here *) 157 190 let error_msg = "Unsupported control request type" in ··· 253 286 let hook_callbacks = Hashtbl.create 16 in 254 287 let next_callback_id = ref 0 in 255 288 289 + (* Setup MCP servers from options *) 290 + let mcp_servers_ht = Hashtbl.create 16 in 291 + List.iter (fun (name, server) -> 292 + Log.info (fun m -> m "Registering MCP server: %s" name); 293 + Hashtbl.add mcp_servers_ht name server 294 + ) (Options.mcp_servers options); 295 + 256 296 let t = 257 297 { 258 298 transport; ··· 264 304 control_mutex = Eio.Mutex.create (); 265 305 control_condition = Eio.Condition.create (); 266 306 clock; 307 + responded_tool_ids = Hashtbl.create 16; 308 + mcp_servers = mcp_servers_ht; 267 309 } 268 310 in 269 311 ··· 329 371 send_message t msg 330 372 331 373 let respond_to_tool t ~tool_use_id ~content ?(is_error = false) () = 332 - let user_msg = Message.User.with_tool_result ~tool_use_id ~content ~is_error () in 333 - let msg = Message.User user_msg in 334 - send_message t msg 374 + (* Check for duplicate response - prevents API errors from multiple responses *) 375 + if Hashtbl.mem t.responded_tool_ids tool_use_id then begin 376 + Log.warn (fun m -> m "Skipping duplicate tool response for tool_use_id: %s" tool_use_id) 377 + end else begin 378 + Hashtbl.add t.responded_tool_ids tool_use_id (); 379 + let user_msg = Message.User.with_tool_result ~tool_use_id ~content ~is_error () in 380 + let msg = Message.User user_msg in 381 + send_message t msg 382 + end 335 383 336 384 let respond_to_tools t responses = 337 - let tool_results = 338 - List.map 339 - (fun (tool_use_id, content, is_error_opt) -> 340 - let is_error = Option.value is_error_opt ~default:false in 341 - Content_block.tool_result ~tool_use_id ~content ~is_error ()) 342 - responses 343 - in 344 - let user_msg = Message.User.of_blocks tool_results in 345 - let msg = Message.User user_msg in 346 - send_message t msg 385 + (* Filter out duplicates *) 386 + let new_responses = List.filter (fun (tool_use_id, _, _) -> 387 + if Hashtbl.mem t.responded_tool_ids tool_use_id then begin 388 + Log.warn (fun m -> m "Skipping duplicate tool response for tool_use_id: %s" tool_use_id); 389 + false 390 + end else begin 391 + Hashtbl.add t.responded_tool_ids tool_use_id (); 392 + true 393 + end 394 + ) responses in 395 + if new_responses <> [] then begin 396 + let tool_results = 397 + List.map 398 + (fun (tool_use_id, content, is_error_opt) -> 399 + let is_error = Option.value is_error_opt ~default:false in 400 + Content_block.tool_result ~tool_use_id ~content ~is_error ()) 401 + new_responses 402 + in 403 + let user_msg = Message.User.of_blocks tool_results in 404 + let msg = Message.User user_msg in 405 + send_message t msg 406 + end 407 + 408 + let clear_tool_response_tracking t = 409 + Hashtbl.clear t.responded_tool_ids 347 410 348 411 let receive t = fun () -> handle_messages t 349 412

+15

lib/client.mli

··· 85 85 (** [respond_to_tool t ~tool_use_id ~content ?is_error ()] responds to a tool 86 86 use request. 87 87 88 + {b Duplicate protection:} If the same [tool_use_id] has already been 89 + responded to, this call is silently skipped with a warning log. This 90 + prevents API errors from duplicate tool responses. 91 + 88 92 @param tool_use_id The ID from the {!Response.Tool_use.t} event 89 93 @param content The result content (can be a string or array of content blocks) 90 94 @param is_error Whether this is an error response (default: false) *) ··· 93 97 (** [respond_to_tools t responses] responds to multiple tool use requests at 94 98 once. 95 99 100 + {b Duplicate protection:} Any [tool_use_id] that has already been 101 + responded to is filtered out with a warning log. 102 + 96 103 Each tuple is [(tool_use_id, content, is_error option)] where content 97 104 can be a string or array of content blocks. 98 105 ··· 104 111 ("tool_use_456", Jsont.string "Error occurred", Some true); 105 112 ] 106 113 ]} *) 114 + 115 + val clear_tool_response_tracking : t -> unit 116 + (** [clear_tool_response_tracking t] clears the internal tracking of which 117 + tool_use_ids have been responded to. 118 + 119 + This is useful when starting a new conversation or turn where you want 120 + to allow responses to previously-seen tool IDs. Normally this is not 121 + needed as tool IDs are unique per conversation turn. *) 107 122 108 123 (** {1 Response Handling} *) 109 124

+142

lib/mcp_server.ml

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + module J = Jsont.Json 7 + 8 + type t = { 9 + name : string; 10 + version : string; 11 + tools : Tool.t list; 12 + tool_map : (string, Tool.t) Hashtbl.t; 13 + } 14 + 15 + let create ~name ?(version = "1.0.0") ~tools () = 16 + let tool_map = Hashtbl.create (List.length tools) in 17 + List.iter (fun tool -> Hashtbl.add tool_map (Tool.name tool) tool) tools; 18 + { name; version; tools; tool_map } 19 + 20 + let name t = t.name 21 + let version t = t.version 22 + let tools t = t.tools 23 + 24 + (* JSONRPC helpers using Jsont.Json builders *) 25 + 26 + let jsonrpc_success ~id result = 27 + J.object' [ 28 + J.mem (J.name "jsonrpc") (J.string "2.0"); 29 + J.mem (J.name "id") id; 30 + J.mem (J.name "result") result 31 + ] 32 + 33 + let jsonrpc_error ~id ~code ~message = 34 + J.object' [ 35 + J.mem (J.name "jsonrpc") (J.string "2.0"); 36 + J.mem (J.name "id") id; 37 + J.mem (J.name "error") (J.object' [ 38 + J.mem (J.name "code") (J.number (Float.of_int code)); 39 + J.mem (J.name "message") (J.string message) 40 + ]) 41 + ] 42 + 43 + (* Extract string from JSON *) 44 + let get_string key (obj : Jsont.json) = 45 + match obj with 46 + | Jsont.Object (mems, _) -> ( 47 + match J.find_mem key mems with 48 + | Some (_, Jsont.String (s, _)) -> Some s 49 + | _ -> None) 50 + | _ -> None 51 + 52 + (* Extract object from JSON *) 53 + let get_object key (obj : Jsont.json) : Jsont.json option = 54 + match obj with 55 + | Jsont.Object (mems, _) -> ( 56 + match J.find_mem key mems with 57 + | Some (_, (Jsont.Object _ as o)) -> Some o 58 + | _ -> None) 59 + | _ -> None 60 + 61 + (* Get ID from JSON message *) 62 + let get_id (msg : Jsont.json) : Jsont.json = 63 + match msg with 64 + | Jsont.Object (mems, _) -> ( 65 + match J.find_mem "id" mems with 66 + | Some (_, id) -> id 67 + | None -> J.null ()) 68 + | _ -> J.null () 69 + 70 + (* Handle initialize request *) 71 + let handle_initialize t ~id = 72 + jsonrpc_success ~id (J.object' [ 73 + J.mem (J.name "protocolVersion") (J.string "2024-11-05"); 74 + J.mem (J.name "capabilities") (J.object' [ 75 + J.mem (J.name "tools") (J.object' []) 76 + ]); 77 + J.mem (J.name "serverInfo") (J.object' [ 78 + J.mem (J.name "name") (J.string t.name); 79 + J.mem (J.name "version") (J.string t.version) 80 + ]) 81 + ]) 82 + 83 + (* Handle tools/list request *) 84 + let handle_tools_list t ~id = 85 + let tools_json = List.map (fun tool -> 86 + J.object' [ 87 + J.mem (J.name "name") (J.string (Tool.name tool)); 88 + J.mem (J.name "description") (J.string (Tool.description tool)); 89 + J.mem (J.name "inputSchema") (Tool.input_schema tool) 90 + ] 91 + ) t.tools in 92 + jsonrpc_success ~id (J.object' [J.mem (J.name "tools") (J.list tools_json)]) 93 + 94 + (* Handle tools/call request *) 95 + let handle_tools_call t ~id ~params = 96 + match get_string "name" params with 97 + | None -> 98 + jsonrpc_error ~id ~code:(-32602) ~message:"Missing 'name' parameter" 99 + | Some tool_name -> 100 + match Hashtbl.find_opt t.tool_map tool_name with 101 + | None -> 102 + jsonrpc_error ~id ~code:(-32601) 103 + ~message:(Printf.sprintf "Tool '%s' not found" tool_name) 104 + | Some tool -> 105 + let arguments = match get_object "arguments" params with 106 + | Some args -> args 107 + | None -> J.object' [] 108 + in 109 + let input = Tool_input.of_json arguments in 110 + match Tool.call tool input with 111 + | Ok content -> 112 + jsonrpc_success ~id (J.object' [J.mem (J.name "content") content]) 113 + | Error msg -> 114 + (* Return error as content with is_error flag *) 115 + jsonrpc_success ~id (J.object' [ 116 + J.mem (J.name "content") (J.list [J.object' [ 117 + J.mem (J.name "type") (J.string "text"); 118 + J.mem (J.name "text") (J.string msg) 119 + ]]); 120 + J.mem (J.name "isError") (J.bool true) 121 + ]) 122 + 123 + let handle_request t ~method_ ~params ~id = 124 + match method_ with 125 + | "initialize" -> handle_initialize t ~id 126 + | "tools/list" -> handle_tools_list t ~id 127 + | "tools/call" -> handle_tools_call t ~id ~params 128 + | _ -> 129 + jsonrpc_error ~id ~code:(-32601) 130 + ~message:(Printf.sprintf "Method '%s' not found" method_) 131 + 132 + let handle_json_message t (msg : Jsont.json) = 133 + let method_ = match get_string "method" msg with 134 + | Some m -> m 135 + | None -> "" 136 + in 137 + let params = match get_object "params" msg with 138 + | Some p -> p 139 + | None -> J.object' [] 140 + in 141 + let id = get_id msg in 142 + handle_request t ~method_ ~params ~id

+94

lib/mcp_server.mli

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** In-process MCP server for custom tools. 7 + 8 + SDK MCP servers run directly in your OCaml application, eliminating 9 + subprocess overhead. They handle MCP protocol requests (tools/list, 10 + tools/call) and route them to your tool handlers. 11 + 12 + {2 Basic Usage} 13 + 14 + {[ 15 + let greet = Tool.create 16 + ~name:"greet" 17 + ~description:"Greet a user" 18 + ~input_schema:(Tool.schema_object ["name", Tool.schema_string] ~required:["name"]) 19 + ~handler:(fun args -> 20 + match Tool_input.get_string args "name" with 21 + | Some name -> Ok (Tool.text_result (Printf.sprintf "Hello, %s!" name)) 22 + | None -> Error "Missing name") 23 + 24 + let server = Mcp_server.create 25 + ~name:"my-tools" 26 + ~tools:[greet] 27 + () 28 + 29 + let options = Options.default 30 + |> Options.with_mcp_server ~name:"tools" server 31 + |> Options.with_allowed_tools ["mcp__tools__greet"] 32 + ]} 33 + 34 + {2 Tool Naming} 35 + 36 + When you register an MCP server with name "foo" containing a tool "bar", 37 + the full tool name becomes [mcp__foo__bar]. This is how Claude CLI 38 + routes MCP tool calls. 39 + 40 + {2 Protocol} 41 + 42 + The server handles these MCP JSONRPC methods: 43 + - [initialize]: Returns server capabilities 44 + - [tools/list]: Returns available tools with schemas 45 + - [tools/call]: Executes a tool and returns result *) 46 + 47 + type t 48 + (** Abstract type for MCP servers. *) 49 + 50 + val create : 51 + name:string -> 52 + ?version:string -> 53 + tools:Tool.t list -> 54 + unit -> 55 + t 56 + (** [create ~name ?version ~tools ()] creates an in-process MCP server. 57 + 58 + @param name Server identifier. Used in tool naming: [mcp__<name>__<tool>]. 59 + @param version Server version string (default "1.0.0"). 60 + @param tools List of tools this server provides. *) 61 + 62 + val name : t -> string 63 + (** [name t] returns the server name. *) 64 + 65 + val version : t -> string 66 + (** [version t] returns the server version. *) 67 + 68 + val tools : t -> Tool.t list 69 + (** [tools t] returns the list of registered tools. *) 70 + 71 + (** {1 MCP Protocol Handling} *) 72 + 73 + val handle_request : 74 + t -> 75 + method_:string -> 76 + params:Jsont.json -> 77 + id:Jsont.json -> 78 + Jsont.json 79 + (** [handle_request t ~method_ ~params ~id] handles an MCP JSONRPC request. 80 + 81 + Returns a JSONRPC response object with the given [id]. 82 + 83 + Supported methods: 84 + - ["initialize"]: Returns server capabilities (tools only) 85 + - ["tools/list"]: Returns list of available tools 86 + - ["tools/call"]: Executes tool, params must have "name" and "arguments" 87 + 88 + Unknown methods return a JSONRPC error response. *) 89 + 90 + val handle_json_message : t -> Jsont.json -> Jsont.json 91 + (** [handle_json_message t msg] handles a complete JSONRPC message. 92 + 93 + Extracts method, params, and id from the message and delegates 94 + to {!handle_request}. *)

+6

lib/options.ml

··· 33 33 max_buffer_size : int option; 34 34 user : string option; 35 35 output_format : Proto.Structured_output.t option; 36 + mcp_servers : (string * Mcp_server.t) list; 36 37 } 37 38 38 39 let default = ··· 62 63 max_buffer_size = None; 63 64 user = None; 64 65 output_format = None; 66 + mcp_servers = []; 65 67 } 66 68 67 69 (* Accessors *) ··· 90 92 let max_buffer_size t = t.max_buffer_size 91 93 let user t = t.user 92 94 let output_format t = t.output_format 95 + let mcp_servers t = t.mcp_servers 93 96 94 97 (* Builders *) 95 98 let with_allowed_tools tools t = { t with allowed_tools = tools } ··· 131 134 let with_max_buffer_size size t = { t with max_buffer_size = Some size } 132 135 let with_user user t = { t with user = Some user } 133 136 let with_output_format format t = { t with output_format = Some format } 137 + 138 + let with_mcp_server ~name server t = 139 + { t with mcp_servers = (name, server) :: t.mcp_servers } 134 140 135 141 let log_options t = 136 142 Log.debug (fun m ->

+9

lib/options.mli

··· 181 181 val with_extra_args : (string * string option) list -> t -> t 182 182 (** [with_extra_args args t] sets the additional CLI flags. *) 183 183 184 + val with_mcp_server : name:string -> Mcp_server.t -> t -> t 185 + (** [with_mcp_server ~name server t] adds an in-process MCP server. 186 + 187 + Multiple servers can be added. Tools from server "foo" are accessed as 188 + [mcp__foo__<tool_name>]. *) 189 + 184 190 (** {1 Accessors} *) 185 191 186 192 val allowed_tools : t -> string list ··· 259 265 260 266 val extra_args : t -> (string * string option) list 261 267 (** [extra_args t] returns the additional CLI flags. *) 268 + 269 + val mcp_servers : t -> (string * Mcp_server.t) list 270 + (** [mcp_servers t] returns the list of in-process MCP servers. *) 262 271 263 272 (** {1 Logging} *) 264 273

+66

lib/tool.ml

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + module J = Jsont.Json 7 + 8 + type t = { 9 + name : string; 10 + description : string; 11 + input_schema : Jsont.json; 12 + handler : Tool_input.t -> (Jsont.json, string) result; 13 + } 14 + 15 + let create ~name ~description ~input_schema ~handler = 16 + { name; description; input_schema; handler } 17 + 18 + let name t = t.name 19 + let description t = t.description 20 + let input_schema t = t.input_schema 21 + let call t input = t.handler input 22 + 23 + (* Convenience constructors using Jsont.Json builders *) 24 + 25 + let text_result s = 26 + J.list [ 27 + J.object' [ 28 + J.mem (J.name "type") (J.string "text"); 29 + J.mem (J.name "text") (J.string s) 30 + ] 31 + ] 32 + 33 + let error_result s = 34 + J.list [ 35 + J.object' [ 36 + J.mem (J.name "type") (J.string "text"); 37 + J.mem (J.name "text") (J.string s); 38 + J.mem (J.name "is_error") (J.bool true) 39 + ] 40 + ] 41 + 42 + (* Schema helpers *) 43 + 44 + let schema_string = J.object' [J.mem (J.name "type") (J.string "string")] 45 + let schema_int = J.object' [J.mem (J.name "type") (J.string "integer")] 46 + let schema_number = J.object' [J.mem (J.name "type") (J.string "number")] 47 + let schema_bool = J.object' [J.mem (J.name "type") (J.string "boolean")] 48 + 49 + let schema_array item_schema = 50 + J.object' [ 51 + J.mem (J.name "type") (J.string "array"); 52 + J.mem (J.name "items") item_schema 53 + ] 54 + 55 + let schema_string_enum values = 56 + J.object' [ 57 + J.mem (J.name "type") (J.string "string"); 58 + J.mem (J.name "enum") (J.list (List.map J.string values)) 59 + ] 60 + 61 + let schema_object props ~required = 62 + J.object' [ 63 + J.mem (J.name "type") (J.string "object"); 64 + J.mem (J.name "properties") (J.object' (List.map (fun (k, v) -> J.mem (J.name k) v) props)); 65 + J.mem (J.name "required") (J.list (List.map J.string required)) 66 + ]

+114

lib/tool.mli

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Custom tool definitions for MCP servers. 7 + 8 + Tools are functions that Claude can invoke. They run in-process within 9 + your OCaml application via the MCP (Model Context Protocol). 10 + 11 + {2 Basic Usage} 12 + 13 + {[ 14 + let greet = Tool.create 15 + ~name:"greet" 16 + ~description:"Greet a user by name" 17 + ~input_schema:(`O [ 18 + "type", `String "object"; 19 + "properties", `O [ 20 + "name", `O ["type", `String "string"] 21 + ]; 22 + "required", `A [`String "name"] 23 + ]) 24 + ~handler:(fun args -> 25 + match Tool_input.get_string args "name" with 26 + | Some name -> Ok (`A [`O ["type", `String "text"; 27 + "text", `String (Printf.sprintf "Hello, %s!" name)]]) 28 + | None -> Error "Missing 'name' parameter") 29 + ]} 30 + 31 + {2 Tool Response Format} 32 + 33 + Tool handlers return MCP-compatible content: 34 + - Success: [Ok content] where content is JSON array of content blocks 35 + - Error: [Error message] for error responses 36 + 37 + Content blocks are typically: 38 + {[ 39 + `A [`O ["type", `String "text"; "text", `String "result"]] 40 + ]} *) 41 + 42 + type t 43 + (** Abstract type for tool definitions. *) 44 + 45 + val create : 46 + name:string -> 47 + description:string -> 48 + input_schema:Jsont.json -> 49 + handler:(Tool_input.t -> (Jsont.json, string) result) -> 50 + t 51 + (** [create ~name ~description ~input_schema ~handler] creates a custom tool. 52 + 53 + @param name Unique tool identifier. Claude uses this in function calls. 54 + When registered with an MCP server named "foo", the full tool name 55 + becomes [mcp__foo__<name>]. 56 + @param description Human-readable description. Helps Claude understand 57 + when to use the tool. 58 + @param input_schema JSON Schema defining input parameters. Should be 59 + a valid JSON Schema object with "type", "properties", etc. 60 + @param handler Function that executes the tool. Receives tool input, 61 + returns content array or error message. *) 62 + 63 + val name : t -> string 64 + (** [name t] returns the tool's name. *) 65 + 66 + val description : t -> string 67 + (** [description t] returns the tool's description. *) 68 + 69 + val input_schema : t -> Jsont.json 70 + (** [input_schema t] returns the JSON Schema for inputs. *) 71 + 72 + val call : t -> Tool_input.t -> (Jsont.json, string) result 73 + (** [call t input] invokes the tool handler with the given input. *) 74 + 75 + (** {1 Convenience Constructors} 76 + 77 + Helper functions for common tool patterns. *) 78 + 79 + val text_result : string -> Jsont.json 80 + (** [text_result s] creates a text content result: 81 + [\`A [\`O ["type", \`String "text"; "text", \`String s]]] *) 82 + 83 + val error_result : string -> Jsont.json 84 + (** [error_result s] creates an error content result with is_error flag. *) 85 + 86 + (** {2 Schema Helpers} 87 + 88 + Build JSON Schema objects more easily. *) 89 + 90 + val schema_object : (string * Jsont.json) list -> required:string list -> Jsont.json 91 + (** [schema_object props ~required] creates an object schema. 92 + {[ 93 + schema_object 94 + ["name", schema_string; "age", schema_int] 95 + ~required:["name"] 96 + ]} *) 97 + 98 + val schema_string : Jsont.json 99 + (** String type schema: [{"type": "string"}] *) 100 + 101 + val schema_int : Jsont.json 102 + (** Integer type schema: [{"type": "integer"}] *) 103 + 104 + val schema_number : Jsont.json 105 + (** Number type schema: [{"type": "number"}] *) 106 + 107 + val schema_bool : Jsont.json 108 + (** Boolean type schema: [{"type": "boolean"}] *) 109 + 110 + val schema_array : Jsont.json -> Jsont.json 111 + (** [schema_array item_schema] creates array schema with given item type. *) 112 + 113 + val schema_string_enum : string list -> Jsont.json 114 + (** [schema_string_enum values] creates enum schema for string values. *)

+6

test/dune

··· 3 3 (modules test_json_utils) 4 4 (libraries jsont jsont.bytesrw)) 5 5 6 + ; Consolidated unit test suite using alcotest 7 + (test 8 + (name test_claude) 9 + (modules test_claude) 10 + (libraries claude alcotest jsont.bytesrw)) 11 + 6 12 (executable 7 13 (public_name camel_jokes) 8 14 (name camel_jokes)

+472

test/test_claude.ml

··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Consolidated unit tests for the Claude OCaml SDK. 7 + 8 + This test suite covers: 9 + - Protocol message encoding/decoding 10 + - Tool module for custom tool definitions 11 + - Mcp_server module for in-process MCP servers 12 + - Structured error handling *) 13 + 14 + module J = Jsont.Json 15 + 16 + (* ============================================ 17 + Protocol Tests - Incoming message codec 18 + ============================================ *) 19 + 20 + let test_decode_user_message () = 21 + (* User messages from CLI come wrapped in a "message" envelope *) 22 + let json_str = {|{"type":"user","message":{"content":"Hello"}}|} in 23 + match Jsont_bytesrw.decode_string' Claude.Proto.Incoming.jsont json_str with 24 + | Ok (Claude.Proto.Incoming.Message (Claude.Proto.Message.User _)) -> () 25 + | Ok _ -> Alcotest.fail "Wrong message type decoded" 26 + | Error err -> Alcotest.fail (Jsont.Error.to_string err) 27 + 28 + let test_decode_assistant_message () = 29 + (* Assistant messages from CLI come wrapped in a "message" envelope *) 30 + let json_str = 31 + {|{"type":"assistant","message":{"model":"claude-sonnet-4","content":[{"type":"text","text":"Hi"}]}}|} 32 + in 33 + match Jsont_bytesrw.decode_string' Claude.Proto.Incoming.jsont json_str with 34 + | Ok (Claude.Proto.Incoming.Message (Claude.Proto.Message.Assistant _)) -> () 35 + | Ok _ -> Alcotest.fail "Wrong message type decoded" 36 + | Error err -> Alcotest.fail (Jsont.Error.to_string err) 37 + 38 + let test_decode_system_message () = 39 + let json_str = 40 + {|{"type":"system","subtype":"init","data":{"session_id":"test-123"}}|} 41 + in 42 + match Jsont_bytesrw.decode_string' Claude.Proto.Incoming.jsont json_str with 43 + | Ok (Claude.Proto.Incoming.Message (Claude.Proto.Message.System _)) -> () 44 + | Ok _ -> Alcotest.fail "Wrong message type decoded" 45 + | Error err -> Alcotest.fail (Jsont.Error.to_string err) 46 + 47 + let test_decode_control_response_success () = 48 + let json_str = 49 + {|{"type":"control_response","response":{"subtype":"success","requestId":"test-req-1"}}|} 50 + in 51 + match Jsont_bytesrw.decode_string' Claude.Proto.Incoming.jsont json_str with 52 + | Ok (Claude.Proto.Incoming.Control_response resp) -> ( 53 + match resp.response with 54 + | Claude.Proto.Control.Response.Success s -> 55 + Alcotest.(check string) "request_id" "test-req-1" s.request_id 56 + | Claude.Proto.Control.Response.Error _ -> 57 + Alcotest.fail "Got error response instead of success") 58 + | Ok _ -> Alcotest.fail "Wrong message type decoded" 59 + | Error err -> Alcotest.fail (Jsont.Error.to_string err) 60 + 61 + let test_decode_control_response_error () = 62 + let json_str = 63 + {|{"type":"control_response","response":{"subtype":"error","requestId":"test-req-2","error":{"code":-32603,"message":"Something went wrong"}}}|} 64 + in 65 + match Jsont_bytesrw.decode_string' Claude.Proto.Incoming.jsont json_str with 66 + | Ok (Claude.Proto.Incoming.Control_response resp) -> ( 67 + match resp.response with 68 + | Claude.Proto.Control.Response.Error e -> 69 + Alcotest.(check string) "request_id" "test-req-2" e.request_id; 70 + Alcotest.(check int) "error code" (-32603) e.error.code; 71 + Alcotest.(check string) "error message" "Something went wrong" e.error.message 72 + | Claude.Proto.Control.Response.Success _ -> 73 + Alcotest.fail "Got success response instead of error") 74 + | Ok _ -> Alcotest.fail "Wrong message type decoded" 75 + | Error err -> Alcotest.fail (Jsont.Error.to_string err) 76 + 77 + let protocol_tests = [ 78 + Alcotest.test_case "decode user message" `Quick test_decode_user_message; 79 + Alcotest.test_case "decode assistant message" `Quick test_decode_assistant_message; 80 + Alcotest.test_case "decode system message" `Quick test_decode_system_message; 81 + Alcotest.test_case "decode control response success" `Quick test_decode_control_response_success; 82 + Alcotest.test_case "decode control response error" `Quick test_decode_control_response_error; 83 + ] 84 + 85 + (* ============================================ 86 + Tool Module Tests 87 + ============================================ *) 88 + 89 + let json_testable = Alcotest.testable 90 + (fun fmt json -> 91 + match Jsont_bytesrw.encode_string' Jsont.json json with 92 + | Ok s -> Format.pp_print_string fmt s 93 + | Error e -> Format.pp_print_string fmt (Jsont.Error.to_string e)) 94 + (fun a b -> 95 + match Jsont_bytesrw.encode_string' Jsont.json a, Jsont_bytesrw.encode_string' Jsont.json b with 96 + | Ok sa, Ok sb -> String.equal sa sb 97 + | _ -> false) 98 + 99 + let test_tool_schema_string () = 100 + let schema = Claude.Tool.schema_string in 101 + let expected = J.object' [J.mem (J.name "type") (J.string "string")] in 102 + Alcotest.check json_testable "schema_string" expected schema 103 + 104 + let test_tool_schema_int () = 105 + let schema = Claude.Tool.schema_int in 106 + let expected = J.object' [J.mem (J.name "type") (J.string "integer")] in 107 + Alcotest.check json_testable "schema_int" expected schema 108 + 109 + let test_tool_schema_number () = 110 + let schema = Claude.Tool.schema_number in 111 + let expected = J.object' [J.mem (J.name "type") (J.string "number")] in 112 + Alcotest.check json_testable "schema_number" expected schema 113 + 114 + let test_tool_schema_bool () = 115 + let schema = Claude.Tool.schema_bool in 116 + let expected = J.object' [J.mem (J.name "type") (J.string "boolean")] in 117 + Alcotest.check json_testable "schema_bool" expected schema 118 + 119 + let test_tool_schema_array () = 120 + let schema = Claude.Tool.schema_array Claude.Tool.schema_string in 121 + let expected = J.object' [ 122 + J.mem (J.name "type") (J.string "array"); 123 + J.mem (J.name "items") (J.object' [J.mem (J.name "type") (J.string "string")]) 124 + ] in 125 + Alcotest.check json_testable "schema_array" expected schema 126 + 127 + let test_tool_schema_string_enum () = 128 + let schema = Claude.Tool.schema_string_enum ["foo"; "bar"; "baz"] in 129 + let expected = J.object' [ 130 + J.mem (J.name "type") (J.string "string"); 131 + J.mem (J.name "enum") (J.list [J.string "foo"; J.string "bar"; J.string "baz"]) 132 + ] in 133 + Alcotest.check json_testable "schema_string_enum" expected schema 134 + 135 + let test_tool_schema_object () = 136 + let schema = Claude.Tool.schema_object 137 + [("name", Claude.Tool.schema_string); ("age", Claude.Tool.schema_int)] 138 + ~required:["name"] 139 + in 140 + let expected = J.object' [ 141 + J.mem (J.name "type") (J.string "object"); 142 + J.mem (J.name "properties") (J.object' [ 143 + J.mem (J.name "name") (J.object' [J.mem (J.name "type") (J.string "string")]); 144 + J.mem (J.name "age") (J.object' [J.mem (J.name "type") (J.string "integer")]) 145 + ]); 146 + J.mem (J.name "required") (J.list [J.string "name"]) 147 + ] in 148 + Alcotest.check json_testable "schema_object" expected schema 149 + 150 + let test_tool_text_result () = 151 + let result = Claude.Tool.text_result "Hello, world!" in 152 + let expected = J.list [J.object' [ 153 + J.mem (J.name "type") (J.string "text"); 154 + J.mem (J.name "text") (J.string "Hello, world!") 155 + ]] in 156 + Alcotest.check json_testable "text_result" expected result 157 + 158 + let test_tool_error_result () = 159 + let result = Claude.Tool.error_result "Something went wrong" in 160 + let expected = J.list [J.object' [ 161 + J.mem (J.name "type") (J.string "text"); 162 + J.mem (J.name "text") (J.string "Something went wrong"); 163 + J.mem (J.name "is_error") (J.bool true) 164 + ]] in 165 + Alcotest.check json_testable "error_result" expected result 166 + 167 + let test_tool_create_and_call () = 168 + let greet = Claude.Tool.create 169 + ~name:"greet" 170 + ~description:"Greet a user" 171 + ~input_schema:(Claude.Tool.schema_object 172 + [("name", Claude.Tool.schema_string)] 173 + ~required:["name"]) 174 + ~handler:(fun args -> 175 + match Claude.Tool_input.get_string args "name" with 176 + | Some name -> Ok (Claude.Tool.text_result ("Hello, " ^ name ^ "!")) 177 + | None -> Error "Missing name parameter") 178 + in 179 + Alcotest.(check string) "tool name" "greet" (Claude.Tool.name greet); 180 + Alcotest.(check string) "tool description" "Greet a user" (Claude.Tool.description greet); 181 + 182 + (* Test successful call *) 183 + let input_json = J.object' [J.mem (J.name "name") (J.string "Alice")] in 184 + let input = Claude.Tool_input.of_json input_json in 185 + match Claude.Tool.call greet input with 186 + | Ok result -> 187 + let expected = Claude.Tool.text_result "Hello, Alice!" in 188 + Alcotest.check json_testable "call result" expected result 189 + | Error msg -> 190 + Alcotest.fail msg 191 + 192 + let test_tool_call_error () = 193 + let tool = Claude.Tool.create 194 + ~name:"fail" 195 + ~description:"Always fails" 196 + ~input_schema:(Claude.Tool.schema_object [] ~required:[]) 197 + ~handler:(fun _ -> Error "Intentional failure") 198 + in 199 + let input = Claude.Tool_input.of_json (J.object' []) in 200 + match Claude.Tool.call tool input with 201 + | Ok _ -> Alcotest.fail "Expected error" 202 + | Error msg -> Alcotest.(check string) "error message" "Intentional failure" msg 203 + 204 + let tool_tests = [ 205 + Alcotest.test_case "schema_string" `Quick test_tool_schema_string; 206 + Alcotest.test_case "schema_int" `Quick test_tool_schema_int; 207 + Alcotest.test_case "schema_number" `Quick test_tool_schema_number; 208 + Alcotest.test_case "schema_bool" `Quick test_tool_schema_bool; 209 + Alcotest.test_case "schema_array" `Quick test_tool_schema_array; 210 + Alcotest.test_case "schema_string_enum" `Quick test_tool_schema_string_enum; 211 + Alcotest.test_case "schema_object" `Quick test_tool_schema_object; 212 + Alcotest.test_case "text_result" `Quick test_tool_text_result; 213 + Alcotest.test_case "error_result" `Quick test_tool_error_result; 214 + Alcotest.test_case "create and call" `Quick test_tool_create_and_call; 215 + Alcotest.test_case "call error" `Quick test_tool_call_error; 216 + ] 217 + 218 + (* ============================================ 219 + Mcp_server Module Tests 220 + ============================================ *) 221 + 222 + let test_mcp_server_create () = 223 + let tool = Claude.Tool.create 224 + ~name:"echo" 225 + ~description:"Echo input" 226 + ~input_schema:(Claude.Tool.schema_object [("text", Claude.Tool.schema_string)] ~required:["text"]) 227 + ~handler:(fun args -> 228 + match Claude.Tool_input.get_string args "text" with 229 + | Some text -> Ok (Claude.Tool.text_result text) 230 + | None -> Error "Missing text") 231 + in 232 + let server = Claude.Mcp_server.create ~name:"test-server" ~version:"2.0.0" ~tools:[tool] () in 233 + Alcotest.(check string) "server name" "test-server" (Claude.Mcp_server.name server); 234 + Alcotest.(check string) "server version" "2.0.0" (Claude.Mcp_server.version server); 235 + Alcotest.(check int) "tools count" 1 (List.length (Claude.Mcp_server.tools server)) 236 + 237 + let test_mcp_server_initialize () = 238 + let server = Claude.Mcp_server.create ~name:"init-test" ~tools:[] () in 239 + let request = J.object' [ 240 + J.mem (J.name "jsonrpc") (J.string "2.0"); 241 + J.mem (J.name "id") (J.number 1.0); 242 + J.mem (J.name "method") (J.string "initialize"); 243 + J.mem (J.name "params") (J.object' []) 244 + ] in 245 + let response = Claude.Mcp_server.handle_json_message server request in 246 + (* Check it's a success response with serverInfo *) 247 + match response with 248 + | Jsont.Object (mems, _) -> 249 + let has_result = List.exists (fun ((k, _), _) -> k = "result") mems in 250 + Alcotest.(check bool) "has result" true has_result 251 + | _ -> Alcotest.fail "Expected object response" 252 + 253 + let test_mcp_server_tools_list () = 254 + let tool = Claude.Tool.create 255 + ~name:"my_tool" 256 + ~description:"My test tool" 257 + ~input_schema:(Claude.Tool.schema_object [] ~required:[]) 258 + ~handler:(fun _ -> Ok (Claude.Tool.text_result "ok")) 259 + in 260 + let server = Claude.Mcp_server.create ~name:"list-test" ~tools:[tool] () in 261 + let request = J.object' [ 262 + J.mem (J.name "jsonrpc") (J.string "2.0"); 263 + J.mem (J.name "id") (J.number 2.0); 264 + J.mem (J.name "method") (J.string "tools/list"); 265 + J.mem (J.name "params") (J.object' []) 266 + ] in 267 + let response = Claude.Mcp_server.handle_json_message server request in 268 + match response with 269 + | Jsont.Object (mems, _) -> ( 270 + match List.find_opt (fun ((k, _), _) -> k = "result") mems with 271 + | Some (_, Jsont.Object (result_mems, _)) -> ( 272 + match List.find_opt (fun ((k, _), _) -> k = "tools") result_mems with 273 + | Some (_, Jsont.Array (tools, _)) -> 274 + Alcotest.(check int) "tools count" 1 (List.length tools) 275 + | _ -> Alcotest.fail "Missing tools in result") 276 + | _ -> Alcotest.fail "Missing result in response") 277 + | _ -> Alcotest.fail "Expected object response" 278 + 279 + let test_mcp_server_tools_call () = 280 + let tool = Claude.Tool.create 281 + ~name:"uppercase" 282 + ~description:"Convert to uppercase" 283 + ~input_schema:(Claude.Tool.schema_object [("text", Claude.Tool.schema_string)] ~required:["text"]) 284 + ~handler:(fun args -> 285 + match Claude.Tool_input.get_string args "text" with 286 + | Some text -> Ok (Claude.Tool.text_result (String.uppercase_ascii text)) 287 + | None -> Error "Missing text") 288 + in 289 + let server = Claude.Mcp_server.create ~name:"call-test" ~tools:[tool] () in 290 + let request = J.object' [ 291 + J.mem (J.name "jsonrpc") (J.string "2.0"); 292 + J.mem (J.name "id") (J.number 3.0); 293 + J.mem (J.name "method") (J.string "tools/call"); 294 + J.mem (J.name "params") (J.object' [ 295 + J.mem (J.name "name") (J.string "uppercase"); 296 + J.mem (J.name "arguments") (J.object' [ 297 + J.mem (J.name "text") (J.string "hello") 298 + ]) 299 + ]) 300 + ] in 301 + let response = Claude.Mcp_server.handle_json_message server request in 302 + (* Verify it contains the expected uppercase result *) 303 + let response_str = match Jsont_bytesrw.encode_string' Jsont.json response with 304 + | Ok s -> s | Error _ -> "" 305 + in 306 + (* Simple substring check for HELLO in response *) 307 + let contains_hello = 308 + let rec check i = 309 + if i + 5 > String.length response_str then false 310 + else if String.sub response_str i 5 = "HELLO" then true 311 + else check (i + 1) 312 + in check 0 313 + in 314 + Alcotest.(check bool) "contains HELLO" true contains_hello 315 + 316 + let test_mcp_server_tool_not_found () = 317 + let server = Claude.Mcp_server.create ~name:"notfound-test" ~tools:[] () in 318 + let request = J.object' [ 319 + J.mem (J.name "jsonrpc") (J.string "2.0"); 320 + J.mem (J.name "id") (J.number 4.0); 321 + J.mem (J.name "method") (J.string "tools/call"); 322 + J.mem (J.name "params") (J.object' [ 323 + J.mem (J.name "name") (J.string "nonexistent") 324 + ]) 325 + ] in 326 + let response = Claude.Mcp_server.handle_json_message server request in 327 + (* Should return an error response *) 328 + match response with 329 + | Jsont.Object (mems, _) -> 330 + let has_error = List.exists (fun ((k, _), _) -> k = "error") mems in 331 + Alcotest.(check bool) "has error" true has_error 332 + | _ -> Alcotest.fail "Expected object response" 333 + 334 + let test_mcp_server_method_not_found () = 335 + let server = Claude.Mcp_server.create ~name:"method-notfound-test" ~tools:[] () in 336 + let request = J.object' [ 337 + J.mem (J.name "jsonrpc") (J.string "2.0"); 338 + J.mem (J.name "id") (J.number 5.0); 339 + J.mem (J.name "method") (J.string "unknown/method"); 340 + J.mem (J.name "params") (J.object' []) 341 + ] in 342 + let response = Claude.Mcp_server.handle_json_message server request in 343 + match response with 344 + | Jsont.Object (mems, _) -> 345 + let has_error = List.exists (fun ((k, _), _) -> k = "error") mems in 346 + Alcotest.(check bool) "has error" true has_error 347 + | _ -> Alcotest.fail "Expected object response" 348 + 349 + let mcp_server_tests = [ 350 + Alcotest.test_case "create server" `Quick test_mcp_server_create; 351 + Alcotest.test_case "initialize" `Quick test_mcp_server_initialize; 352 + Alcotest.test_case "tools/list" `Quick test_mcp_server_tools_list; 353 + Alcotest.test_case "tools/call" `Quick test_mcp_server_tools_call; 354 + Alcotest.test_case "tool not found" `Quick test_mcp_server_tool_not_found; 355 + Alcotest.test_case "method not found" `Quick test_mcp_server_method_not_found; 356 + ] 357 + 358 + (* ============================================ 359 + Structured Error Tests 360 + ============================================ *) 361 + 362 + let test_error_detail_creation () = 363 + let error = Claude.Proto.Control.Response.error_detail 364 + ~code:`Method_not_found 365 + ~message:"Method not found" 366 + () 367 + in 368 + Alcotest.(check int) "error code" (-32601) error.code; 369 + Alcotest.(check string) "error message" "Method not found" error.message 370 + 371 + let test_error_code_conventions () = 372 + let codes = [ 373 + (`Parse_error, -32700); 374 + (`Invalid_request, -32600); 375 + (`Method_not_found, -32601); 376 + (`Invalid_params, -32602); 377 + (`Internal_error, -32603); 378 + (`Custom 1, 1); 379 + ] in 380 + List.iter (fun (code, expected_int) -> 381 + let err = Claude.Proto.Control.Response.error_detail ~code ~message:"test" () in 382 + Alcotest.(check int) "error code value" expected_int err.code 383 + ) codes 384 + 385 + let test_error_response_encoding () = 386 + let error_detail = Claude.Proto.Control.Response.error_detail 387 + ~code:`Invalid_params 388 + ~message:"Invalid parameters" 389 + () 390 + in 391 + let error_resp = Claude.Proto.Control.Response.error 392 + ~request_id:"test-123" 393 + ~error:error_detail 394 + () 395 + in 396 + match Jsont.Json.encode Claude.Proto.Control.Response.jsont error_resp with 397 + | Ok json -> ( 398 + match Jsont.Json.decode Claude.Proto.Control.Response.jsont json with 399 + | Ok (Claude.Proto.Control.Response.Error decoded) -> 400 + Alcotest.(check string) "request_id" "test-123" decoded.request_id; 401 + Alcotest.(check int) "error code" (-32602) decoded.error.code; 402 + Alcotest.(check string) "error message" "Invalid parameters" decoded.error.message 403 + | Ok _ -> Alcotest.fail "Wrong response type decoded" 404 + | Error e -> Alcotest.fail e) 405 + | Error e -> Alcotest.fail e 406 + 407 + let structured_error_tests = [ 408 + Alcotest.test_case "error detail creation" `Quick test_error_detail_creation; 409 + Alcotest.test_case "error code conventions" `Quick test_error_code_conventions; 410 + Alcotest.test_case "error response encoding" `Quick test_error_response_encoding; 411 + ] 412 + 413 + (* ============================================ 414 + Tool_input Tests 415 + ============================================ *) 416 + 417 + let test_tool_input_get_string () = 418 + let json = J.object' [J.mem (J.name "foo") (J.string "bar")] in 419 + let input = Claude.Tool_input.of_json json in 420 + Alcotest.(check (option string)) "get_string foo" (Some "bar") (Claude.Tool_input.get_string input "foo"); 421 + Alcotest.(check (option string)) "get_string missing" None (Claude.Tool_input.get_string input "missing") 422 + 423 + let test_tool_input_get_int () = 424 + let json = J.object' [J.mem (J.name "count") (J.number 42.0)] in 425 + let input = Claude.Tool_input.of_json json in 426 + Alcotest.(check (option int)) "get_int count" (Some 42) (Claude.Tool_input.get_int input "count") 427 + 428 + let test_tool_input_get_float () = 429 + let json = J.object' [J.mem (J.name "pi") (J.number 3.14159)] in 430 + let input = Claude.Tool_input.of_json json in 431 + match Claude.Tool_input.get_float input "pi" with 432 + | Some f -> Alcotest.(check bool) "get_float pi approx" true (abs_float (f -. 3.14159) < 0.0001) 433 + | None -> Alcotest.fail "Expected float" 434 + 435 + let test_tool_input_get_bool () = 436 + let json = J.object' [ 437 + J.mem (J.name "yes") (J.bool true); 438 + J.mem (J.name "no") (J.bool false) 439 + ] in 440 + let input = Claude.Tool_input.of_json json in 441 + Alcotest.(check (option bool)) "get_bool yes" (Some true) (Claude.Tool_input.get_bool input "yes"); 442 + Alcotest.(check (option bool)) "get_bool no" (Some false) (Claude.Tool_input.get_bool input "no") 443 + 444 + let test_tool_input_get_string_list () = 445 + let json = J.object' [ 446 + J.mem (J.name "items") (J.list [J.string "a"; J.string "b"; J.string "c"]) 447 + ] in 448 + let input = Claude.Tool_input.of_json json in 449 + Alcotest.(check (option (list string))) "get_string_list" 450 + (Some ["a"; "b"; "c"]) 451 + (Claude.Tool_input.get_string_list input "items") 452 + 453 + let tool_input_tests = [ 454 + Alcotest.test_case "get_string" `Quick test_tool_input_get_string; 455 + Alcotest.test_case "get_int" `Quick test_tool_input_get_int; 456 + Alcotest.test_case "get_float" `Quick test_tool_input_get_float; 457 + Alcotest.test_case "get_bool" `Quick test_tool_input_get_bool; 458 + Alcotest.test_case "get_string_list" `Quick test_tool_input_get_string_list; 459 + ] 460 + 461 + (* ============================================ 462 + Main test runner 463 + ============================================ *) 464 + 465 + let () = 466 + Alcotest.run "Claude SDK" [ 467 + "Protocol", protocol_tests; 468 + "Tool", tool_tests; 469 + "Mcp_server", mcp_server_tests; 470 + "Structured errors", structured_error_tests; 471 + "Tool_input", tool_input_tests; 472 + ]