···

       
1
       
 
       
let src = Logs.Src.create "claude.client" ~doc:"Claude client"

     

       
2
       
 
       
module Log = (val Logs.src_log src : Logs.LOG)

     

       
3
       
 
       


     

       
4
       
-
       
(* Helper functions for JSON manipulation *)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
5
       
 
       
let json_to_string json =

     

       
6
       
 
       
  match Jsont_bytesrw.encode_string' Jsont.json json with

     

       
7
       
 
       
  | Ok s -> s

     

       
8
       
 
       
  | Error err -> failwith (Jsont.Error.to_string err)

     

       
9
       
 
       


     

       
10
       
-
       
let json_of_string s =

     

       
11
       
-
       
  match Jsont_bytesrw.decode_string' Jsont.json s with

     

       
12
       
-
       
  | Ok j -> j

     

       
13
       
-
       
  | Error err -> failwith (Jsont.Error.to_string err)

     

       
14
       
-
       


     

       
15
       
-
       
let get_field json key =

     

       
16
       
-
       
  match json with

     

       
17
       
-
       
  | Jsont.Object (members, _) ->

     

       
18
       
-
       
      List.find_map (fun ((name, _), value) ->

     

       
19
       
-
       
        if name = key then Some value else None

     

       
20
       
-
       
      ) members

     

       
21
       
-
       
  | _ -> None

     

       
22
       
 
       


     

       
23
       
-
       
let rec find json path =

     

       
24
       
-
       
  match path with

     

       
25
       
-
       
  | [] -> json

     

       
26
       
-
       
  | key :: rest ->

     

       
27
       
-
       
      match get_field json key with

     

       
28
       
-
       
      | Some value -> find value rest

     

       
29
       
-
       
      | None -> raise Not_found

     

       
30
       
-
       


     

       
31
       
-
       
let find_string json path =

     

       
32
       
-
       
  let value = find json path in

     

       
33
       
-
       
  match value with

     

       
34
       
-
       
  | Jsont.String (s, _) -> s

     

       
35
       
-
       
  | _ -> raise (Invalid_argument "Expected string value")

     

       
36
       
-
       


     

       
37
       
-
       
let json_string s = Jsont.String (s, Jsont.Meta.none)

     

       
38
       
-
       
let json_null = Jsont.Null ((), Jsont.Meta.none)

     

       
39
       
-
       


     

       
40
       
-
       
let json_dict pairs =

     

       
41
       
-
       
  let members = List.map (fun (k, v) -> ((k, Jsont.Meta.none), v)) pairs in

     

       
42
       
-
       
  Jsont.Object (members, Jsont.Meta.none)

     

       
43
       
 
       


     

       
44
       
 
       
type t = {

     

       
45
       
 
       
  transport : Transport.t;

     
···

       
53
       
 
       
  control_condition : Eio.Condition.t;

     

       
54
       
 
       
}

     

       
55
       
 
       


     

       
56
       
-
       
let handle_control_request t control_msg =

     

       
57
       
-
       
  let data = Control.data control_msg in

     

       
58
       
-
       
  Log.info (fun m -> m "Handling control request: %s" (Control.subtype control_msg));

     

       
59
       
-
       
  Log.info (fun m -> m "Control request data: %s" (json_to_string data));

     

       
60
       
-
       
  match find_string data ["request"; "subtype"] with

     

       
61
       
-
       
  | "can_use_tool" ->

     

       
62
       
-
       
      let tool_name = find_string data ["request"; "tool_name"] in

     

       
63
       
-
       
      let input = find data ["request"; "input"] in

     

       
64
       
 
       
      Log.info (fun m -> m "Permission request for tool '%s' with input: %s"

     

       
65
       
 
       
        tool_name (json_to_string input));

     

       
66
       
-
       
      let suggestions =

     

       
67
       
-
       
        try

     

       
68
       
-
       
          let sugg_json = find data ["request"; "permission_suggestions"] in

     

       
69
       
-
       
          match sugg_json with

     

       
70
       
-
       
          | Jsont.Array _ ->

     

       
71
       
-
       
              (* TODO: Parse permission suggestions *)

     

       
72
       
-
       
              []

     

       
73
       
-
       
          | _ -> []

     

       
74
       
-
       
        with Not_found -> []

     

       
75
       
-
       
      in

     

       
76
       
-
       
      let context = Permissions.Context.create ~suggestions () in

     

       
77
       
 
       


     

       
78
       
 
       
      Log.info (fun m -> m "Invoking permission callback for tool: %s" tool_name);

     

       
79
       
 
       
      let result = match t.permission_callback with

     
···

       
89
       
 
       
         | Permissions.Result.Allow _ -> "ALLOW"

     

       
90
       
 
       
         | Permissions.Result.Deny _ -> "DENY"));

     

       
91
       
 
       


     

       
92
       
-
       
      (* Convert permission result to CLI format: {"behavior": "allow", "updatedInput": ...} or {"behavior": "deny", "message": ...} *)

     

       
93
       
 
       
      let response_data = match result with

     

       
94
       
 
       
        | Permissions.Result.Allow { updated_input; updated_permissions = _; unknown = _ } ->

     

       
95
       
-
       
            (* updatedInput is required when allowing - use original input if not modified *)

     

       
96
       
-
       
            let updated_input = match updated_input with

     

       
97
       
-
       
              | Some inp -> inp

     

       
98
       
-
       
              | None -> input  (* Use original input *)

     

       
99
       
-
       
            in

     

       
100
       
-
       
            json_dict [

     

       
101
       
 
       
              ("behavior", json_string "allow");

     

       
102
       
 
       
              ("updatedInput", updated_input);

     

       
103
       
 
       
            ]

     

       
104
       
 
       
        | Permissions.Result.Deny { message; interrupt = _; unknown = _ } ->

     

       
105
       
-
       
            json_dict [

     

       
106
       
 
       
              ("behavior", json_string "deny");

     

       
107
       
 
       
              ("message", json_string message);

     

       
108
       
 
       
            ]

     

       
109
       
 
       
      in

     

       
110
       
-
       


     

       
111
       
-
       
      let response = json_dict [

     

       
112
       
-
       
        "type", json_string "control_response";

     

       
113
       
-
       
        "response", json_dict [

     

       
114
       
-
       
          "subtype", json_string "success";

     

       
115
       
-
       
          "request_id", json_string (Control.request_id control_msg);

     

       
116
       
-
       
          "response", response_data

     

       
117
       
-
       
        ]

     

       
118
       
-
       
      ] in

     

       
119
       
 
       
      Log.info (fun m -> m "Sending control response: %s" (json_to_string response));

     

       
120
       
 
       
      Transport.send t.transport response

     

       
121
       
-
       
  

     

       
122
       
-
       
  | "hook_callback" ->

     

       
123
       
-
       
      let callback_id = find_string data ["request"; "callback_id"] in

     

       
124
       
-
       
      let input = find data ["request"; "input"] in

     

       
125
       
-
       
      let tool_use_id =

     

       
126
       
-
       
        try Some (find_string data ["request"; "tool_use_id"])

     

       
127
       
-
       
        with Not_found -> None

     

       
128
       
-
       
      in

     

       
129
       
 
       
      Log.info (fun m -> m "Hook callback request for callback_id: %s" callback_id);

     

       
130
       
 
       


     

       
131
       
 
       
      (try

     
···

       
137
       
 
       
          | Ok j -> j

     

       
138
       
 
       
          | Error msg -> failwith ("Failed to encode hook result: " ^ msg)

     

       
139
       
 
       
        in

     

       
140
       
-
       


     

       
141
       
-
       
        let response = json_dict [

     

       
142
       
-
       
          "type", json_string "control_response";

     

       
143
       
-
       
          "response", json_dict [

     

       
144
       
-
       
            "subtype", json_string "success";

     

       
145
       
-
       
            "request_id", json_string (Control.request_id control_msg);

     

       
146
       
-
       
            "response", result_json

     

       
147
       
-
       
          ]

     

       
148
       
-
       
        ] in

     

       
149
       
 
       
        Log.info (fun m -> m "Hook callback succeeded, sending response");

     

       
150
       
 
       
        Transport.send t.transport response

     

       
151
       
 
       
      with

     

       
152
       
 
       
      | Not_found ->

     

       
153
       
 
       
          let error_msg = Printf.sprintf "Hook callback not found: %s" callback_id in

     

       
154
       
 
       
          Log.err (fun m -> m "%s" error_msg);

     

       
155
       
-
       
          let response = json_dict [

     

       
156
       
-
       
            "type", json_string "control_response";

     

       
157
       
-
       
            "response", json_dict [

     

       
158
       
-
       
              "subtype", json_string "error";

     

       
159
       
-
       
              "request_id", json_string (Control.request_id control_msg);

     

       
160
       
-
       
              "error", json_string error_msg

     

       
161
       
-
       
            ]

     

       
162
       
-
       
          ] in

     

       
163
       
-
       
          Transport.send t.transport response

     

       
164
       
 
       
      | exn ->

     

       
165
       
 
       
          let error_msg = Printf.sprintf "Hook callback error: %s" (Printexc.to_string exn) in

     

       
166
       
 
       
          Log.err (fun m -> m "%s" error_msg);

     

       
167
       
-
       
          let response = json_dict [

     

       
168
       
-
       
            "type", json_string "control_response";

     

       
169
       
-
       
            "response", json_dict [

     

       
170
       
-
       
              "subtype", json_string "error";

     

       
171
       
-
       
              "request_id", json_string (Control.request_id control_msg);

     

       
172
       
-
       
              "error", json_string error_msg

     

       
173
       
-
       
            ]

     

       
174
       
-
       
          ] in

     

       
175
       
-
       
          Transport.send t.transport response)

     

       
