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