My agentic slop goes here. Not intended for anyone else!
1open Eio.Std
2
3let src = Logs.Src.create "simple_permission_test" ~doc:"Simple permission test"
4module Log = (val Logs.src_log src : Logs.LOG)
5
6(* Auto-allow callback that logs what it sees *)
7let auto_allow_callback ~tool_name ~input ~context:_ =
8 Log.app (fun m -> m "\n🔐 Permission callback invoked!");
9 Log.app (fun m -> m " Tool: %s" tool_name);
10 Log.app (fun m -> m " Input: %s" (Ezjsonm.value_to_string input));
11 Log.app (fun m -> m " ✅ Auto-allowing");
12 Claude.Permissions.Result.allow ()
13
14let run_test ~sw ~env =
15 Log.app (fun m -> m "🧪 Testing Permission Callbacks (Auto-Allow Mode)");
16 Log.app (fun m -> m "====================================================");
17
18 (* Create options with permission callback *)
19 let options = Claude.Options.create
20 ~model:(Claude.Model.of_string "sonnet")
21 ~permission_callback:auto_allow_callback
22 () in
23
24 Log.app (fun m -> m "Creating client with permission callback...");
25 let client = Claude.Client.create ~options ~sw
26 ~process_mgr:env#process_mgr
27 () in
28
29 (* Query that should trigger Write tool *)
30 Log.app (fun m -> m "\n📤 Asking Claude to write a file...");
31 Claude.Client.query client
32 "Write a simple hello world message to /tmp/test_permission.txt";
33
34 (* Process response *)
35 let messages = Claude.Client.receive_all client in
36 Log.app (fun m -> m "\n📨 Received %d messages" (List.length messages));
37
38 let tool_count = ref 0 in
39 let write_used = ref false in
40
41 List.iter (fun msg ->
42 match msg with
43 | Claude.Message.Assistant msg ->
44 List.iter (function
45 | Claude.Content_block.Text t ->
46 let text = Claude.Content_block.Text.text t in
47 if String.length text > 0 then
48 Log.app (fun m -> m "\n💬 Claude: %s" text)
49 | Claude.Content_block.Tool_use t ->
50 incr tool_count;
51 let tool_name = Claude.Content_block.Tool_use.name t in
52 if tool_name = "Write" then write_used := true;
53 Log.app (fun m -> m "🔧 Tool use #%d: %s" !tool_count tool_name)
54 | _ -> ()
55 ) (Claude.Message.Assistant.content msg)
56 | Claude.Message.User msg ->
57 (* Check for tool results which might have errors *)
58 (match Claude.Message.User.content msg with
59 | Claude.Message.User.Blocks blocks ->
60 List.iter (function
61 | Claude.Content_block.Tool_result r ->
62 let tool_use_id = Claude.Content_block.Tool_result.tool_use_id r in
63 let is_error = Claude.Content_block.Tool_result.is_error r |> Option.value ~default:false in
64 if is_error then begin
65 Log.app (fun m -> m "\n⚠️ Tool result error for %s:" tool_use_id);
66 (match Claude.Content_block.Tool_result.content r with
67 | Some s -> Log.app (fun m -> m " %s" s)
68 | None -> ())
69 end
70 | _ -> ()
71 ) blocks
72 | _ -> ())
73 | Claude.Message.Result msg ->
74 if Claude.Message.Result.is_error msg then
75 Log.err (fun m -> m "\n❌ Error occurred!")
76 else
77 Log.app (fun m -> m "\n✅ Success!");
78 (match Claude.Message.Result.total_cost_usd msg with
79 | Some cost -> Log.app (fun m -> m "💰 Cost: $%.6f" cost)
80 | None -> ());
81 Log.app (fun m -> m "⏱️ Duration: %dms"
82 (Claude.Message.Result.duration_ms msg))
83 | _ -> ()
84 ) messages;
85
86 Log.app (fun m -> m "\n====================================================");
87 Log.app (fun m -> m "📊 Test Results:");
88 Log.app (fun m -> m " Total tools used: %d" !tool_count);
89 Log.app (fun m -> m " Write tool used: %b" !write_used);
90
91 if !write_used then
92 Log.app (fun m -> m " ✅ Permission callback successfully intercepted Write tool!")
93 else
94 Log.app (fun m -> m " ⚠️ Write tool was not used (unexpected)");
95
96 Log.app (fun m -> m "====================================================");
97 Log.app (fun m -> m "✨ Test complete!")
98
99let main ~env =
100 Switch.run @@ fun sw ->
101 run_test ~sw ~env
102
103(* Command-line interface *)
104open Cmdliner
105
106let main_term env =
107 let setup_log style_renderer level =
108 Fmt_tty.setup_std_outputs ?style_renderer ();
109 Logs.set_level level;
110 Logs.set_reporter (Logs_fmt.reporter ());
111 if level = None then Logs.set_level (Some Logs.App);
112 match level with
113 | Some Logs.Info | Some Logs.Debug ->
114 Logs.Src.set_level Claude.Client.src (Some Logs.Info);
115 Logs.Src.set_level Claude.Transport.src (Some Logs.Info)
116 | _ -> ()
117 in
118 let run style level =
119 setup_log style level;
120 main ~env
121 in
122 Term.(const run $ Fmt_cli.style_renderer () $ Logs_cli.level ())
123
124let cmd env =
125 let doc = "Test permission callback with auto-allow" in
126 let info = Cmd.info "simple_permission_test" ~version:"1.0" ~doc in
127 Cmd.v info (main_term env)
128
129let () =
130 Eio_main.run @@ fun env ->
131 exit (Cmd.eval (cmd env))