176
       
 
       


     

       
177
       
-
       
  | subtype ->

     

       
178
       
-
       
      (* Respond with error for unknown control requests *)

     

       
179
       
-
       
      let response = json_dict [

     

       
180
       
-
       
        "type", json_string "control_response";

     

       
181
       
-
       
        "response", json_dict [

     

       
182
       
-
       
          "subtype", json_string "error";

     

       
183
       
-
       
          "request_id", json_string (Control.request_id control_msg);

     

       
184
       
-
       
          "error", json_string (Printf.sprintf "Unsupported control request: %s" subtype)

     

       
185
       
-
       
        ]

     

       
186
       
-
       
      ] in

     

       
187
       
-
       
      Transport.send t.transport response

     

       
188
       
 
       


     

       
189
       
 
       
let handle_control_response t control_resp =

     

       
190
       
 
       
  let request_id = match control_resp.Sdk_control.response with

     
···

       
211
       
 
       
        Log.debug (fun m -> m "Handle messages: EOF received");

     

       
212
       
 
       
        Seq.Nil

     

       
213
       
 
       
    | Some line ->

     

       
214
       
-
       
          try

     

       
215
       
-
       
            (* First check if it's a control_request (special case, not in Incoming) *)

     

       
216
       
-
       
            let json = json_of_string line in

     

       
217
       
-
       
            match find_string json ["type"] with

     

       
218
       
-
       
            | "control_request" ->

     

       
219
       
-
       
                let control_msg = Control.create

     

       
220
       
-
       
                  ~request_id:(find_string json ["request_id"])

     

       
221
       
-
       
                  ~subtype:(find_string json ["request"; "subtype"])

     

       
222
       
-
       
                  ~data:json in

     

       
223
       
-
       
                Log.info (fun m -> m "Received control request: %s (request_id: %s)"

     

       
224
       
-
       
                  (Control.subtype control_msg) (Control.request_id control_msg));

     

       
225
       
-
       
                handle_control_request t control_msg;

     

       
226
       
-
       
                loop ()

     

       
227
       
 
       


     

       
228
       
-
       
            | _ ->

     

       
229
       
-
       
                (* Use Incoming codec for all other message types *)

     

       
230
       
-
       
                match Jsont_bytesrw.decode_string' Incoming.jsont line with

     

       
231
       
-
       
                | Ok (Incoming.Message msg) ->

     

       
232
       
-
       
                    Log.info (fun m -> m "← %a" Message.pp msg);

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
233
       
 
       


     

       
234
       
-
       
                    (* Extract session ID from system messages *)

     

       
235
       
-
       
                    (match msg with

     

       
236
       
-
       
                    | Message.System sys when Message.System.subtype sys = "init" ->

     

       
237
       
-
       
                        (match Message.System.Data.get_string (Message.System.data sys) "session_id" with

     

       
238
       
-
       
                        | Some session_id ->

     

       
239
       
-
       
                          t.session_id <- Some session_id;

     

       
240
       
-
       
                          Log.debug (fun m -> m "Stored session ID: %s" session_id)

     

       
241
       
-
       
                        | None -> ())

     

       
242
       
-
       
                    | _ -> ());

     

       
243
       
 
       


     

       
244
       
-
       
                    Seq.Cons (msg, loop)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
245
       
 
       


     

       
246
       
-
       
                | Ok (Incoming.Control_response resp) ->

     

       
247
       
-
       
                    handle_control_response t resp;

     

       
248
       
-
       
                    loop ()

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
249
       
 
       


     

       
250
       
-
       
                | Error err ->

     

       
251
       
-
       
                    Log.err (fun m -> m "Failed to decode incoming message: %s\nLine: %s"

     

       
252
       
-
       
                      (Jsont.Error.to_string err) line);

     

       
253
       
-
       
                    loop ()

     

       
254
       
-
       
          with

     

       
255
       
-
       
          | exn ->

     

       
256
       
-
       
              Log.err (fun m -> m "Failed to parse message: %s\nLine: %s"

     

       
257
       
-
       
                (Printexc.to_string exn) line);

     

       
258
       
-
       
              loop ()

     

       
259
       
 
       
  in

     

       
260
       
 
       
  Log.debug (fun m -> m "Starting message handler");

     

       
261
       
 
       
  loop

     
···

       
304
       
 
       
            Log.debug (fun m -> m "Registered callback: %s for event: %s" callback_id event_name);

     

       
305
       
 
       
            callback_id

     

       
306
       
 
       
          ) matcher.Hooks.callbacks in

     

       
307
       
-
       
          json_dict [

     

       
308
       
 
       
            "matcher", (match matcher.Hooks.matcher with

     

       
309
       
 
       
              | Some p -> json_string p

     

       
310
       
-
       
              | None -> json_null);

     

       
311
       
-
       
            "hookCallbackIds", Jsont.Array (List.map (fun id -> json_string id) callback_ids, Jsont.Meta.none);

     

       
312
       
 
       
          ]

     

       
313
       
 
       
        ) matchers in

     

       
314
       
-
       
        (event_name, Jsont.Array (matchers_json, Jsont.Meta.none)) :: acc

     

       
315
       
 
       
      ) [] hooks_config in

     

       
316
       
 
       


     

       
317
       
 
       
      (* Send initialize control request *)

     

       
318
       
-
       
      let initialize_msg = json_dict [

     

       
319
       
 
       
        "type", json_string "control_request";

     

       
320
       
 
       
        "request_id", json_string "init_hooks";

     

       
321
       
-
       
        "request", json_dict [

     

       
322
       
 
       
          "subtype", json_string "initialize";

     

       
323
       
-
       
          "hooks", json_dict hooks_json;

     

       
324
       
 
       
        ]

     

       
325
       
 
       
      ] in

     

       
326
       
 
       
      Log.info (fun m -> m "Sending hooks initialize request");

     
···

       
420
       
 
       
  let response_json = wait_for_response () in

     

       
421
       
 
       
  Log.debug (fun m -> m "Received control response: %s" (json_to_string response_json));

     

       
422
       
 
       


     

       
423
       
-
       
  (* Parse the response *)

     

       
424
       
-
       
  let response_data = find response_json ["response"] in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
425
       
 
       
  let response = match Jsont.Json.decode Sdk_control.Response.jsont response_data with

     

       
426
       
 
       
    | Ok r -> r

     

       
427
       
 
       
    | Error msg -> raise (Invalid_argument ("Failed to decode response: " ^ msg))

     

···

       
1
       
 
       
let src = Logs.Src.create "claude.client" ~doc:"Claude client"

     

       
2
       
 
       
module Log = (val Logs.src_log src : Logs.LOG)

     

       
3
       
 
       


     

       
4
       
+
       
(** Control response builders using jsont *)

     

       
5
       
+
       
module Control_response = struct

     

       
6
       
+
       
  let success ~request_id ~response =

     

       
7
       
+
       
    Jsont.Json.object' [

     

       
8
       
+
       
      Jsont.Json.mem (Jsont.Json.name "type") (Jsont.Json.string "control_response");

     

       
9
       
+
       
      Jsont.Json.mem (Jsont.Json.name "response") (Jsont.Json.object' [

     

       
10
       
+
       
        Jsont.Json.mem (Jsont.Json.name "subtype") (Jsont.Json.string "success");

     

       
11
       
+
       
        Jsont.Json.mem (Jsont.Json.name "request_id") (Jsont.Json.string request_id);

     

       
12
       
+
       
        Jsont.Json.mem (Jsont.Json.name "response") response;

     

       
13
       
+
       
      ]);

     

       
14
       
+
       
    ]

     

       
15
       
+
       


     

       
16
       
+
       
  let error ~request_id ~message =

     

       
17
       
+
       
    Jsont.Json.object' [

     

       
18
       
+
       
      Jsont.Json.mem (Jsont.Json.name "type") (Jsont.Json.string "control_response");

     

       
19
       
