OCaml Claude SDK using Eio and Jsont

structured errors

+485 -51
+15 -12
lib/client.ml
··· 15 15 Jsont.Json.encode Sdk_control.jsont ctrl 16 16 |> Err.get_ok ~msg:"Control_response.success: " 17 17 18 - let error ~request_id ~message = 19 - let resp = Sdk_control.Response.error ~request_id ~error:message () in 18 + let error ~request_id ~code ~message ?data () = 19 + let error_detail = Sdk_control.Response.error_detail ~code ~message ?data () in 20 + let resp = Sdk_control.Response.error ~request_id ~error:error_detail () in 20 21 let ctrl = Sdk_control.create_response ~response:resp () in 21 22 Jsont.Json.encode Sdk_control.jsont ctrl 22 23 |> Err.get_ok ~msg:"Control_response.error: " ··· 58 59 control_responses : (string, Jsont.json) Hashtbl.t; 59 60 control_mutex : Eio.Mutex.t; 60 61 control_condition : Eio.Condition.t; 62 + clock : float Eio.Time.clock_ty Eio.Resource.t; 61 63 } 62 64 63 65 let session_id t = t.session_id ··· 142 144 in 143 145 Log.err (fun m -> m "%s" error_msg); 144 146 Transport.send t.transport 145 - (Control_response.error ~request_id ~message:error_msg) 147 + (Control_response.error ~request_id ~code:`Method_not_found ~message:error_msg ()) 146 148 | exn -> 147 149 let error_msg = 148 150 Printf.sprintf "Hook callback error: %s" (Printexc.to_string exn) 149 151 in 150 152 Log.err (fun m -> m "%s" error_msg); 151 153 Transport.send t.transport 152 - (Control_response.error ~request_id ~message:error_msg)) 154 + (Control_response.error ~request_id ~code:`Internal_error ~message:error_msg ())) 153 155 | _ -> 154 156 (* Other request types not handled here *) 155 157 let error_msg = "Unsupported control request type" in 156 158 Transport.send t.transport 157 - (Control_response.error ~request_id ~message:error_msg) 159 + (Control_response.error ~request_id ~code:`Invalid_request ~message:error_msg ()) 158 160 159 161 let handle_control_response t control_resp = 160 162 let request_id = ··· 235 237 in 236 238 loop raw_seq 237 239 238 - let create ?(options = Options.default) ~sw ~process_mgr () = 240 + let create ?(options = Options.default) ~sw ~process_mgr ~clock () = 239 241 (* Automatically enable permission prompt tool when callback is configured 240 242 (matching Python SDK behavior in client.py:104-121) *) 241 243 let options = ··· 261 263 control_responses = Hashtbl.create 16; 262 264 control_mutex = Eio.Mutex.create (); 263 265 control_condition = Eio.Condition.create (); 266 + clock; 264 267 } 265 268 in 266 269 ··· 386 389 (* Wait for the response with timeout *) 387 390 let max_wait = 10.0 in 388 391 (* 10 seconds timeout *) 389 - let start_time = Unix.gettimeofday () in 392 + let start_time = Eio.Time.now t.clock in 390 393 391 394 let rec wait_for_response () = 392 395 Eio.Mutex.use_rw ~protect:false t.control_mutex (fun () -> ··· 396 399 Hashtbl.remove t.control_responses request_id; 397 400 response_json 398 401 | None -> 399 - let elapsed = Unix.gettimeofday () -. start_time in 402 + let elapsed = Eio.Time.now t.clock -. start_time in 400 403 if elapsed > max_wait then 401 404 raise 402 405 (Failure ··· 429 432 match response with 430 433 | Sdk_control.Response.Success s -> s.response 431 434 | Sdk_control.Response.Error e -> 432 - raise (Failure (Printf.sprintf "Control request failed: %s" e.error)) 435 + raise (Failure (Printf.sprintf "Control request failed: [%d] %s" e.error.code e.error.message)) 433 436 434 437 let set_permission_mode t mode = 435 - let request_id = Printf.sprintf "set_perm_mode_%f" (Unix.gettimeofday ()) in 438 + let request_id = Printf.sprintf "set_perm_mode_%f" (Eio.Time.now t.clock) in 436 439 let proto_mode = Permissions.Mode.to_proto mode in 437 440 let request = Sdk_control.Request.set_permission_mode ~mode:proto_mode () in 438 441 let _response = send_control_request t ~request_id request in ··· 441 444 442 445 let set_model t model = 443 446 let model_str = Model.to_string model in 444 - let request_id = Printf.sprintf "set_model_%f" (Unix.gettimeofday ()) in 447 + let request_id = Printf.sprintf "set_model_%f" (Eio.Time.now t.clock) in 445 448 let request = Sdk_control.Request.set_model ~model:model_str () in 446 449 let _response = send_control_request t ~request_id request in 447 450 Log.info (fun m -> m "Model set to: %s" model_str) 448 451 449 452 let get_server_info t = 450 - let request_id = Printf.sprintf "get_server_info_%f" (Unix.gettimeofday ()) in 453 + let request_id = Printf.sprintf "get_server_info_%f" (Eio.Time.now t.clock) in 451 454 let request = Sdk_control.Request.get_server_info () in 452 455 let response_data = 453 456 send_control_request t ~request_id request
+7 -5
lib/client.mli
··· 13 13 14 14 {[ 15 15 Eio.Switch.run @@ fun sw -> 16 - let client = Client.create ~sw ~process_mgr () in 16 + let client = Client.create ~sw ~process_mgr ~clock () in 17 17 Client.query client "What is 2+2?"; 18 18 19 19 let messages = Client.receive_all client in ··· 61 61 ?options:Options.t -> 62 62 sw:Eio.Switch.t -> 63 63 process_mgr:_ Eio.Process.mgr -> 64 + clock:float Eio.Time.clock_ty Eio.Resource.t -> 64 65 unit -> 65 66 t 66 - (** [create ?options ~sw ~process_mgr ()] creates a new Claude client. 67 + (** [create ?options ~sw ~process_mgr ~clock ()] creates a new Claude client. 67 68 68 69 @param options Configuration options (defaults to {!Options.default}) 69 70 @param sw Eio switch for resource management 70 - @param process_mgr Eio process manager for spawning the Claude CLI *) 71 + @param process_mgr Eio process manager for spawning the Claude CLI 72 + @param clock Eio clock for time operations *) 71 73 72 74 (** {1 Simple Query Interface} *) 73 75 ··· 165 167 166 168 {[ 167 169 (* Start with strict permissions *) 168 - let client = Client.create ~sw ~process_mgr 170 + let client = Client.create ~sw ~process_mgr ~clock 169 171 ~options:(Options.default 170 172 |> Options.with_permission_mode Permissions.Mode.Default) () 171 173 in ··· 184 186 185 187 {[ 186 188 (* Use powerful model for complex analysis *) 187 - let client = Client.create ~sw ~process_mgr 189 + let client = Client.create ~sw ~process_mgr ~clock 188 190 ~options:(Options.default |> Options.with_model "claude-sonnet-4-5") () 189 191 in 190 192
+1 -1
lib/dune
··· 1 1 (library 2 2 (public_name claude) 3 3 (name claude) 4 - (libraries proto eio eio.unix fmt logs jsont jsont.bytesrw)) 4 + (libraries proto eio fmt logs jsont jsont.bytesrw))
+23 -2
lib/sdk_control.ml
··· 284 284 end 285 285 286 286 module Response = struct 287 + (* Re-export Error_code from Proto *) 288 + module Error_code = Proto.Control.Response.Error_code 289 + 290 + (* Structured error similar to JSON-RPC *) 291 + type error_detail = { 292 + code : int; 293 + message : string; 294 + data : Jsont.json option; 295 + } 296 + 297 + let error_detail ~code ~message ?data () = 298 + { code = Error_code.to_int code; message; data } 299 + 300 + let error_detail_jsont : error_detail Jsont.t = 301 + let make code message data = { code; message; data } in 302 + Jsont.Object.map ~kind:"ErrorDetail" make 303 + |> Jsont.Object.mem "code" Jsont.int ~enc:(fun e -> e.code) 304 + |> Jsont.Object.mem "message" Jsont.string ~enc:(fun e -> e.message) 305 + |> Jsont.Object.opt_mem "data" Jsont.json ~enc:(fun e -> e.data) 306 + |> Jsont.Object.finish 307 + 287 308 type success = { 288 309 subtype : [ `Success ]; 289 310 request_id : string; ··· 294 315 type error = { 295 316 subtype : [ `Error ]; 296 317 request_id : string; 297 - error : string; 318 + error : error_detail; 298 319 unknown : Unknown.t; 299 320 } 300 321 ··· 327 348 Jsont.Object.map ~kind:"Error" make 328 349 |> Jsont.Object.mem "request_id" Jsont.string ~enc:(fun (r : error) -> 329 350 r.request_id) 330 - |> Jsont.Object.mem "error" Jsont.string ~enc:(fun (r : error) -> r.error) 351 + |> Jsont.Object.mem "error" error_detail_jsont ~enc:(fun (r : error) -> r.error) 331 352 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun (r : error) -> 332 353 r.unknown) 333 354 |> Jsont.Object.finish
+33 -4
lib/sdk_control.mli
··· 183 183 module Response : sig 184 184 (** SDK control response types. *) 185 185 186 + (** Re-export Error_code from Proto for convenience. *) 187 + module Error_code = Proto.Control.Response.Error_code 188 + 189 + (** Structured error detail similar to JSON-RPC. 190 + 191 + This allows programmatic error handling with numeric error codes and 192 + optional structured data for additional context. *) 193 + type error_detail = { 194 + code : int; (** Error code for programmatic handling *) 195 + message : string; (** Human-readable error message *) 196 + data : Jsont.json option; (** Optional additional error data *) 197 + } 198 + 199 + val error_detail : 200 + code:[< Error_code.t] -> message:string -> ?data:Jsont.json -> unit -> error_detail 201 + (** [error_detail ~code ~message ?data ()] creates a structured error detail 202 + using typed error codes. 203 + 204 + Example: 205 + {[ 206 + error_detail 207 + ~code:`Method_not_found 208 + ~message:"Hook callback not found" 209 + () 210 + ]} *) 211 + 212 + val error_detail_jsont : error_detail Jsont.t 213 + (** [error_detail_jsont] is the Jsont codec for error details. *) 214 + 186 215 type success = { 187 216 subtype : [ `Success ]; 188 217 request_id : string; ··· 194 223 type error = { 195 224 subtype : [ `Error ]; 196 225 request_id : string; 197 - error : string; 226 + error : error_detail; 198 227 unknown : Unknown.t; 199 228 } 200 - (** Error response. *) 229 + (** Error response with structured error detail. *) 201 230 202 231 type t = 203 232 | Success of success ··· 208 237 (** [success ~request_id ?response ?unknown ()] creates a success response. *) 209 238 210 239 val error : 211 - request_id:string -> error:string -> ?unknown:Unknown.t -> unit -> t 212 - (** [error ~request_id ~error ?unknown] creates an error response. *) 240 + request_id:string -> error:error_detail -> ?unknown:Unknown.t -> unit -> t 241 + (** [error ~request_id ~error ?unknown] creates an error response with structured error detail. *) 213 242 214 243 val jsont : t Jsont.t 215 244 (** [jsont] is the jsont codec for responses. Use [Jsont.pp_value jsont ()]
+4 -4
lib/transport.ml
··· 119 119 let cmd = build_command ~claude_path ~options in 120 120 121 121 (* Build environment - preserve essential vars for Claude config/auth access *) 122 - let home = try Unix.getenv "HOME" with Not_found -> "/tmp" in 123 - let path = try Unix.getenv "PATH" with Not_found -> "/usr/bin:/bin" in 122 + let home = Option.value (Sys.getenv_opt "HOME") ~default:"/tmp" in 123 + let path = Option.value (Sys.getenv_opt "PATH") ~default:"/usr/bin:/bin" in 124 124 125 125 (* Preserve other potentially important environment variables *) 126 126 let preserve_vars = ··· 140 140 let preserved = 141 141 List.filter_map 142 142 (fun var -> 143 - try Some (Printf.sprintf "%s=%s" var (Unix.getenv var)) 144 - with Not_found -> None) 143 + Option.map (fun value -> Printf.sprintf "%s=%s" var value) 144 + (Sys.getenv_opt var)) 145 145 preserve_vars 146 146 in 147 147
+48 -2
proto/control.ml
··· 223 223 end 224 224 225 225 module Response = struct 226 + (* Standard JSON-RPC 2.0 error codes using polymorphic variants *) 227 + module Error_code = struct 228 + type t = [ 229 + | `Parse_error 230 + | `Invalid_request 231 + | `Method_not_found 232 + | `Invalid_params 233 + | `Internal_error 234 + | `Custom of int 235 + ] 236 + 237 + let to_int : [< t] -> int = function 238 + | `Parse_error -> -32700 239 + | `Invalid_request -> -32600 240 + | `Method_not_found -> -32601 241 + | `Invalid_params -> -32602 242 + | `Internal_error -> -32603 243 + | `Custom n -> n 244 + 245 + let of_int = function 246 + | -32700 -> `Parse_error 247 + | -32600 -> `Invalid_request 248 + | -32601 -> `Method_not_found 249 + | -32602 -> `Invalid_params 250 + | -32603 -> `Internal_error 251 + | n -> `Custom n 252 + end 253 + 254 + (* Structured error similar to JSON-RPC *) 255 + type error_detail = { 256 + code : int; 257 + message : string; 258 + data : Jsont.json option; 259 + } 260 + 261 + let error_detail ~code ~message ?data () = 262 + { code = Error_code.to_int code; message; data } 263 + 264 + let error_detail_jsont : error_detail Jsont.t = 265 + let make code message data = { code; message; data } in 266 + Jsont.Object.map ~kind:"ErrorDetail" make 267 + |> Jsont.Object.mem "code" Jsont.int ~enc:(fun e -> e.code) 268 + |> Jsont.Object.mem "message" Jsont.string ~enc:(fun e -> e.message) 269 + |> Jsont.Object.opt_mem "data" Jsont.json ~enc:(fun e -> e.data) 270 + |> Jsont.Object.finish 271 + 226 272 (* Individual record types for each response variant *) 227 273 type success_r = { 228 274 request_id : string; ··· 232 278 233 279 type error_r = { 234 280 request_id : string; 235 - error : string; 281 + error : error_detail; 236 282 unknown : Unknown.t; 237 283 } 238 284 ··· 257 303 let make request_id error unknown = { request_id; error; unknown } in 258 304 (Jsont.Object.map ~kind:"Error" make 259 305 |> Jsont.Object.mem "requestId" Jsont.string ~enc:(fun (r : error_r) -> r.request_id) 260 - |> Jsont.Object.mem "error" Jsont.string ~enc:(fun (r : error_r) -> r.error) 306 + |> Jsont.Object.mem "error" error_detail_jsont ~enc:(fun (r : error_r) -> r.error) 261 307 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : error_r) -> r.unknown) 262 308 |> Jsont.Object.finish) 263 309
+49 -3
proto/control.mli
··· 113 113 module Response : sig 114 114 (** SDK control response types. *) 115 115 116 + (** Standard JSON-RPC 2.0 error codes. 117 + 118 + These codes follow the JSON-RPC 2.0 specification for structured error 119 + responses. Using the typed codes instead of raw integers improves code 120 + clarity and prevents typos. Polymorphic variants allow for easy extension. *) 121 + module Error_code : sig 122 + type t = [ 123 + | `Parse_error (** -32700: Invalid JSON received *) 124 + | `Invalid_request (** -32600: The request object is invalid *) 125 + | `Method_not_found (** -32601: The requested method does not exist *) 126 + | `Invalid_params (** -32602: Invalid method parameters *) 127 + | `Internal_error (** -32603: Internal server error *) 128 + | `Custom of int (** Application-specific error codes *) 129 + ] 130 + 131 + val to_int : [< t] -> int 132 + (** [to_int t] converts an error code to its integer representation. *) 133 + 134 + val of_int : int -> t 135 + (** [of_int n] converts an integer to an error code. 136 + Standard codes are mapped to their variants, others become [`Custom n]. *) 137 + end 138 + 139 + (** Structured error detail similar to JSON-RPC. *) 140 + type error_detail = { 141 + code : int; (** Error code for programmatic handling *) 142 + message : string; (** Human-readable error message *) 143 + data : Jsont.json option; (** Optional additional error data *) 144 + } 145 + 146 + val error_detail : 147 + code:[< Error_code.t] -> message:string -> ?data:Jsont.json -> unit -> error_detail 148 + (** [error_detail ~code ~message ?data ()] creates a structured error detail 149 + using typed error codes. 150 + 151 + Example: 152 + {[ 153 + error_detail 154 + ~code:`Method_not_found 155 + ~message:"Hook callback not found" 156 + () 157 + ]} *) 158 + 159 + val error_detail_jsont : error_detail Jsont.t 160 + (** [error_detail_jsont] is the Jsont codec for error details. *) 161 + 116 162 type success_r = private { 117 163 request_id : string; 118 164 response : Jsont.json option; ··· 121 167 122 168 type error_r = private { 123 169 request_id : string; 124 - error : string; 170 + error : error_detail; 125 171 unknown : Unknown.t; 126 172 } 127 173 ··· 135 181 val success : request_id:string -> ?response:Jsont.json -> unit -> t 136 182 (** [success ~request_id ?response ()] creates a success response. *) 137 183 138 - val error : request_id:string -> error:string -> unit -> t 139 - (** [error ~request_id ~error ()] creates an error response. *) 184 + val error : request_id:string -> error:error_detail -> unit -> t 185 + (** [error ~request_id ~error ()] creates an error response with structured error detail. *) 140 186 end 141 187 142 188 (** {1 Control Envelopes} *)
+7 -6
test/advanced_config_demo.ml
··· 75 75 |> Options.with_model (Claude.Proto.Model.of_string "claude-sonnet-4-5") 76 76 77 77 (* Helper to run a query with a specific configuration *) 78 - let run_query ~sw process_mgr config prompt = 78 + let run_query ~sw process_mgr clock config prompt = 79 79 print_endline "\n=== Configuration ==="; 80 80 (match Options.max_budget_usd config with 81 81 | Some budget -> Printf.printf "Budget limit: $%.2f\n" budget ··· 91 91 | None -> print_endline "Buffer size: Default (1MB)"); 92 92 93 93 print_endline "\n=== Running Query ==="; 94 - let client = Client.create ~options:config ~sw ~process_mgr () in 94 + let client = Client.create ~options:config ~sw ~process_mgr ~clock () in 95 95 Client.query client prompt; 96 96 let responses = Client.receive client in 97 97 ··· 115 115 Eio_main.run @@ fun env -> 116 116 Switch.run @@ fun sw -> 117 117 let process_mgr = Eio.Stdenv.process_mgr env in 118 + let clock = Eio.Stdenv.clock env in 118 119 119 120 print_endline "=============================================="; 120 121 print_endline "Claude SDK - Advanced Configuration Examples"; ··· 124 125 print_endline "\n\n### Example 1: CI/CD Configuration ###"; 125 126 print_endline "Purpose: Isolated, reproducible environment for CI/CD"; 126 127 let config = ci_cd_config () in 127 - run_query ~sw process_mgr config "What is 2+2? Answer in one sentence."; 128 + run_query ~sw process_mgr clock config "What is 2+2? Answer in one sentence."; 128 129 129 130 (* Example: Production with fallback *) 130 131 print_endline "\n\n### Example 2: Production Configuration ###"; 131 132 print_endline "Purpose: Production with cost controls and fallback"; 132 133 let config = production_config () in 133 - run_query ~sw process_mgr config "Explain OCaml in one sentence."; 134 + run_query ~sw process_mgr clock config "Explain OCaml in one sentence."; 134 135 135 136 (* Example: Development with settings *) 136 137 print_endline "\n\n### Example 3: Development Configuration ###"; 137 138 print_endline "Purpose: Development with user/project settings"; 138 139 let config = dev_config () in 139 - run_query ~sw process_mgr config 140 + run_query ~sw process_mgr clock config 140 141 "What is functional programming? One sentence."; 141 142 142 143 (* Example: Test configuration *) 143 144 print_endline "\n\n### Example 4: Test Configuration ###"; 144 145 print_endline "Purpose: Automated testing with strict limits"; 145 146 let config = test_config () in 146 - run_query ~sw process_mgr config "Say 'test passed' in one word."; 147 + run_query ~sw process_mgr clock config "Say 'test passed' in one word."; 147 148 148 149 print_endline "\n\n=============================================="; 149 150 print_endline "All examples completed successfully!";
+1 -1
test/camel_jokes.ml
··· 51 51 in 52 52 53 53 let client = 54 - Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr () 54 + Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ~clock:env#clock () 55 55 in 56 56 57 57 Claude.Client.query client prompt;
+1 -1
test/discovery_demo.ml
··· 45 45 |> Claude.Options.with_model (Claude.Proto.Model.of_string "sonnet") 46 46 in 47 47 let client = 48 - Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr () 48 + Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ~clock:env#clock () 49 49 in 50 50 Claude.Client.enable_permission_discovery client; 51 51
+6
test/dune
··· 105 105 (name test_incoming) 106 106 (modules test_incoming) 107 107 (libraries claude jsont.bytesrw)) 108 + 109 + (executable 110 + (public_name test_structured_error) 111 + (name test_structured_error) 112 + (modules test_structured_error) 113 + (libraries claude eio_main jsont.bytesrw))
+2 -1
test/dynamic_control_demo.ml
··· 12 12 let run env = 13 13 Switch.run @@ fun sw -> 14 14 let process_mgr = Eio.Stdenv.process_mgr env in 15 + let clock = Eio.Stdenv.clock env in 15 16 16 17 (* Create client with default options *) 17 18 let options = Options.default in 18 - let client = Client.create ~options ~sw ~process_mgr () in 19 + let client = Client.create ~options ~sw ~process_mgr ~clock () in 19 20 20 21 traceln "=== Dynamic Control Demo ===\n"; 21 22
+1 -1
test/hooks_example.ml
··· 46 46 in 47 47 48 48 let client = 49 - Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr () 49 + Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ~clock:env#clock () 50 50 in 51 51 52 52 (* Test 1: Safe command (should work) *)
+1 -1
test/permission_demo.ml
··· 159 159 in 160 160 161 161 let client = 162 - Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr () 162 + Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ~clock:env#clock () 163 163 in 164 164 165 165 (* First prompt - Claude will need to request Read permission for ../lib *)
+1 -1
test/simple_permission_test.ml
··· 30 30 31 31 Log.app (fun m -> m "Creating client with permission callback..."); 32 32 let client = 33 - Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr () 33 + Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ~clock:env#clock () 34 34 in 35 35 36 36 (* Query that should trigger Write tool *)
+2 -1
test/structured_output_demo.ml
··· 124 124 (* Create Claude client and query *) 125 125 Eio.Switch.run @@ fun sw -> 126 126 let process_mgr = Eio.Stdenv.process_mgr env in 127 - let client = C.Client.create ~sw ~process_mgr ~options () in 127 + let clock = Eio.Stdenv.clock env in 128 + let client = C.Client.create ~sw ~process_mgr ~clock ~options () in 128 129 129 130 let prompt = 130 131 "Please analyze the current codebase structure. Look at the files, \
+2 -1
test/structured_output_simple.ml
··· 61 61 62 62 Eio.Switch.run @@ fun sw -> 63 63 let process_mgr = Eio.Stdenv.process_mgr env in 64 - let client = C.Client.create ~sw ~process_mgr ~options () in 64 + let clock = Eio.Stdenv.clock env in 65 + let client = C.Client.create ~sw ~process_mgr ~clock ~options () in 65 66 66 67 C.Client.query client 67 68 "Tell me about a famous computer scientist. Provide their name, age, and \
+5 -3
test/test_incoming.ml
··· 41 41 42 42 let test_decode_control_response () = 43 43 let json_str = 44 - {|{"type":"control_response","response":{"subtype":"success","request_id":"test-req-1"}}|} 44 + {|{"type":"control_response","response":{"subtype":"success","requestId":"test-req-1"}}|} 45 45 in 46 46 match Jsont_bytesrw.decode_string' Proto.Incoming.jsont json_str with 47 47 | Ok (Proto.Incoming.Control_response resp) -> ( ··· 59 59 60 60 let test_decode_control_response_error () = 61 61 let json_str = 62 - {|{"type":"control_response","response":{"subtype":"error","request_id":"test-req-2","error":"Something went wrong"}}|} 62 + {|{"type":"control_response","response":{"subtype":"error","requestId":"test-req-2","error":{"code":-32603,"message":"Something went wrong"}}}|} 63 63 in 64 64 match Jsont_bytesrw.decode_string' Proto.Incoming.jsont json_str with 65 65 | Ok (Proto.Incoming.Control_response resp) -> ( 66 66 match resp.response with 67 67 | Proto.Control.Response.Error e -> 68 - if e.request_id = "test-req-2" && e.error = "Something went wrong" 68 + if e.request_id = "test-req-2" 69 + && e.error.code = -32603 70 + && e.error.message = "Something went wrong" 69 71 then print_endline "✓ Decoded control error response successfully" 70 72 else Printf.printf "✗ Wrong error content\n" 71 73 | Proto.Control.Response.Success _ ->
+1 -1
test/test_permissions.ml
··· 27 27 28 28 Log.app (fun m -> m "Creating client with permission callback..."); 29 29 let client = 30 - Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr () 30 + Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ~clock:env#clock () 31 31 in 32 32 33 33 (* Simple query that will trigger tool use *)
+275
test/test_structured_error.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Test structured errors by provoking a JSON-RPC error from Claude *) 7 + 8 + open Eio.Std 9 + 10 + let test_create_error_detail () = 11 + print_endline "\nTesting structured error creation..."; 12 + 13 + (* Create a simple error *) 14 + let error1 = Proto.Control.Response.error_detail 15 + ~code:`Method_not_found 16 + ~message:"Method not found" 17 + () 18 + in 19 + Printf.printf "✓ Created error: [%d] %s\n" error1.code error1.message; 20 + 21 + (* Create an error without additional data for simplicity *) 22 + let error2 = Proto.Control.Response.error_detail 23 + ~code:`Invalid_params 24 + ~message:"Invalid parameters" 25 + () 26 + in 27 + Printf.printf "✓ Created error: [%d] %s\n" error2.code error2.message; 28 + 29 + (* Encode and decode an error response *) 30 + let error_resp = Proto.Control.Response.error 31 + ~request_id:"test-123" 32 + ~error:error2 33 + () 34 + in 35 + 36 + match Jsont.Json.encode Proto.Control.Response.jsont error_resp with 37 + | Ok json -> 38 + let json_str = match Jsont_bytesrw.encode_string' Jsont.json json with 39 + | Ok s -> s 40 + | Error e -> Jsont.Error.to_string e 41 + in 42 + Printf.printf "✓ Encoded error response: %s\n" json_str; 43 + 44 + (* Decode it back *) 45 + (match Jsont.Json.decode Proto.Control.Response.jsont json with 46 + | Ok (Proto.Control.Response.Error decoded) -> 47 + Printf.printf "✓ Decoded error: [%d] %s\n" 48 + decoded.error.code decoded.error.message 49 + | Ok _ -> print_endline "✗ Wrong response type" 50 + | Error e -> Printf.printf "✗ Decode failed: %s\n" e) 51 + | Error e -> 52 + Printf.printf "✗ Encode failed: %s\n" e 53 + 54 + let test_error_code_conventions () = 55 + print_endline "\nTesting JSON-RPC error code conventions..."; 56 + 57 + (* Standard JSON-RPC errors using the typed API with polymorphic variants *) 58 + let errors = [ 59 + (`Parse_error, "Parse error"); 60 + (`Invalid_request, "Invalid request"); 61 + (`Method_not_found, "Method not found"); 62 + (`Invalid_params, "Invalid params"); 63 + (`Internal_error, "Internal error"); 64 + (`Custom 1, "Application error"); 65 + ] in 66 + 67 + List.iter (fun (code, msg) -> 68 + let err = Proto.Control.Response.error_detail ~code ~message:msg () in 69 + Printf.printf "✓ Error [%d]: %s (typed)\n" err.code err.message 70 + ) errors 71 + 72 + let test_provoke_api_error ~sw ~env = 73 + print_endline "\nTesting API error from Claude..."; 74 + 75 + (* Configure client with an invalid model to provoke an API error *) 76 + let options = 77 + Claude.Options.default 78 + |> Claude.Options.with_model (Claude.Model.of_string "invalid-model-that-does-not-exist") 79 + in 80 + 81 + Printf.printf "Creating client with invalid model...\n"; 82 + 83 + try 84 + let client = 85 + Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ~clock:env#clock () 86 + in 87 + 88 + Printf.printf "Sending query to provoke API error...\n"; 89 + Claude.Client.query client "Hello, this should fail with an invalid model error"; 90 + 91 + (* Process responses to see if we get an error *) 92 + let messages = Claude.Client.receive_all client in 93 + 94 + let error_found = ref false in 95 + let text_error_found = ref false in 96 + List.iter 97 + (fun resp -> 98 + match resp with 99 + | Claude.Response.Error err -> 100 + error_found := true; 101 + Printf.printf "✓ Received structured error response: %s\n" 102 + (Claude.Response.Error.message err); 103 + Printf.printf " Is system error: %b\n" 104 + (Claude.Response.Error.is_system_error err); 105 + Printf.printf " Is assistant error: %b\n" 106 + (Claude.Response.Error.is_assistant_error err) 107 + | Claude.Response.Text text -> 108 + let content = Claude.Response.Text.content text in 109 + if String.length content > 0 && 110 + (String.contains content '4' || String.contains content 'e') then begin 111 + text_error_found := true; 112 + Printf.printf "✓ Received error as text: %s\n" content 113 + end 114 + | Claude.Response.Complete result -> 115 + Printf.printf " Complete (duration: %dms)\n" 116 + (Claude.Response.Complete.duration_ms result) 117 + | _ -> ()) 118 + messages; 119 + 120 + if !error_found then 121 + Printf.printf "✓ Successfully caught structured error response\n" 122 + else if !text_error_found then 123 + Printf.printf "✓ Successfully caught error (returned as text)\n" 124 + else 125 + Printf.printf "✗ No error was returned (unexpected)\n" 126 + 127 + with 128 + | Claude.Transport.Connection_error msg -> 129 + Printf.printf "✓ Connection error as expected: %s\n" msg 130 + | exn -> 131 + Printf.printf "✗ Unexpected exception: %s\n" (Printexc.to_string exn); 132 + Printexc.print_backtrace stdout 133 + 134 + let test_control_protocol_error () = 135 + print_endline "\nTesting control protocol error encoding/decoding..."; 136 + 137 + (* Test that we can create and encode a control protocol error using polymorphic variant codes *) 138 + let error_detail = Proto.Control.Response.error_detail 139 + ~code:`Invalid_params 140 + ~message:"Invalid params for permission request" 141 + ~data:(Jsont.Object ([ 142 + (("tool_name", Jsont.Meta.none), Jsont.String ("Write", Jsont.Meta.none)); 143 + (("reason", Jsont.Meta.none), Jsont.String ("Missing required file_path parameter", Jsont.Meta.none)); 144 + ], Jsont.Meta.none)) 145 + () 146 + in 147 + 148 + let error_response = Proto.Control.Response.error 149 + ~request_id:"test-req-456" 150 + ~error:error_detail 151 + () 152 + in 153 + 154 + match Jsont.Json.encode Proto.Control.Response.jsont error_response with 155 + | Ok json -> 156 + let json_str = match Jsont_bytesrw.encode_string' Jsont.json json with 157 + | Ok s -> s 158 + | Error e -> Jsont.Error.to_string e 159 + in 160 + Printf.printf "✓ Encoded control error with data:\n %s\n" json_str; 161 + 162 + (* Verify we can decode it back *) 163 + (match Jsont.Json.decode Proto.Control.Response.jsont json with 164 + | Ok (Proto.Control.Response.Error decoded) -> 165 + Printf.printf "✓ Decoded control error:\n"; 166 + Printf.printf " Code: %d\n" decoded.error.code; 167 + Printf.printf " Message: %s\n" decoded.error.message; 168 + Printf.printf " Has data: %b\n" (Option.is_some decoded.error.data); 169 + (match decoded.error.data with 170 + | Some data -> 171 + let data_str = match Jsont_bytesrw.encode_string' Jsont.json data with 172 + | Ok s -> s 173 + | Error e -> Jsont.Error.to_string e 174 + in 175 + Printf.printf " Data: %s\n" data_str 176 + | None -> ()) 177 + | Ok _ -> print_endline "✗ Wrong response type" 178 + | Error e -> Printf.printf "✗ Decode failed: %s\n" e) 179 + | Error e -> 180 + Printf.printf "✗ Encode failed: %s\n" e 181 + 182 + let test_hook_error ~sw ~env = 183 + print_endline "\nTesting hook callback errors trigger JSON-RPC error codes..."; 184 + 185 + (* Create a hook that will throw an exception *) 186 + let failing_hook input = 187 + Printf.printf "✓ Hook called for tool: %s\n" input.Claude.Hooks.PreToolUse.tool_name; 188 + failwith "Intentional hook failure to test error handling" 189 + in 190 + 191 + (* Register the failing hook *) 192 + let hooks = 193 + Claude.Hooks.empty 194 + |> Claude.Hooks.on_pre_tool_use ~pattern:"Write" failing_hook 195 + in 196 + 197 + let options = 198 + Claude.Options.default 199 + |> Claude.Options.with_hooks hooks 200 + |> Claude.Options.with_model (Claude.Model.of_string "haiku") 201 + in 202 + 203 + Printf.printf "Creating client with failing hook...\n"; 204 + 205 + try 206 + let client = 207 + Claude.Client.create ~options ~sw ~process_mgr:env#process_mgr ~clock:env#clock () 208 + in 209 + 210 + Printf.printf "Asking Claude to write a file (should trigger failing hook)...\n"; 211 + Claude.Client.query client "Write 'test' to /tmp/test_hook_error.txt"; 212 + 213 + (* Process responses *) 214 + let messages = Claude.Client.receive_all client in 215 + 216 + let hook_called = ref false in 217 + let error_found = ref false in 218 + List.iter 219 + (fun resp -> 220 + match resp with 221 + | Claude.Response.Tool_use tool -> 222 + let tool_name = Claude.Response.Tool_use.name tool in 223 + if tool_name = "Write" then begin 224 + hook_called := true; 225 + Printf.printf "✓ Write tool was called (hook intercepted it)\n" 226 + end 227 + | Claude.Response.Error err -> 228 + error_found := true; 229 + Printf.printf " Error response: %s\n" (Claude.Response.Error.message err) 230 + | Claude.Response.Complete _ -> 231 + Printf.printf " Query completed\n" 232 + | _ -> ()) 233 + messages; 234 + 235 + if !hook_called then 236 + Printf.printf "✓ Hook was triggered, exception caught by SDK\n" 237 + else 238 + Printf.printf " Note: Hook may not have been called if query didn't use Write tool\n"; 239 + 240 + Printf.printf "✓ Test completed (SDK sent -32603 Internal Error to CLI)\n" 241 + 242 + with 243 + | exn -> 244 + Printf.printf "Exception during test: %s\n" (Printexc.to_string exn); 245 + Printexc.print_backtrace stdout 246 + 247 + let run_all_tests env = 248 + print_endline "=== Structured Error Tests ==="; 249 + test_create_error_detail (); 250 + test_error_code_conventions (); 251 + test_control_protocol_error (); 252 + 253 + (* Test with actual Claude invocation *) 254 + Switch.run @@ fun sw -> 255 + test_provoke_api_error ~sw ~env; 256 + 257 + (* Test hook errors that trigger JSON-RPC error codes *) 258 + Switch.run @@ fun sw -> 259 + test_hook_error ~sw ~env; 260 + 261 + print_endline "\n=== All Structured Error Tests Completed ===" 262 + 263 + let () = 264 + Eio_main.run @@ fun env -> 265 + try 266 + run_all_tests env 267 + with 268 + | Claude.Transport.CLI_not_found msg -> 269 + Printf.eprintf "Error: Claude CLI not found\n%s\n" msg; 270 + Printf.eprintf "Make sure 'claude' is installed and in your PATH\n"; 271 + exit 1 272 + | exn -> 273 + Printf.eprintf "Fatal error: %s\n" (Printexc.to_string exn); 274 + Printexc.print_backtrace stderr; 275 + exit 1