My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1open Ezjsonm
2
3let src = Logs.Src.create "claude.hooks" ~doc:"Claude hooks system"
4module Log = (val Logs.src_log src : Logs.LOG)
5
6(** Hook events that can be intercepted *)
7type event =
8 | Pre_tool_use
9 | Post_tool_use
10 | User_prompt_submit
11 | Stop
12 | Subagent_stop
13 | Pre_compact
14
15let event_to_string = function
16 | Pre_tool_use -> "PreToolUse"
17 | Post_tool_use -> "PostToolUse"
18 | User_prompt_submit -> "UserPromptSubmit"
19 | Stop -> "Stop"
20 | Subagent_stop -> "SubagentStop"
21 | Pre_compact -> "PreCompact"
22
23let event_of_string = function
24 | "PreToolUse" -> Pre_tool_use
25 | "PostToolUse" -> Post_tool_use
26 | "UserPromptSubmit" -> User_prompt_submit
27 | "Stop" -> Stop
28 | "SubagentStop" -> Subagent_stop
29 | "PreCompact" -> Pre_compact
30 | s -> raise (Invalid_argument (Printf.sprintf "Unknown hook event: %s" s))
31
32(** Context provided to hook callbacks *)
33module Context = struct
34 type t = {
35 signal: unit option; (* Future: abort signal support *)
36 }
37
38 let create ?(signal = None) () = { signal }
39end
40
41(** Hook decision control *)
42type decision =
43 | Continue
44 | Block
45
46(** Generic hook result *)
47type result = {
48 decision: decision option;
49 system_message: string option;
50 hook_specific_output: value option;
51}
52
53(** {1 PreToolUse Hook} *)
54module PreToolUse = struct
55 type t = {
56 session_id: string;
57 transcript_path: string;
58 tool_name: string;
59 tool_input: value;
60 }
61
62 type permission_decision = Allow | Deny | Ask
63
64 type output = {
65 permission_decision: permission_decision option;
66 permission_decision_reason: string option;
67 }
68
69 let of_json json =
70 {
71 session_id = get_string (find json ["session_id"]);
72 transcript_path = get_string (find json ["transcript_path"]);
73 tool_name = get_string (find json ["tool_name"]);
74 tool_input = find json ["tool_input"];
75 }
76
77 let session_id t = t.session_id
78 let transcript_path t = t.transcript_path
79 let tool_name t = t.tool_name
80 let tool_input t = t.tool_input
81 let raw_json t =
82 dict [
83 "session_id", string t.session_id;
84 "transcript_path", string t.transcript_path;
85 "hook_event_name", string "PreToolUse";
86 "tool_name", string t.tool_name;
87 "tool_input", t.tool_input;
88 ]
89
90 let permission_decision_to_string = function
91 | Allow -> "allow"
92 | Deny -> "deny"
93 | Ask -> "ask"
94
95 let output_to_json output =
96 let fields = [("hookEventName", string "PreToolUse")] in
97 let fields = match output.permission_decision with
98 | Some pd -> ("permissionDecision", string (permission_decision_to_string pd)) :: fields
99 | None -> fields
100 in
101 let fields = match output.permission_decision_reason with
102 | Some reason -> ("permissionDecisionReason", string reason) :: fields
103 | None -> fields
104 in
105 dict fields
106
107 let allow ?reason () =
108 { permission_decision = Some Allow; permission_decision_reason = reason }
109
110 let deny ?reason () =
111 { permission_decision = Some Deny; permission_decision_reason = reason }
112
113 let ask ?reason () =
114 { permission_decision = Some Ask; permission_decision_reason = reason }
115
116 let continue () =
117 { permission_decision = None; permission_decision_reason = None }
118end
119
120(** {1 PostToolUse Hook} *)
121module PostToolUse = struct
122 type t = {
123 session_id: string;
124 transcript_path: string;
125 tool_name: string;
126 tool_input: value;
127 tool_response: value;
128 }
129
130 type output = {
131 decision: decision option;
132 reason: string option;
133 additional_context: string option;
134 }
135
136 let of_json json =
137 {
138 session_id = get_string (find json ["session_id"]);
139 transcript_path = get_string (find json ["transcript_path"]);
140 tool_name = get_string (find json ["tool_name"]);
141 tool_input = find json ["tool_input"];
142 tool_response = find json ["tool_response"];
143 }
144
145 let session_id t = t.session_id
146 let transcript_path t = t.transcript_path
147 let tool_name t = t.tool_name
148 let tool_input t = t.tool_input
149 let tool_response t = t.tool_response
150 let raw_json t =
151 dict [
152 "session_id", string t.session_id;
153 "transcript_path", string t.transcript_path;
154 "hook_event_name", string "PostToolUse";
155 "tool_name", string t.tool_name;
156 "tool_input", t.tool_input;
157 "tool_response", t.tool_response;
158 ]
159
160 let output_to_json output =
161 let fields = [("hookEventName", string "PostToolUse")] in
162 let fields = match output.decision with
163 | Some Block -> ("decision", string "block") :: fields
164 | Some Continue | None -> fields
165 in
166 let fields = match output.reason with
167 | Some r -> ("reason", string r) :: fields
168 | None -> fields
169 in
170 let fields = match output.additional_context with
171 | Some ctx -> ("additionalContext", string ctx) :: fields
172 | None -> fields
173 in
174 dict fields
175
176 let continue ?additional_context () =
177 { decision = None; reason = None; additional_context }
178
179 let block ?reason ?additional_context () =
180 { decision = Some Block; reason; additional_context }
181end
182
183(** {1 UserPromptSubmit Hook} *)
184module UserPromptSubmit = struct
185 type t = {
186 session_id: string;
187 transcript_path: string;
188 prompt: string;
189 }
190
191 type output = {
192 decision: decision option;
193 reason: string option;
194 additional_context: string option;
195 }
196
197 let of_json json =
198 {
199 session_id = get_string (find json ["session_id"]);
200 transcript_path = get_string (find json ["transcript_path"]);
201 prompt = get_string (find json ["prompt"]);
202 }
203
204 let session_id t = t.session_id
205 let transcript_path t = t.transcript_path
206 let prompt t = t.prompt
207 let raw_json t =
208 dict [
209 "session_id", string t.session_id;
210 "transcript_path", string t.transcript_path;
211 "hook_event_name", string "UserPromptSubmit";
212 "prompt", string t.prompt;
213 ]
214
215 let output_to_json output =
216 let fields = [("hookEventName", string "UserPromptSubmit")] in
217 let fields = match output.decision with
218 | Some Block -> ("decision", string "block") :: fields
219 | Some Continue | None -> fields
220 in
221 let fields = match output.reason with
222 | Some r -> ("reason", string r) :: fields
223 | None -> fields
224 in
225 let fields = match output.additional_context with
226 | Some ctx -> ("additionalContext", string ctx) :: fields
227 | None -> fields
228 in
229 dict fields
230
231 let continue ?additional_context () =
232 { decision = None; reason = None; additional_context }
233
234 let block ?reason () =
235 { decision = Some Block; reason; additional_context = None }
236end
237
238(** {1 Stop Hook} *)
239module Stop = struct
240 type t = {
241 session_id: string;
242 transcript_path: string;
243 stop_hook_active: bool;
244 }
245
246 type output = {
247 decision: decision option;
248 reason: string option;
249 }
250
251 let of_json json =
252 {
253 session_id = get_string (find json ["session_id"]);
254 transcript_path = get_string (find json ["transcript_path"]);
255 stop_hook_active = get_bool (find json ["stop_hook_active"]);
256 }
257
258 let session_id t = t.session_id
259 let transcript_path t = t.transcript_path
260 let stop_hook_active t = t.stop_hook_active
261 let raw_json t =
262 dict [
263 "session_id", string t.session_id;
264 "transcript_path", string t.transcript_path;
265 "hook_event_name", string "Stop";
266 "stop_hook_active", bool t.stop_hook_active;
267 ]
268
269 let output_to_json output =
270 let fields = [] in
271 let fields = match output.decision with
272 | Some Block -> ("decision", string "block") :: fields
273 | Some Continue | None -> fields
274 in
275 let fields = match output.reason with
276 | Some r -> ("reason", string r) :: fields
277 | None -> fields
278 in
279 dict fields
280
281 let continue () = { decision = None; reason = None }
282 let block ?reason () = { decision = Some Block; reason }
283end
284
285(** {1 SubagentStop Hook} - Same structure as Stop *)
286module SubagentStop = struct
287 include Stop
288
289 let of_json json =
290 {
291 session_id = get_string (find json ["session_id"]);
292 transcript_path = get_string (find json ["transcript_path"]);
293 stop_hook_active = get_bool (find json ["stop_hook_active"]);
294 }
295
296 let raw_json t =
297 dict [
298 "session_id", string t.session_id;
299 "transcript_path", string t.transcript_path;
300 "hook_event_name", string "SubagentStop";
301 "stop_hook_active", bool t.stop_hook_active;
302 ]
303end
304
305(** {1 PreCompact Hook} *)
306module PreCompact = struct
307 type t = {
308 session_id: string;
309 transcript_path: string;
310 }
311
312 type output = unit (* No specific output for PreCompact *)
313
314 let of_json json =
315 {
316 session_id = get_string (find json ["session_id"]);
317 transcript_path = get_string (find json ["transcript_path"]);
318 }
319
320 let session_id t = t.session_id
321 let transcript_path t = t.transcript_path
322 let raw_json t =
323 dict [
324 "session_id", string t.session_id;
325 "transcript_path", string t.transcript_path;
326 "hook_event_name", string "PreCompact";
327 ]
328
329 let output_to_json () = dict []
330
331 let continue () = ()
332end
333
334(** {1 Generic Callback Type} *)
335type callback =
336 input:value ->
337 tool_use_id:string option ->
338 context:Context.t ->
339 result
340
341(** {1 Matcher Configuration} *)
342type matcher = {
343 matcher: string option;
344 callbacks: callback list;
345}
346
347type config = (event * matcher list) list
348
349(** {1 Result Builders} *)
350let continue ?system_message ?hook_specific_output () =
351 { decision = None; system_message; hook_specific_output }
352
353let block ?system_message ?hook_specific_output () =
354 { decision = Some Block; system_message; hook_specific_output }
355
356(** {1 Matcher Builders} *)
357let matcher ?pattern callbacks = { matcher = pattern; callbacks }
358
359(** {1 Config Builders} *)
360let empty = []
361
362let add event matchers config =
363 (event, matchers) :: config
364
365(** {1 JSON Conversion} *)
366let result_to_json result =
367 let fields = [] in
368 let fields = match result.decision with
369 | Some Block -> ("decision", string "block") :: fields
370 | Some Continue | None -> fields
371 in
372 let fields = match result.system_message with
373 | Some msg -> ("systemMessage", string msg) :: fields
374 | None -> fields
375 in
376 let fields = match result.hook_specific_output with
377 | Some output -> ("hookSpecificOutput", output) :: fields
378 | None -> fields
379 in
380 dict fields
381
382let config_to_protocol_format config =
383 let hooks_dict = List.map (fun (event, matchers) ->
384 let event_name = event_to_string event in
385 let matchers_json = List.map (fun m ->
386 (* matcher and hookCallbackIds will be filled in by client *)
387 dict [
388 "matcher", (match m.matcher with Some p -> string p | None -> `Null);
389 "callbacks", `A []; (* Placeholder, filled by client *)
390 ]
391 ) matchers in
392 (event_name, `A matchers_json)
393 ) config in
394 dict hooks_dict