+
       
      Jsont.Json.mem (Jsont.Json.name "response") (Jsont.Json.object' [

     

       
20
       
+
       
        Jsont.Json.mem (Jsont.Json.name "subtype") (Jsont.Json.string "error");

     

       
21
       
+
       
        Jsont.Json.mem (Jsont.Json.name "request_id") (Jsont.Json.string request_id);

     

       
22
       
+
       
        Jsont.Json.mem (Jsont.Json.name "error") (Jsont.Json.string message);

     

       
23
       
+
       
      ]);

     

       
24
       
+
       
    ]

     

       
25
       
+
       
end

     

       
26
       
+
       


     

       
27
       
+
       
(* Helper functions for JSON manipulation using jsont *)

     

       
28
       
 
       
let json_to_string json =

     

       
29
       
 
       
  match Jsont_bytesrw.encode_string' Jsont.json json with

     

       
30
       
 
       
  | Ok s -> s

     

       
31
       
 
       
  | Error err -> failwith (Jsont.Error.to_string err)

     

       
32
       
 
       


     

       
33
       
+
       
(* JSON construction helpers using jsont *)

     

       
34
       
+
       
let json_string s = Jsont.Json.string s

     

       
35
       
+
       
let json_null () = Jsont.Json.null ()

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
36
       
 
       


     

       
37
       
+
       
let json_object pairs =

     

       
38
       
+
       
  Jsont.Json.object' (List.map (fun (k, v) -> Jsont.Json.mem (Jsont.Json.name k) v) pairs)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
39
       
 
       


     

       
40
       
 
       
type t = {

     

       
41
       
 
       
  transport : Transport.t;

     
···

       
49
       
 
       
  control_condition : Eio.Condition.t;

     

       
50
       
 
       
}

     

       
51
       
 
       


     

       
52
       
+
       
let handle_control_request t (ctrl_req : Incoming.Control_request.t) =

     

       
53
       
+
       
  let request_id = Incoming.Control_request.request_id ctrl_req in

     

       
54
       
+
       
  Log.info (fun m -> m "Handling control request: %s" (Incoming.Control_request.subtype ctrl_req));

     

       
55
       
+
       


     

       
56
       
+
       
  match Incoming.Control_request.request ctrl_req with

     

       
57
       
+
       
  | Incoming.Control_request.Can_use_tool req ->

     

       
58
       
+
       
      let tool_name = Incoming.Control_request.Can_use_tool.tool_name req in

     

       
59
       
+
       
      let input = Incoming.Control_request.Can_use_tool.input req in

     

       
60
       
 
       
      Log.info (fun m -> m "Permission request for tool '%s' with input: %s"

     

       
61
       
 
       
        tool_name (json_to_string input));

     

       
62
       
+
       
      (* TODO: Parse permission_suggestions properly *)

     

       
63
       
+
       
      let context = Permissions.Context.create ~suggestions:[] () in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
64
       
 
       


     

       
65
       
 
       
      Log.info (fun m -> m "Invoking permission callback for tool: %s" tool_name);

     

       
66
       
 
       
      let result = match t.permission_callback with

     
···

       
76
       
 
       
         | Permissions.Result.Allow _ -> "ALLOW"

     

       
77
       
 
       
         | Permissions.Result.Deny _ -> "DENY"));

     

       
78
       
 
       


     

       
79
       
+
       
      (* Convert permission result to CLI format *)

     

       
80
       
 
       
      let response_data = match result with

     

       
81
       
 
       
        | Permissions.Result.Allow { updated_input; updated_permissions = _; unknown = _ } ->

     

       
82
       
+
       
            let updated_input = Option.value updated_input ~default:input in

     

       
83
       
+
       
            json_object [

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
84
       
 
       
              ("behavior", json_string "allow");

     

       
85
       
 
       
              ("updatedInput", updated_input);

     

       
86
       
 
       
            ]

     

       
87
       
 
       
        | Permissions.Result.Deny { message; interrupt = _; unknown = _ } ->

     

       
88
       
+
       
            json_object [

     

       
89
       
 
       
              ("behavior", json_string "deny");

     

       
90
       
 
       
              ("message", json_string message);

     

       
91
       
 
       
            ]

     

       
92
       
 
       
      in

     

       
93
       
+
       
      let response = Control_response.success ~request_id ~response:response_data in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
94
       
 
       
      Log.info (fun m -> m "Sending control response: %s" (json_to_string response));

     

       
95
       
 
       
      Transport.send t.transport response

     

       
96
       
+
       


     

       
97
       
+
       
  | Incoming.Control_request.Hook_callback req ->

     

       
98
       
+
       
      let callback_id = Incoming.Control_request.Hook_callback.callback_id req in

     

       
99
       
+
       
      let input = Incoming.Control_request.Hook_callback.input req in

     

       
100
       
+
       
      let tool_use_id = Incoming.Control_request.Hook_callback.tool_use_id req in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
101
       
 
       
      Log.info (fun m -> m "Hook callback request for callback_id: %s" callback_id);

     

       
102
       
 
       


     

       
103
       
 
       
      (try

     
···

       
109
       
 
       
          | Ok j -> j

     

       
110
       
 
       
          | Error msg -> failwith ("Failed to encode hook result: " ^ msg)

     

       
111
       
 
       
        in

     

       
112
       
+
       
        let response = Control_response.success ~request_id ~response:result_json in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
113
       
 
       
        Log.info (fun m -> m "Hook callback succeeded, sending response");

     

       
114
       
 
       
        Transport.send t.transport response

     

       
115
       
 
       
      with

     

       
116
       
 
       
      | Not_found ->

     

       
117
       
 
       
          let error_msg = Printf.sprintf "Hook callback not found: %s" callback_id in

     

       
118
       
 
       
          Log.err (fun m -> m "%s" error_msg);

     

       
119
       
+
       
          Transport.send t.transport (Control_response.error ~request_id ~message:error_msg)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
120
       
 
       
      | exn ->

     

       
121
       
 
       
          let error_msg = Printf.sprintf "Hook callback error: %s" (Printexc.to_string exn) in

     

       
122
       
 
       
          Log.err (fun m -> m "%s" error_msg);

     

       
123
       
+
       
          Transport.send t.transport (Control_response.error ~request_id ~message:error_msg))

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
124
       
 
       


     

       
125
       
+
       
  | Incoming.Control_request.Unknown (subtype, _) ->

     

       
126
       
+
       
      let error_msg = Printf.sprintf "Unsupported control request: %s" subtype in

     

       
127
       
+
       
      Transport.send t.transport (Control_response.error ~request_id ~message:error_msg)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
128
       
 
       


     

       
129
       
 
       
let handle_control_response t control_resp =

     

       
130
       
 
       
  let request_id = match control_resp.Sdk_control.response with

     
···

       
151
       
 
       
        Log.debug (fun m -> m "Handle messages: EOF received");

     

       
152
       
 
       
        Seq.Nil

     

       
153
       
 
       
    | Some line ->

     

       
154
       
+
       
        (* Use unified Incoming codec for all message types *)

     

       
155
       
+
       
        match Jsont_bytesrw.decode_string' Incoming.jsont line with

     

       
156
       
+
       
        | Ok (Incoming.Message msg) ->

     

       
157
       
+
       
            Log.info (fun m -> m "← %a" Message.pp msg);

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
158
       
 
       


     

       
159
       
+
       
            (* Extract session ID from system messages *)

     

       
160
       
+
       
            (match msg with

     

       
161
       
+
       
            | Message.System sys ->

     

       
162
       
+
       
                (match Message.System.Data.session_id (Message.System.data sys) with

     

       
163
       
+
       
                | Some session_id ->

     

       
164
       
+
       
                  t.session_id <- Some session_id;

     

       
165
       
+
       
                  Log.debug (fun m -> m "Stored session ID: %s" session_id)

     

       
166
       
+
       
                | None -> ())

     

       
167
       
+
       
            | _ -> ());

     

       
168
       
 
       


     

       
169
       
+
       
            Seq.Cons (msg, loop)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
170
       
 
       


     

       
171
       
+
       
        | Ok (Incoming.Control_response resp) ->

     

       
172
       
+
       
            handle_control_response t resp;

     

       
173
       
+
       
            loop ()

     

       
174
       
 
       


     

       
175
       
+
       
        | Ok (Incoming.Control_request ctrl_req) ->

     

       
176
       
+
       
            Log.info (fun m -> m "Received control request: %s (request_id: %s)"

     

       
177
       
+
       
              (Incoming.Control_request.subtype ctrl_req)

     

       
178
       
+
       
              (Incoming.Control_request.request_id ctrl_req));

     

       
179
       
+
       
            handle_control_request t ctrl_req;

     

       
180
       
+
       
            loop ()

     

       
181
       
 
       


     

       
182
       
+
       
        | Error err ->

     

       
183
       
