anil.recoil.org
OCaml Claude SDK using Eio and Jsont
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** Control protocol wire format for SDK communication. *)
7
8module Request = struct
9 (* Individual record types for each request variant - private to this module *)
10 type permission_r = {
11 tool_name : string;
12 input : Jsont.json;
13 permission_suggestions : Permissions.Update.t list option;
14 blocked_path : string option;
15 unknown : Unknown.t;
16 }
17
18 type initialize_r = {
19 hooks : (string * Jsont.json) list option;
20 unknown : Unknown.t;
21 }
22
23 type set_permission_mode_r = {
24 mode : Permissions.Mode.t;
25 unknown : Unknown.t;
26 }
27
28 type hook_callback_r = {
29 callback_id : string;
30 input : Jsont.json;
31 tool_use_id : string option;
32 unknown : Unknown.t;
33 }
34
35 type mcp_message_r = {
36 server_name : string;
37 message : Jsont.json;
38 unknown : Unknown.t;
39 }
40
41 type set_model_r = { model : string; unknown : Unknown.t }
42
43 type t =
44 | Interrupt
45 | Permission of permission_r
46 | Initialize of initialize_r
47 | Set_permission_mode of set_permission_mode_r
48 | Hook_callback of hook_callback_r
49 | Mcp_message of mcp_message_r
50 | Set_model of set_model_r
51 | Get_server_info
52
53 let interrupt () = Interrupt
54
55 let permission ~tool_name ~input ?permission_suggestions ?blocked_path () =
56 Permission
57 {
58 tool_name;
59 input;
60 permission_suggestions;
61 blocked_path;
62 unknown = Unknown.empty;
63 }
64
65 let initialize ?hooks () = Initialize { hooks; unknown = Unknown.empty }
66
67 let set_permission_mode ~mode () =
68 Set_permission_mode { mode; unknown = Unknown.empty }
69
70 let hook_callback ~callback_id ~input ?tool_use_id () =
71 Hook_callback { callback_id; input; tool_use_id; unknown = Unknown.empty }
72
73 let mcp_message ~server_name ~message () =
74 Mcp_message { server_name; message; unknown = Unknown.empty }
75
76 let set_model ~model () = Set_model { model; unknown = Unknown.empty }
77 let get_server_info () = Get_server_info
78
79 (* Individual record codecs *)
80 let interrupt_jsont : unit Jsont.t =
81 Jsont.Object.map ~kind:"Interrupt" (fun _unknown -> ())
82 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun () -> Unknown.empty)
83 |> Jsont.Object.finish
84
85 let permission_jsont : permission_r Jsont.t =
86 let make tool_name input permission_suggestions blocked_path unknown :
87 permission_r =
88 { tool_name; input; permission_suggestions; blocked_path; unknown }
89 in
90 Jsont.Object.map ~kind:"Permission" make
91 |> Jsont.Object.mem "toolName" Jsont.string ~enc:(fun (r : permission_r) ->
92 r.tool_name)
93 |> Jsont.Object.mem "input" Jsont.json ~enc:(fun (r : permission_r) ->
94 r.input)
95 |> Jsont.Object.opt_mem "permissionSuggestions"
96 (Jsont.list Permissions.Update.jsont) ~enc:(fun (r : permission_r) ->
97 r.permission_suggestions)
98 |> Jsont.Object.opt_mem "blockedPath" Jsont.string
99 ~enc:(fun (r : permission_r) -> r.blocked_path)
100 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : permission_r) ->
101 r.unknown)
102 |> Jsont.Object.finish
103
104 let initialize_jsont : initialize_r Jsont.t =
105 (* The hooks field is an object with string keys and json values *)
106 let hooks_map_jsont = Jsont.Object.as_string_map Jsont.json in
107 let module StringMap = Map.Make (String) in
108 let hooks_jsont =
109 Jsont.map
110 ~dec:(fun m -> StringMap.bindings m)
111 ~enc:(fun l -> StringMap.of_seq (List.to_seq l))
112 hooks_map_jsont
113 in
114 let make hooks unknown = { hooks; unknown } in
115 Jsont.Object.map ~kind:"Initialize" make
116 |> Jsont.Object.opt_mem "hooks" hooks_jsont ~enc:(fun (r : initialize_r) ->
117 r.hooks)
118 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : initialize_r) ->
119 r.unknown)
120 |> Jsont.Object.finish
121
122 let set_permission_mode_jsont : set_permission_mode_r Jsont.t =
123 let make mode unknown = { mode; unknown } in
124 Jsont.Object.map ~kind:"SetPermissionMode" make
125 |> Jsont.Object.mem "mode" Permissions.Mode.jsont
126 ~enc:(fun (r : set_permission_mode_r) -> r.mode)
127 |> Jsont.Object.keep_unknown Unknown.mems
128 ~enc:(fun (r : set_permission_mode_r) -> r.unknown)
129 |> Jsont.Object.finish
130
131 let hook_callback_jsont : hook_callback_r Jsont.t =
132 let make callback_id input tool_use_id unknown =
133 { callback_id; input; tool_use_id; unknown }
134 in
135 Jsont.Object.map ~kind:"HookCallback" make
136 |> Jsont.Object.mem "callbackId" Jsont.string
137 ~enc:(fun (r : hook_callback_r) -> r.callback_id)
138 |> Jsont.Object.mem "input" Jsont.json ~enc:(fun (r : hook_callback_r) ->
139 r.input)
140 |> Jsont.Object.opt_mem "toolUseId" Jsont.string
141 ~enc:(fun (r : hook_callback_r) -> r.tool_use_id)
142 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : hook_callback_r) ->
143 r.unknown)
144 |> Jsont.Object.finish
145
146 let mcp_message_jsont : mcp_message_r Jsont.t =
147 let make server_name message unknown = { server_name; message; unknown } in
148 Jsont.Object.map ~kind:"McpMessage" make
149 |> Jsont.Object.mem "serverName" Jsont.string
150 ~enc:(fun (r : mcp_message_r) -> r.server_name)
151 |> Jsont.Object.mem "message" Jsont.json ~enc:(fun (r : mcp_message_r) ->
152 r.message)
153 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : mcp_message_r) ->
154 r.unknown)
155 |> Jsont.Object.finish
156
157 let set_model_jsont : set_model_r Jsont.t =
158 let make model unknown = { model; unknown } in
159 Jsont.Object.map ~kind:"SetModel" make
160 |> Jsont.Object.mem "model" Jsont.string ~enc:(fun (r : set_model_r) ->
161 r.model)
162 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : set_model_r) ->
163 r.unknown)
164 |> Jsont.Object.finish
165
166 let get_server_info_jsont : unit Jsont.t =
167 Jsont.Object.map ~kind:"GetServerInfo" (fun _unknown -> ())
168 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun () -> Unknown.empty)
169 |> Jsont.Object.finish
170
171 (* Main variant codec using subtype discriminator *)
172 let jsont : t Jsont.t =
173 let case_interrupt =
174 Jsont.Object.Case.map "interrupt" interrupt_jsont ~dec:(fun () ->
175 Interrupt)
176 in
177 let case_permission =
178 Jsont.Object.Case.map "canUseTool" permission_jsont ~dec:(fun v ->
179 Permission v)
180 in
181 let case_initialize =
182 Jsont.Object.Case.map "initialize" initialize_jsont ~dec:(fun v ->
183 Initialize v)
184 in
185 let case_set_permission_mode =
186 Jsont.Object.Case.map "setPermissionMode" set_permission_mode_jsont
187 ~dec:(fun v -> Set_permission_mode v)
188 in
189 let case_hook_callback =
190 Jsont.Object.Case.map "hookCallback" hook_callback_jsont ~dec:(fun v ->
191 Hook_callback v)
192 in
193 let case_mcp_message =
194 Jsont.Object.Case.map "mcpMessage" mcp_message_jsont ~dec:(fun v ->
195 Mcp_message v)
196 in
197 let case_set_model =
198 Jsont.Object.Case.map "setModel" set_model_jsont ~dec:(fun v ->
199 Set_model v)
200 in
201 let case_get_server_info =
202 Jsont.Object.Case.map "getServerInfo" get_server_info_jsont
203 ~dec:(fun () -> Get_server_info)
204 in
205
206 let enc_case = function
207 | Interrupt -> Jsont.Object.Case.value case_interrupt ()
208 | Permission v -> Jsont.Object.Case.value case_permission v
209 | Initialize v -> Jsont.Object.Case.value case_initialize v
210 | Set_permission_mode v ->
211 Jsont.Object.Case.value case_set_permission_mode v
212 | Hook_callback v -> Jsont.Object.Case.value case_hook_callback v
213 | Mcp_message v -> Jsont.Object.Case.value case_mcp_message v
214 | Set_model v -> Jsont.Object.Case.value case_set_model v
215 | Get_server_info -> Jsont.Object.Case.value case_get_server_info ()
216 in
217
218 let cases =
219 Jsont.Object.Case.
220 [
221 make case_interrupt;
222 make case_permission;
223 make case_initialize;
224 make case_set_permission_mode;
225 make case_hook_callback;
226 make case_mcp_message;
227 make case_set_model;
228 make case_get_server_info;
229 ]
230 in
231
232 Jsont.Object.map ~kind:"Request" Fun.id
233 |> Jsont.Object.case_mem "subtype" Jsont.string ~enc:Fun.id ~enc_case cases
234 ~tag_to_string:Fun.id ~tag_compare:String.compare
235 |> Jsont.Object.finish
236end
237
238module Response = struct
239 (* Standard JSON-RPC 2.0 error codes using polymorphic variants *)
240 module Error_code = struct
241 type t =
242 [ `Parse_error
243 | `Invalid_request
244 | `Method_not_found
245 | `Invalid_params
246 | `Internal_error
247 | `Custom of int ]
248
249 let to_int : [< t ] -> int = function
250 | `Parse_error -> -32700
251 | `Invalid_request -> -32600
252 | `Method_not_found -> -32601
253 | `Invalid_params -> -32602
254 | `Internal_error -> -32603
255 | `Custom n -> n
256
257 let of_int = function
258 | -32700 -> `Parse_error
259 | -32600 -> `Invalid_request
260 | -32601 -> `Method_not_found
261 | -32602 -> `Invalid_params
262 | -32603 -> `Internal_error
263 | n -> `Custom n
264 end
265
266 (* Structured error similar to JSON-RPC *)
267 type error_detail = { code : int; message : string; data : Jsont.json option }
268
269 let error_detail ~code ~message ?data () =
270 { code = Error_code.to_int code; message; data }
271
272 let error_detail_jsont : error_detail Jsont.t =
273 let make code message data = { code; message; data } in
274 Jsont.Object.map ~kind:"ErrorDetail" make
275 |> Jsont.Object.mem "code" Jsont.int ~enc:(fun e -> e.code)
276 |> Jsont.Object.mem "message" Jsont.string ~enc:(fun e -> e.message)
277 |> Jsont.Object.opt_mem "data" Jsont.json ~enc:(fun e -> e.data)
278 |> Jsont.Object.finish
279
280 (* Individual record types for each response variant *)
281 type success_r = {
282 request_id : string;
283 response : Jsont.json option;
284 unknown : Unknown.t;
285 }
286
287 type error_r = {
288 request_id : string;
289 error : error_detail;
290 unknown : Unknown.t;
291 }
292
293 type t = Success of success_r | Error of error_r
294
295 let success ~request_id ?response () =
296 Success { request_id; response; unknown = Unknown.empty }
297
298 let error ~request_id ~error () =
299 Error { request_id; error; unknown = Unknown.empty }
300
301 (* Individual record codecs *)
302 let success_jsont : success_r Jsont.t =
303 let make request_id response unknown = { request_id; response; unknown } in
304 Jsont.Object.map ~kind:"Success" make
305 |> Jsont.Object.mem "requestId" Jsont.string ~enc:(fun (r : success_r) ->
306 r.request_id)
307 |> Jsont.Object.opt_mem "response" Jsont.json ~enc:(fun (r : success_r) ->
308 r.response)
309 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : success_r) ->
310 r.unknown)
311 |> Jsont.Object.finish
312
313 let error_jsont : error_r Jsont.t =
314 let make request_id error unknown = { request_id; error; unknown } in
315 Jsont.Object.map ~kind:"Error" make
316 |> Jsont.Object.mem "requestId" Jsont.string ~enc:(fun (r : error_r) ->
317 r.request_id)
318 |> Jsont.Object.mem "error" error_detail_jsont ~enc:(fun (r : error_r) ->
319 r.error)
320 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : error_r) ->
321 r.unknown)
322 |> Jsont.Object.finish
323
324 (* Main variant codec using subtype discriminator *)
325 let jsont : t Jsont.t =
326 let case_success =
327 Jsont.Object.Case.map "success" success_jsont ~dec:(fun v -> Success v)
328 in
329 let case_error =
330 Jsont.Object.Case.map "error" error_jsont ~dec:(fun v -> Error v)
331 in
332
333 let enc_case = function
334 | Success v -> Jsont.Object.Case.value case_success v
335 | Error v -> Jsont.Object.Case.value case_error v
336 in
337
338 let cases = Jsont.Object.Case.[ make case_success; make case_error ] in
339
340 Jsont.Object.map ~kind:"Response" Fun.id
341 |> Jsont.Object.case_mem "subtype" Jsont.string ~enc:Fun.id ~enc_case cases
342 ~tag_to_string:Fun.id ~tag_compare:String.compare
343 |> Jsont.Object.finish
344end
345
346type request_envelope = {
347 request_id : string;
348 request : Request.t;
349 unknown : Unknown.t;
350}
351
352type response_envelope = { response : Response.t; unknown : Unknown.t }
353
354let create_request ~request_id ~request () =
355 { request_id; request; unknown = Unknown.empty }
356
357let create_response ~response () = { response; unknown = Unknown.empty }
358
359(* Envelope codecs *)
360let request_envelope_jsont : request_envelope Jsont.t =
361 let make request_id request unknown = { request_id; request; unknown } in
362 Jsont.Object.map ~kind:"RequestEnvelope" make
363 |> Jsont.Object.mem "requestId" Jsont.string
364 ~enc:(fun (r : request_envelope) -> r.request_id)
365 |> Jsont.Object.mem "request" Request.jsont
366 ~enc:(fun (r : request_envelope) -> r.request)
367 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : request_envelope) ->
368 r.unknown)
369 |> Jsont.Object.finish
370
371let response_envelope_jsont : response_envelope Jsont.t =
372 let make response unknown = { response; unknown } in
373 Jsont.Object.map ~kind:"ResponseEnvelope" make
374 |> Jsont.Object.mem "response" Response.jsont
375 ~enc:(fun (r : response_envelope) -> r.response)
376 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun (r : response_envelope) ->
377 r.unknown)
378 |> Jsont.Object.finish
379
380(** Server information *)
381module Server_info = struct
382 type t = {
383 version : string;
384 capabilities : string list;
385 commands : string list;
386 output_styles : string list;
387 unknown : Unknown.t;
388 }
389
390 let create ~version ~capabilities ~commands ~output_styles () =
391 { version; capabilities; commands; output_styles; unknown = Unknown.empty }
392
393 let version t = t.version
394 let capabilities t = t.capabilities
395 let commands t = t.commands
396 let output_styles t = t.output_styles
397 let unknown t = t.unknown
398
399 let jsont : t Jsont.t =
400 let make version capabilities commands output_styles unknown =
401 { version; capabilities; commands; output_styles; unknown }
402 in
403 Jsont.Object.map ~kind:"ServerInfo" make
404 |> Jsont.Object.mem "version" Jsont.string ~enc:(fun r -> r.version)
405 |> Jsont.Object.mem "capabilities" (Jsont.list Jsont.string)
406 ~enc:(fun r -> r.capabilities)
407 ~dec_absent:[]
408 |> Jsont.Object.mem "commands" (Jsont.list Jsont.string)
409 ~enc:(fun r -> r.commands)
410 ~dec_absent:[]
411 |> Jsont.Object.mem "outputStyles" (Jsont.list Jsont.string)
412 ~enc:(fun r -> r.output_styles)
413 ~dec_absent:[]
414 |> Jsont.Object.keep_unknown Unknown.mems ~enc:(fun r -> r.unknown)
415 |> Jsont.Object.finish
416end