+
       
            Log.err (fun m -> m "Failed to decode incoming message: %s\nLine: %s"

     

       
184
       
+
       
              (Jsont.Error.to_string err) line);

     

       
185
       
+
       
            loop ()

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
186
       
 
       
  in

     

       
187
       
 
       
  Log.debug (fun m -> m "Starting message handler");

     

       
188
       
 
       
  loop

     
···

       
231
       
 
       
            Log.debug (fun m -> m "Registered callback: %s for event: %s" callback_id event_name);

     

       
232
       
 
       
            callback_id

     

       
233
       
 
       
          ) matcher.Hooks.callbacks in

     

       
234
       
+
       
          json_object [

     

       
235
       
 
       
            "matcher", (match matcher.Hooks.matcher with

     

       
236
       
 
       
              | Some p -> json_string p

     

       
237
       
+
       
              | None -> json_null ());

     

       
238
       
+
       
            "hookCallbackIds", Jsont.Json.list (List.map (fun id -> json_string id) callback_ids);

     

       
239
       
 
       
          ]

     

       
240
       
 
       
        ) matchers in

     

       
241
       
+
       
        (event_name, Jsont.Json.list matchers_json) :: acc

     

       
242
       
 
       
      ) [] hooks_config in

     

       
243
       
 
       


     

       
244
       
 
       
      (* Send initialize control request *)

     

       
245
       
+
       
      let initialize_msg = json_object [

     

       
246
       
 
       
        "type", json_string "control_request";

     

       
247
       
 
       
        "request_id", json_string "init_hooks";

     

       
248
       
+
       
        "request", json_object [

     

       
249
       
 
       
          "subtype", json_string "initialize";

     

       
250
       
+
       
          "hooks", json_object hooks_json;

     

       
251
       
 
       
        ]

     

       
252
       
 
       
      ] in

     

       
253
       
 
       
      Log.info (fun m -> m "Sending hooks initialize request");

     
···

       
347
       
 
       
  let response_json = wait_for_response () in

     

       
348
       
 
       
  Log.debug (fun m -> m "Received control response: %s" (json_to_string response_json));

     

       
349
       
 
       


     

       
350
       
+
       
  (* Parse the response - extract the "response" field using jsont codec *)

     

       
351
       
+
       
  let response_field_codec = Jsont.Object.map ~kind:"ResponseField" Fun.id

     

       
352
       
+
       
    |> Jsont.Object.mem "response" Jsont.json ~enc:Fun.id

     

       
353
       
+
       
    |> Jsont.Object.finish

     

       
354
       
+
       
  in

     

       
355
       
+
       
  let response_data = match Jsont.Json.decode response_field_codec response_json with

     

       
356
       
+
       
    | Ok r -> r

     

       
357
       
+
       
    | Error msg -> raise (Invalid_argument ("Failed to extract response field: " ^ msg))

     

       
358
       
+
       
  in

     

       
359
       
 
       
  let response = match Jsont.Json.decode Sdk_control.Response.jsont response_data with

     

       
360
       
 
       
    | Ok r -> r

     

       
361
       
 
       
    | Error msg -> raise (Invalid_argument ("Failed to decode response: " ^ msg))

     

···

       
47
       
 
       


     

       
48
       
 
       
module Tool_use = struct

     

       
49
       
 
       
  module Input = struct

     

       
0
       
 
       

     

       
50
       
 
       
    type t = Jsont.json

     

       
51
       
 
       


     

       
52
       
 
       
    let jsont = Jsont.json

     

       
53
       
 
       


     

       
54
       
 
       
    let of_string_pairs pairs =

     

       
55
       
-
       
      Jsont.Object (

     

       
56
       
-
       
        List.map (fun (k, v) ->

     

       
57
       
-
       
          ((Jsont.Json.name k), Jsont.String (v, Jsont.Meta.none))

     

       
58
       
-
       
        ) pairs,

     

       
59
       
-
       
        Jsont.Meta.none

     

       
60
       
-
       
      )

     

       
61
       
 
       


     

       
62
       
 
       
    let of_assoc (assoc : (string * Jsont.json) list) : t =

     

       
63
       
-
       
      Jsont.Object (

     

       
64
       
-
       
        List.map (fun (k, v) -> (Jsont.Json.name k, v)) assoc,

     

       
65
       
-
       
        Jsont.Meta.none

     

       
66
       
-
       
      )

     

       
67
       
 
       


     

       
68
       
-
       
    let get_field t key =

     

       
69
       
-
       
      match t with

     

       
70
       
-
       
      | Jsont.Object (members, _) ->

     

       
71
       
-
       
          List.find_map (fun ((name, _), value) ->

     

       
72
       
-
       
            if name = key then Some value else None

     

       
73
       
-
       
          ) members

     

       
74
       
-
       
      | _ -> None

     

       
75
       
-
       


     

       
76
       
-
       
    let get_string t key =

     

       
77
       
-
       
      match get_field t key with

     

       
78
       
-
       
      | Some (Jsont.String (s, _)) -> Some s

     

       
79
       
-
       
      | _ -> None

     

       
80
       
-
       


     

       
81
       
-
       
    let get_int t key =

     

       
82
       
-
       
      match get_field t key with

     

       
83
       
-
       
      | Some (Jsont.Number (f, _)) ->

     

       
84
       
-
       
          let i = int_of_float f in

     

       
85
       
-
       
          if float_of_int i = f then Some i else None

     

       
86
       
-
       
      | _ -> None

     

       
87
       
 
       


     

       
88
       
-
       
    let get_bool t key =

     

       
89
       
-
       
      match get_field t key with

     

       
90
       
-
       
      | Some (Jsont.Bool (b, _)) -> Some b

     

       
91
       
-
       
      | _ -> None

     

       
92
       
-
       


     

       
93
       
-
       
    let get_float t key =

     

       
94
       
-
       
      match get_field t key with

     

       
95
       
-
       
      | Some (Jsont.Number (f, _)) -> Some f

     

       
96
       
-
       
      | _ -> None

     

       
97
       
 
       


     

       
98
       
 
       
    let keys t =

     

       
0
       
 
       

     

       
99
       
 
       
      match t with

     

       
100
       
 
       
      | Jsont.Object (members, _) -> List.map (fun ((name, _), _) -> name) members

     

       
101
       
 
       
      | _ -> []

     

···

       
47
       
 
       


     

       
48
       
 
       
module Tool_use = struct

     

       
49
       
 
       
  module Input = struct

     

       
50
       
+
       
    (* Dynamic JSON data for tool inputs with typed accessors using jsont decoders *)

     

       
51
       
 
       
    type t = Jsont.json

     

       
52
       
 
       


     

       
53
       
 
       
    let jsont = Jsont.json

     

       
54
       
 
       


     

       
55
       
 
       
    let of_string_pairs pairs =

     

       
56
       
+
       
      Jsont.Json.object' (List.map (fun (k, v) ->

     

       
57
       
+
       
        Jsont.Json.mem (Jsont.Json.name k) (Jsont.Json.string v)

     

       
58
       
+
       
      ) pairs)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
59
       
 
       


     

       
60
       
 
       
    let of_assoc (assoc : (string * Jsont.json) list) : t =

     

       
61
       
+
       
      Jsont.Json.object' (List.map (fun (k, v) -> Jsont.Json.mem (Jsont.Json.name k) v) assoc)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
62
       
 
       


     

       
63
       
+
       
    (* Helper to decode an optional field with a given codec *)

     

       
64
       
+
       
    let get_opt (type a) (codec : a Jsont.t) t key : a option =

     

       
65
       
+
       
      let field_codec = Jsont.Object.map ~kind:"field" (fun v -> v)

     

       
66
       
+
       
        |> Jsont.Object.opt_mem key codec ~enc:Fun.id

     

       
67
       
+
       
        |> Jsont.Object.finish

     

       
68
       
+
       
      in

     

       
69
       
+
       
      match Jsont.Json.decode field_codec t with

     

       
70
       
+
       
      | Ok v -> v

     

       
71
       
+
       
      | Error _ -> None

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
72
       
 
       


     

       
73
       
+
       
    let get_string t key = get_opt Jsont.string t key

     

       
74
       
+
       
    let get_int t key = get_opt Jsont.int t key

     

       
75
       
+
       
    let get_bool t key = get_opt Jsont.bool t key

     

       
76
       
+
       
    let get_float t key = get_opt Jsont.number t key

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
77
       
 
       


     

       
78
       
 
       
    let keys t =

     

       
79
       
+
       
      (* Decode as object with all members captured as unknown *)

     

       
80
       
 
       
      match t with

     

       
81
       
 
       
      | Jsont.Object (members, _) -> List.map (fun ((name, _), _) -> name) members

     

       
82
       
 
       
      | _ -> []

     

···

       
117
       
 
       
    unknown : Input_unknown.t;

     

       
118
       
 
       
  }

     

       
119
       
 
       


     

       
120
       
-
       
  let get_field json key =

     

       
121
       
-
       
    match json with

     

       
122
       
-
       
    | Jsont.Object (members, _) ->

     

       
123
       
-
       
        List.find_map (fun ((name, _), value) ->

     

       
124
       
-
       
          if name = key then Some value else None

     

       
125
       
-
       
        ) members

     

       
126
       
-
       
    | _ -> None

     

       
127
       
-
       


     

       
128
       
-
       
  let get_string json key =

     

       
129
       
-
       
    match get_field json key with

     

       
130
       
-
       
    | Some (Jsont.String (s, _)) -> Some s

     

       
131
       
-
       
    | _ -> None

     

       
132
       
-
       


     

       
133
       
-
       
  let of_json json =

     

       
134
       
-
       
    match get_string json "session_id" with

     

       
135
       
-
       
    | None -> raise (Invalid_argument "PreToolUse: missing session_id")

     

       
136
       
-
       
    | Some session_id ->

     

       
137
       
-
       
        match get_string json "transcript_path" with

     

       
138
       
-
       
        | None -> raise (Invalid_argument "PreToolUse: missing transcript_path")

     

       
139
       
-
       
        | Some transcript_path ->

     

       
140
       
-
       
            match get_string json "tool_name" with

     

       
141
       
-
       
            | None -> raise (Invalid_argument "PreToolUse: missing tool_name")

     

       
142
       
-
       
            | Some tool_name ->

     

       
143
       
-
       
                match get_field json "tool_input" with

     

       
144
       
-
       
                | None -> raise (Invalid_argument "PreToolUse: missing tool_input")

     

       
145
       
-
       
                | Some tool_input ->

     

       
146
       
-
       
                    { session_id; transcript_path; tool_name; tool_input; unknown = json }

     

       
147
       
-
       


     

       
148
       
 
       
  type t = input

     

       
149
       
 
       


     

       
150
       
 
       
  let session_id t = t.session_id

     
···

       
164
       
 
       
    |> Jsont.Object.mem "tool_input" Jsont.json ~enc:tool_input

     

       
165
       
 
       
    |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown

     

       
166
       
 
       
    |> Jsont.Object.finish

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
167
       
 
       


     

       
168
       
 
       
  type permission_decision = [ `Allow | `Deny | `Ask ]

     

       
169
       
 
       


     
···

       
239
       
 
       
    unknown : Input_unknown.t;

     

       
240
       
 
       
  }

     

       
241
       
 
       


     

       
242
       
-
       
  let get_field json key =

     

       
243
       
-
       
    match json with

     

       
244
       
-
       
    | Jsont.Object (members, _) ->

     

       
245
       
-
       
        List.find_map (fun ((name, _), value) ->

     

       
246
       
-
       
          if name = key then Some value else None

     

       
247
       
-
       
        ) members

     

       
248
       
-
       
    | _ -> None

     

       
249
       
-
       


     

       
250
       
-
       
  let get_string json key =

     

       
251
       
-
       
    match get_field json key with

     

       
252
       
-
       
    | Some (Jsont.String (s, _)) -> Some s

     

       
253
       
-
       
    | _ -> None

     

       
254
       
-
       


     

       
255
       
-
       
  let of_json json =

     

       
256
       
-
       
    match get_string json "session_id" with

     

       
257
       
-
       
    | None -> raise (Invalid_argument "PostToolUse: missing session_id")

     

       
258
       
-
       
    | Some session_id ->

     

       
259
       
-
       
        match get_string json "transcript_path" with

     

       
260
       
-
       
        | None -> raise (Invalid_argument "PostToolUse: missing transcript_path")

     

       
261
       
-
       
        | Some transcript_path ->

     

       
262
       
-
       
            match get_string json "tool_name" with

     

       
263
       
-
       
            | None -> raise (Invalid_argument "PostToolUse: missing tool_name")

     

       
264
       
-
       
            | Some tool_name ->

     

       
265
       
-
       
                match get_field json "tool_input" with

     

       
266
       
-
       
                | None -> raise (Invalid_argument "PostToolUse: missing tool_input")

     

       
267
       
-
       
                | Some tool_input ->

     

       
268
       
-
       
                    match get_field json "tool_response" with

     

       
269
       
-
       
                    | None -> raise (Invalid_argument "PostToolUse: missing tool_response")

     

       
270
       
-
       
                    | Some tool_response ->

     

       
271
       
-
       
                        { session_id; transcript_path; tool_name; tool_input; tool_response; unknown = json }

     

       
272
       
-
       


     

       
273
       
 
       
  type t = input

     

       
274
       
 
       


     

       
275
       
 
       
  let session_id t = t.session_id

     
···

       
291
       
 
       
    |> Jsont.Object.mem "tool_response" Jsont.json ~enc:tool_response

     

       
292
       
 
       
    |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown

     

       
293
       
 
       
    |> Jsont.Object.finish

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
294
       
 
       


     

       
295
       
 
       
  module Output_unknown = struct

     

       
296
       
 
       
    type t = Jsont.json

     
···

       
345
       
 
       
    unknown : Input_unknown.t;

     

       
346
       
 
       
  }

     

       
347
       
 
       


     

       
348
       
-
       
  let get_field json key =

     

       
349
       
-
       
    match json with

     

       
350
       
-
       
    | Jsont.Object (members, _) ->

     

       
351
       
-
       
        List.find_map (fun ((name, _), value) ->

     

       
352
       
-
       
          if name = key then Some value else None

     

       
353
       
-
       
        ) members

     

       
354
       
-
       
    | _ -> None

     

       
355
       
-
       


     

       
356
       
-
       
  let get_string json key =

     

       
357
       
-
       
    match get_field json key with

     

       
358
       
-
       
    | Some (Jsont.String (s, _)) -> Some s

     

       
359
       
-
       
    | _ -> None

     

       
360
       
-
       


     

       
361
       
-
       
  let of_json json =

     

       
362
       
-
       
    match get_string json "session_id" with

     

       
363
       
-
       
    | None -> raise (Invalid_argument "UserPromptSubmit: missing session_id")

     

       
364
       
-
       
    | Some session_id ->

     

       
365
       
-
       
        match get_string json "transcript_path" with

     

       
366
       
-
       
        | None -> raise (Invalid_argument "UserPromptSubmit: missing transcript_path")

     

       
367
       
-
       
        | Some transcript_path ->

     

       
368
       
-
       
            match get_string json "prompt" with

     

       
369
       
-
       
            | None -> raise (Invalid_argument "UserPromptSubmit: missing prompt")

     

       
370
       
-
       
            | Some prompt ->

     

       
371
       
-
       
                { session_id; transcript_path; prompt; unknown = json }

     

       
372
       
-
       


     

       
373
       
 
       
  type t = input

     

       
374
       
 
       


     

       
375
       
 
       
  let session_id t = t.session_id

     
···

       
388
       
 
       
    |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown

     

       
389
       
 
       
    |> Jsont.Object.finish

     

       
390
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
391
       
 
       
  module Output_unknown = struct

     

       
392
       
 
       
    type t = Jsont.json

     

       
393
       
 
       
    let empty = Jsont.Object ([], Jsont.Meta.none)

     
···

       
441
       
 
       
    unknown : Input_unknown.t;

     

       
442
       
 
       
  }

     

       
443
       
 
       


     

       
444
       
-
       
  let get_field json key =

     

       
445
       
-
       
    match json with

     

       
446
       
-
       
    | Jsont.Object (members, _) ->

     

       
447
       
-
       
        List.find_map (fun ((name, _), value) ->

     

       
448
       
-
       
          if name = key then Some value else None

     

       
449
       
-
       
        ) members

     

       
450
       
-
       
    | _ -> None

     

       
451
       
-
       


     

       
452
       
-
       
  let get_string json key =

     

       
453
       
-
       
    match get_field json key with

     

       
454
       
-
       
    | Some (Jsont.String (s, _)) -> Some s

     

       
455
       
-
       
    | _ -> None

     

       
456
       
-
       


     

       
457
       
-
       
  let get_bool json key =

     

       
458
       
-
       
    match get_field json key with

     

       
459
       
-
       
    | Some (Jsont.Bool (b, _)) -> Some b

     

       
460
       
-
       
    | _ -> None

     

       
461
       
-
       


     

       
462
       
-
       
  let of_json json =

     

       
463
       
-
       
    match get_string json "session_id" with

     

       
464
       
-
       
    | None -> raise (Invalid_argument "Stop: missing session_id")

     

       
465
       
-
       
    | Some session_id ->

     

       
466
       
-
       
        match get_string json "transcript_path" with

     

       
467
       
-
       
        | None -> raise (Invalid_argument "Stop: missing transcript_path")

     

       
468
       
-
       
        | Some transcript_path ->

     

       
469
       
-
       
            match get_bool json "stop_hook_active" with

     

       
470
       
-
       
            | None -> raise (Invalid_argument "Stop: missing stop_hook_active")

     

       
471
       
-
       
            | Some stop_hook_active ->

     

       
472
       
-
       
                { session_id; transcript_path; stop_hook_active; unknown = json }

     

       
473
       
-
       


     

       
474
       
 
       
  type t = input

     

       
475
       
 
       


     

       
476
       
 
       
  let session_id t = t.session_id

     
···

       
488
       
 
       
    |> Jsont.Object.mem "stop_hook_active" Jsont.bool ~enc:stop_hook_active

     

       
489
       
 
       
    |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown

     

       
490
       
 
       
    |> Jsont.Object.finish

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
491
       
 
       


     

       
492
       
 
       
  module Output_unknown = struct

     

       
493
       
 
       
    type t = Jsont.json

     
···

       
524
       
 
       
(** {1 SubagentStop Hook} - Same structure as Stop *)

     

       
525
       
 
       
module SubagentStop = struct

     

       
526
       
 
       
  include Stop

     

       
527
       
-
       


     

       
528
       
-
       
  let get_field json key =

     

       
529
       
-
       
    match json with

     

       
530
       
-
       
    | Jsont.Object (members, _) ->

     

       
531
       
-
       
        List.find_map (fun ((name, _), value) ->

     

       
532
       
-
       
          if name = key then Some value else None

     

       
533
       
-
       
        ) members

     

       
534
       
-
       
    | _ -> None

     

       
535
       
-
       


     

       
536
       
-
       
  let get_string json key =

     

       
537
       
-
       
    match get_field json key with

     

       
538
       
-
       
    | Some (Jsont.String (s, _)) -> Some s

     

       
539
       
-
       
    | _ -> None

     

       
540
       
-
       


     

       
541
       
-
       
  let get_bool json key =

     

       
542
       
-
       
    match get_field json key with

     

       
543
       
-
       
    | Some (Jsont.Bool (b, _)) -> Some b

     

       
544
       
-
       
    | _ -> None

     

       
545
       
-
       


     

       
546
       
-
       
  let of_json json =

     

       
547
       
-
       
    match get_string json "session_id" with

     

       
548
       
-
       
    | None -> raise (Invalid_argument "SubagentStop: missing session_id")

     

       
549
       
-
       
    | Some session_id ->

     

       
550
       
-
       
        match get_string json "transcript_path" with

     

       
551
       
-
       
        | None -> raise (Invalid_argument "SubagentStop: missing transcript_path")

     

       
552
       
-
       
        | Some transcript_path ->

     

       
553
       
-
       
            match get_bool json "stop_hook_active" with

     

       
554
       
-
       
            | None -> raise (Invalid_argument "SubagentStop: missing stop_hook_active")

     

       
555
       
-
       
            | Some stop_hook_active ->

     

       
556
       
-
       
                { session_id; transcript_path; stop_hook_active; unknown = json }

     

       
557
       
 
       
end

     

       
558
       
 
       


     

       
559
       
 
       
(** {1 PreCompact Hook} *)

     
···

       
571
       
 
       
    unknown : Input_unknown.t;

     

       
572
       
 
       
  }

     

       
573
       
 
       


     

       
574
       
-
       
  let get_field json key =

     

       
575
       
-
       
    match json with

     

       
576
       
-
       
    | Jsont.Object (members, _) ->

     

       
577
       
-
       
        List.find_map (fun ((name, _), value) ->

     

       
578
       
-
       
          if name = key then Some value else None

     

       
579
       
-
       
        ) members

     

       
580
       
-
       
    | _ -> None

     

       
581
       
-
       


     

       
582
       
-
       
  let get_string json key =

     

       
583
       
-
       
    match get_field json key with

     

       
584
       
-
       
    | Some (Jsont.String (s, _)) -> Some s

     

       
585
       
-
       
    | _ -> None

     

       
586
       
-
       


     

       
587
       
-
       
  let of_json json =

     

       
588
       
-
       
    match get_string json "session_id" with

     

       
589
       
-
       
    | None -> raise (Invalid_argument "PreCompact: missing session_id")

     

       
590
       
-
       
    | Some session_id ->

     

       
591
       
-
       
        match get_string json "transcript_path" with

     

       
592
       
-
       
        | None -> raise (Invalid_argument "PreCompact: missing transcript_path")

     

       
593
       
-
       
        | Some transcript_path ->

     

       
594
       
-
       
            { session_id; transcript_path; unknown = json }

     

       
595
       
-
       


     

       
596
       
 
       
  type t = input

     

       
597
       
 
       


     

       
598
       
 
       
  let session_id t = t.session_id

     
···

       
608
       
 
       
    |> Jsont.Object.mem "transcript_path" Jsont.string ~enc:transcript_path

     

       
609
       
 
       
    |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown

     

       
610
       
 
       
    |> Jsont.Object.finish

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
611
       
 
       


     

       
612
       
 
       
  type output = unit  (* No specific output for PreCompact *)

     

       
613
       
 
       


     

···

       
117
       
 
       
    unknown : Input_unknown.t;

     

       
118
       
 
       
  }

     

       
119
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
120
       
 
       
  type t = input

     

       
121
       
 
       


     

       
122
       
 
       
  let session_id t = t.session_id

     
···

       
136
       
 
       
    |> Jsont.Object.mem "tool_input" Jsont.json ~enc:tool_input

     

       
137
       
 
       
    |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown

     

       
138
       
 
       
    |> Jsont.Object.finish

     

       
139
       
+
       


     

       
140
       
+
       
  let of_json json =

     

       
141
       
+
       
    match Jsont.Json.decode input_jsont json with

     

       
142
       
+
       
    | Ok v -> v

     

       
143
       
+
       
    | Error msg -> raise (Invalid_argument ("PreToolUse: " ^ msg))

     

       
144
       
 
       


     

       
145
       
 
       
  type permission_decision = [ `Allow | `Deny | `Ask ]

     

       
146
       
 
       


     
···

       
216
       
 
       
    unknown : Input_unknown.t;

     

       
217
       
 
       
  }

     

       
218
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
219
       
 
       
  type t = input

     

       
220
       
 
       


     

       
221
       
 
       
  let session_id t = t.session_id

     
···

       
237
       
 
       
    |> Jsont.Object.mem "tool_response" Jsont.json ~enc:tool_response

     

       
238
       
 
       
    |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown

     

       
239
       
 
       
    |> Jsont.Object.finish

     

       
240
       
+
       


     

       
241
       
+
       
  let of_json json =

     

       
242
       
+
       
    match Jsont.Json.decode input_jsont json with

     

       
243
       
+
       
    | Ok v -> v

     

       
244
       
+
       
    | Error msg -> raise (Invalid_argument ("PostToolUse: " ^ msg))

     

       
245
       
 
       


     

       
246
       
 
       
  module Output_unknown = struct

     

       
247
       
 
       
    type t = Jsont.json

     
···

       
296
       
 
       
    unknown : Input_unknown.t;

     

       
297
       
 
       
  }

     

       
298
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
299
       
 
       
  type t = input

     

       
300
       
 
       


     

       
301
       
 
       
  let session_id t = t.session_id

     
···

       
314
       
 
       
    |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown

     

       
315
       
 
       
    |> Jsont.Object.finish

     

       
316
       
 
       


     

       
317
       
+
       
  let of_json json =

     

       
318
       
+
       
    match Jsont.Json.decode input_jsont json with

     

       
319
       
+
       
    | Ok v -> v

     

       
320
       
+
       
    | Error msg -> raise (Invalid_argument ("UserPromptSubmit: " ^ msg))

     

       
321
       
+
       


     

       
322
       
 
       
  module Output_unknown = struct

     

       
323
       
 
       
    type t = Jsont.json

     

       
324
       
 
       
    let empty = Jsont.Object ([], Jsont.Meta.none)

     
···

       
372
       
 
       
    unknown : Input_unknown.t;

     

       
373
       
 
       
  }

     

       
374
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
375
       
 
       
  type t = input

     

       
376
       
 
       


     

       
377
       
 
       
  let session_id t = t.session_id

     
···

       
389
       
 
       
    |> Jsont.Object.mem "stop_hook_active" Jsont.bool ~enc:stop_hook_active

     

       
390
       
 
       
    |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown

     

       
391
       
 
       
    |> Jsont.Object.finish

     

       
392
       
+
       


     

       
393
       
+
       
  let of_json json =

     

       
394
       
+
       
    match Jsont.Json.decode input_jsont json with

     

       
395
       
+
       
    | Ok v -> v

     

       
396
       
+
       
    | Error msg -> raise (Invalid_argument ("Stop: " ^ msg))

     

       
397
       
 
       


     

       
398
       
 
       
  module Output_unknown = struct

     

       
399
       
 
       
    type t = Jsont.json

     
···

       
430
       
 
       
(** {1 SubagentStop Hook} - Same structure as Stop *)

     

       
431
       
 
       
module SubagentStop = struct

     

       
432
       
 
       
  include Stop

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
433
       
 
       
end

     

       
434
       
 
       


     

       
435
       
 
       
(** {1 PreCompact Hook} *)

     
···

       
447
       
 
       
    unknown : Input_unknown.t;

     

       
448
       
 
       
  }

     

       
449
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
450
       
 
       
  type t = input

     

       
451
       
 
       


     

       
452
       
 
       
  let session_id t = t.session_id

     
···

       
462
       
 
       
    |> Jsont.Object.mem "transcript_path" Jsont.string ~enc:transcript_path

     

       
463
       
 
       
    |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown

     

       
464
       
 
       
    |> Jsont.Object.finish

     

       
465
       
+
       


     

       
466
       
+
       
  let of_json json =

     

       
467
       
+
       
    match Jsont.Json.decode input_jsont json with

     

       
468
       
+
       
    | Ok v -> v

     

       
469
       
+
       
    | Error msg -> raise (Invalid_argument ("PreCompact: " ^ msg))

     

       
470
       
 
       


     

       
471
       
 
       
  type output = unit  (* No specific output for PreCompact *)

     

       
472
       
 
       


     

···

       
1
       
 
       
let src = Logs.Src.create "claude.incoming" ~doc:"Incoming messages from Claude CLI"

     

       
2
       
 
       
module Log = (val Logs.src_log src : Logs.LOG)

     

       
3
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
4
       
 
       
type t =

     

       
5
       
 
       
  | Message of Message.t

     

       
6
       
 
       
  | Control_response of Sdk_control.control_response

     

       
0
       
 
       

     

       
7
       
 
       


     

       
8
       
 
       
let jsont : t Jsont.t =

     

       
9
       
 
       
  (* Custom decoder that checks the type field and dispatches to the appropriate codec.

     

       
10
       
 
       


     

       
11
       
 
       
     The challenge is that Message can have multiple type values ("user", "assistant",

     

       
12
       
-
       
     "system", "result"), while control_response has only one type value. Jsont's

     

       
13
       
-
       
     case_mem discriminator doesn't support multiple tags per case, so we implement

     

       
14
       
 
       
     a custom decoder/encoder. *)

     

       
15
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
16
       
 
       
  let dec json =

     

       
17
       
-
       
    (* First check if it has a type field *)

     

       
18
       
-
       
    match json with

     

       
19
       
-
       
    | Jsont.Object (members, _meta) ->

     

       
20
       
-
       
        let type_field = List.find_map (fun ((name, _), value) ->

     

       
21
       
-
       
          if name = "type" then

     

       
22
       
-
       
            match value with

     

       
23
       
-
       
            | Jsont.String (s, _) -> Some s

     

       
24
       
-
       
            | _ -> None

     

       
25
       
-
       
          else None

     

       
26
       
-
       
        ) members in

     

       
27
       
-
       
        (match type_field with

     

       
28
       
-
       
        | Some "control_response" ->

     

       
29
       
 
       
            (match Jsont.Json.decode Sdk_control.control_response_jsont json with

     

       
30
       
 
       
            | Ok resp -> Control_response resp

     

       
31
       
 
       
            | Error err -> failwith ("Failed to decode control_response: " ^ err))

     

       
32
       
-
       
        | Some ("user" | "assistant" | "system" | "result") | Some _ | None ->

     

       
33
       
-
       
            (* Try to decode as message *)

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
34
       
 
       
            (match Jsont.Json.decode Message.jsont json with

     

       
35
       
 
       
            | Ok msg -> Message msg

     

       
36
       
-
       
            | Error err -> failwith ("Failed to decode message: " ^ err)))

     

       
37
       
-
       
    | _ -> failwith "Expected JSON object for incoming message"

     

       
38
       
 
       
  in

     

       
39
       
 
       


     

       
40
       
 
       
  let enc = function

     
···

       
46
       
 
       
        (match Jsont.Json.encode Sdk_control.control_response_jsont resp with

     

       
47
       
 
       
        | Ok json -> json

     

       
48
       
 
       
        | Error err -> failwith ("Failed to encode control response: " ^ err))

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
49
       
 
       
  in

     

       
50
       
 
       


     

       
51
       
 
       
  Jsont.map ~kind:"Incoming" ~dec ~enc Jsont.json

     
···

       
53
       
 
       
let pp fmt = function

     

       
54
       
 
       
  | Message msg -> Format.fprintf fmt "@[<2>Message@ %a@]" Message.pp msg

     

       
55
       
 
       
  | Control_response resp -> Format.fprintf fmt "@[<2>ControlResponse@ %a@]" Sdk_control.pp (Sdk_control.Response resp)

     

       
0
       
 
       

     

       
0
       
 
       

     

···

       
1
       
 
       
let src = Logs.Src.create "claude.incoming" ~doc:"Incoming messages from Claude CLI"

     

       
2
       
 
       
module Log = (val Logs.src_log src : Logs.LOG)

     

       
3
       
 
       


     

       
4
       
+
       
(** Control request types for incoming control_request messages *)

     

       
5
       
+
       
module Control_request = struct

     

       
6
       
+
       
  (** Can use tool permission request *)

     

       
7
       
+
       
  module Can_use_tool = struct

     

       
8
       
+
       
    type t = {

     

       
9
       
+
       
      tool_name : string;

     

       
10
       
+
       
      input : Jsont.json;

     

       
11
       
+
       
      permission_suggestions : Jsont.json list;

     

       
12
       
+
       
    }

     

       
13
       
+
       


     

       
14
       
+
       
    let tool_name t = t.tool_name

     

       
15
       
+
       
    let input t = t.input

     

       
16
       
+
       
    let permission_suggestions t = t.permission_suggestions

     

       
17
       
+
       


     

       
18
       
+
       
    let jsont : t Jsont.t =

     

       
19
       
+
       
      let make tool_name input permission_suggestions =

     

       
20
       
+
       
        { tool_name; input; permission_suggestions = Option.value permission_suggestions ~default:[] }

     

       
21
       
+
       
      in

     

       
22
       
+
       
      Jsont.Object.map ~kind:"CanUseTool" make

     

       
23
       
+
       
      |> Jsont.Object.mem "tool_name" Jsont.string ~enc:tool_name

     

       
24
       
+
       
      |> Jsont.Object.mem "input" Jsont.json ~enc:input

     

       
25
       
+
       
      |> Jsont.Object.opt_mem "permission_suggestions" (Jsont.list Jsont.json)

     

       
26
       
+
       
          ~enc:(fun t -> if t.permission_suggestions = [] then None else Some t.permission_suggestions)

     

       
27
       
+
       
      |> Jsont.Object.finish

     

       
28
       
+
       
  end

     

       
29
       
+
       


     

       
30
       
+
       
  (** Hook callback request *)

     

       
31
       
+
       
  module Hook_callback = struct

     

       
32
       
+
       
    type t = {

     

       
33
       
+
       
      callback_id : string;

     

       
34
       
+
       
      input : Jsont.json;

     

       
35
       
+
       
      tool_use_id : string option;

     

       
36
       
+
       
    }

     

       
37
       
+
       


     

       
38
       
+
       
    let callback_id t = t.callback_id

     

       
39
       
+
       
    let input t = t.input

     

       
40
       
+
       
    let tool_use_id t = t.tool_use_id

     

       
41
       
+
       


     

       
42
       
+
       
    let jsont : t Jsont.t =

     

       
43
       
+
       
      let make callback_id input tool_use_id = { callback_id; input; tool_use_id } in

     

       
44
       
+
       
      Jsont.Object.map ~kind:"HookCallback" make

     

       
45
       
+
       
      |> Jsont.Object.mem "callback_id" Jsont.string ~enc:callback_id

     

       
46
       
+
       
      |> Jsont.Object.mem "input" Jsont.json ~enc:input

     

       
47
       
+
       
      |> Jsont.Object.opt_mem "tool_use_id" Jsont.string ~enc:tool_use_id

     

       
48
       
+
       
      |> Jsont.Object.finish

     

       
49
       
+
       
  end

     

       
50
       
+
       


     

       
51
       
+
       
  (** Request payload - discriminated by subtype *)

     

       
52
       
+
       
  type request =

     

       
53
       
+
       
    | Can_use_tool of Can_use_tool.t

     

       
54
       
+
       
    | Hook_callback of Hook_callback.t

     

       
55
       
+
       
    | Unknown of string * Jsont.json

     

       
56
       
+
       


     

       
57
       
+
       
  let request_of_json json =

     

       
58
       
+
       
    let subtype_codec = Jsont.Object.map ~kind:"Subtype" Fun.id

     

       
59
       
+
       
      |> Jsont.Object.mem "subtype" Jsont.string ~enc:Fun.id

     

       
60
       
+
       
      |> Jsont.Object.finish

     

       
61
       
+
       
    in

     

       
62
       
+
       
    match Jsont.Json.decode subtype_codec json with

     

       
63
       
+
       
    | Error _ -> Unknown ("unknown", json)

     

       
64
       
+
       
    | Ok subtype ->

     

       
65
       
+
       
        match subtype with

     

       
66
       
+
       
        | "can_use_tool" ->

     

       
67
       
+
       
            (match Jsont.Json.decode Can_use_tool.jsont json with

     

       
68
       
+
       
            | Ok r -> Can_use_tool r

     

       
69
       
+
       
            | Error _ -> Unknown (subtype, json))

     

       
70
       
+
       
        | "hook_callback" ->

     

       
71
       
+
       
            (match Jsont.Json.decode Hook_callback.jsont json with

     

       
72
       
+
       
            | Ok r -> Hook_callback r

     

       
73
       
+
       
            | Error _ -> Unknown (subtype, json))

     

       
74
       
+
       
        | _ -> Unknown (subtype, json)

     

       
75
       
+
       


     

       
76
       
+
       
  (** Full control request message *)

     

       
77
       
+
       
  type t = {

     

       
78
       
+
       
    request_id : string;

     

       
79
       
+
       
    request : request;

     

       
80
       
+
       
  }

     

       
81
       
+
       


     

       
82
       
+
       
  let request_id t = t.request_id

     

       
83
       
+
       
  let request t = t.request

     

       
84
       
+
       


     

       
85
       
+
       
  let subtype t =

     

       
86
       
+
       
    match t.request with

     

       
87
       
+
       
    | Can_use_tool _ -> "can_use_tool"

     

       
88
       
+
       
    | Hook_callback _ -> "hook_callback"

     

       
89
       
+
       
    | Unknown (s, _) -> s

     

       
90
       
+
       


     

       
91
       
+
       
  let jsont : t Jsont.t =

     

       
92
       
+
       
    let dec json =

     

       
93
       
+
       
      let envelope_codec =

     

       
94
       
+
       
        Jsont.Object.map ~kind:"ControlRequestEnvelope" (fun request_id request_json -> (request_id, request_json))

     

       
95
       
+
       
        |> Jsont.Object.mem "request_id" Jsont.string ~enc:fst

     

       
96
       
+
       
        |> Jsont.Object.mem "request" Jsont.json ~enc:snd

     

       
97
       
+
       
        |> Jsont.Object.finish

     

       
98
       
+
       
      in

     

       
99
       
+
       
      match Jsont.Json.decode envelope_codec json with

     

       
100
       
+
       
      | Error err -> failwith ("Failed to decode control_request envelope: " ^ err)

     

       
101
       
+
       
      | Ok (request_id, request_json) ->

     

       
102
       
+
       
          { request_id; request = request_of_json request_json }

     

       
103
       
+
       
    in

     

       
104
       
+
       
    let enc t =

     

       
105
       
+
       
      let request_json = match t.request with

     

       
106
       
+
       
        | Can_use_tool r ->

     

       
107
       
+
       
            (match Jsont.Json.encode Can_use_tool.jsont r with

     

       
108
       
+
       
            | Ok j -> j

     

       
109
       
+
       
            | Error err -> failwith ("Failed to encode Can_use_tool: " ^ err))

     

       
110
       
+
       
        | Hook_callback r ->

     

       
111
       
+
       
            (match Jsont.Json.encode Hook_callback.jsont r with

     

       
112
       
+
       
            | Ok j -> j

     

       
113
       
+
       
            | Error err -> failwith ("Failed to encode Hook_callback: " ^ err))

     

       
114
       
+
       
        | Unknown (_, j) -> j

     

       
115
       
+
       
      in

     

       
116
       
+
       
      Jsont.Json.object' [

     

       
117
       
+
       
        Jsont.Json.mem (Jsont.Json.name "type") (Jsont.Json.string "control_request");

     

       
118
       
+
       
        Jsont.Json.mem (Jsont.Json.name "request_id") (Jsont.Json.string t.request_id);

     

       
119
       
+
       
        Jsont.Json.mem (Jsont.Json.name "request") request_json;

     

       
120
       
+
       
      ]

     

       
121
       
+
       
    in

     

       
122
       
+
       
    Jsont.map ~kind:"ControlRequest" ~dec ~enc Jsont.json

     

       
123
       
+
       
end

     

       
124
       
+
       


     

       
125
       
 
       
type t =

     

       
126
       
 
       
  | Message of Message.t

     

       
127
       
 
       
  | Control_response of Sdk_control.control_response

     

       
128
       
+
       
  | Control_request of Control_request.t

     

       
129
       
 
       


     

       
130
       
 
       
let jsont : t Jsont.t =

     

       
131
       
 
       
  (* Custom decoder that checks the type field and dispatches to the appropriate codec.

     

       
132
       
 
       


     

       
133
       
 
       
     The challenge is that Message can have multiple type values ("user", "assistant",

     

       
134
       
+
       
     "system", "result"), while control_response and control_request have single type values.

     

       
135
       
+
       
     Jsont's case_mem discriminator doesn't support multiple tags per case, so we implement

     

       
136
       
 
       
     a custom decoder/encoder. *)

     

       
137
       
 
       


     

       
138
       
+
       
  let type_field_codec = Jsont.Object.map ~kind:"type_field" Fun.id

     

       
139
       
+
       
    |> Jsont.Object.opt_mem "type" Jsont.string ~enc:Fun.id

     

       
140
       
+
       
    |> Jsont.Object.finish

     

       
141
       
+
       
  in

     

       
142
       
+
       


     

       
143
       
 
       
  let dec json =

     

       
144
       
+
       
    match Jsont.Json.decode type_field_codec json with

     

       
145
       
+
       
    | Error _ | Ok None ->

     

       
146
       
+
       
        (* No type field, try as message *)

     

       
147
       
+
       
        (match Jsont.Json.decode Message.jsont json with

     

       
148
       
+
       
        | Ok msg -> Message msg

     

       
149
       
+
       
        | Error err -> failwith ("Failed to decode message: " ^ err))

     

       
150
       
+
       
    | Ok (Some typ) ->

     

       
151
       
+
       
        match typ with

     

       
152
       
+
       
        | "control_response" ->

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
153
       
 
       
            (match Jsont.Json.decode Sdk_control.control_response_jsont json with

     

       
154
       
 
       
            | Ok resp -> Control_response resp

     

       
155
       
 
       
            | Error err -> failwith ("Failed to decode control_response: " ^ err))

     

       
156
       
+
       
        | "control_request" ->

     

       
157
       
+
       
            (match Jsont.Json.decode Control_request.jsont json with

     

       
158
       
+
       
            | Ok req -> Control_request req

     

       
159
       
+
       
            | Error err -> failwith ("Failed to decode control_request: " ^ err))

     

       
160
       
+
       
        | "user" | "assistant" | "system" | "result" | _ ->

     

       
161
       
+
       
            (* Message types *)

     

       
162
       
 
       
            (match Jsont.Json.decode Message.jsont json with

     

       
163
       
 
       
            | Ok msg -> Message msg

     

       
164
       
+
       
            | Error err -> failwith ("Failed to decode message: " ^ err))

     

       
0
       
 
       

     

       
165
       
 
       
  in

     

       
166
       
 
       


     

       
167
       
 
       
  let enc = function

     
···

       
173
       
 
       
        (match Jsont.Json.encode Sdk_control.control_response_jsont resp with

     

       
174
       
 
       
        | Ok json -> json

     

       
175
       
 
       
        | Error err -> failwith ("Failed to encode control response: " ^ err))

     

       
176
       
+
       
    | Control_request req ->

     

       
177
       
+
       
        (match Jsont.Json.encode Control_request.jsont req with

     

       
178
       
+
       
        | Ok json -> json

     

       
179
       
+
       
        | Error err -> failwith ("Failed to encode control request: " ^ err))

     

       
180
       
 
       
  in

     

       
181
       
 
       


     

       
182
       
 
       
  Jsont.map ~kind:"Incoming" ~dec ~enc Jsont.json

     
···

       
184
       
 
       
let pp fmt = function

     

       
185
       
 
       
  | Message msg -> Format.fprintf fmt "@[<2>Message@ %a@]" Message.pp msg

     

       
186
       
 
       
  | Control_response resp -> Format.fprintf fmt "@[<2>ControlResponse@ %a@]" Sdk_control.pp (Sdk_control.Response resp)

     

       
187
       
+
       
  | Control_request req -> Format.fprintf fmt "@[<2>ControlRequest@ { request_id=%S; subtype=%S }@]"

     

       
188
       
+
       
      (Control_request.request_id req) (Control_request.subtype req)