My agentic slop goes here. Not intended for anyone else!
1open Eio
2
3type log_context = {
4 session_id : string option;
5 request_id : string option;
6 trace_id : string option;
7 span_id : string option;
8 parent_span_id : string option;
9 user_id : string option;
10 tenant_id : string option;
11 fiber_id : string option;
12 domain_id : int option;
13 tags : string list;
14 labels : (string * string) list;
15 custom : (string * Yojson.Safe.t) list;
16}
17
18let empty_context = {
19 session_id = None;
20 request_id = None;
21 trace_id = None;
22 span_id = None;
23 parent_span_id = None;
24 user_id = None;
25 tenant_id = None;
26 fiber_id = None;
27 domain_id = None;
28 tags = [];
29 labels = [];
30 custom = [];
31}
32
33type source_location = {
34 file_path : string option;
35 line_number : int option;
36 column_number : int option;
37 function_name : string option;
38 module_path : string option;
39}
40
41type performance_metrics = {
42 duration_ms : float option;
43 memory_before : int option;
44 memory_after : int option;
45 cpu_time_ms : float option;
46}
47
48type network_context = {
49 client_ip : string option;
50 server_ip : string option;
51 host_name : string option;
52 port : int option;
53 protocol : string option;
54 method_ : string option;
55 path : string option;
56 status_code : int option;
57 bytes_sent : int option;
58 bytes_received : int option;
59}
60
61type error_info = {
62 error_type : string option;
63 error_code : string option;
64 error_hash : string option;
65 stack_trace : string option;
66}
67
68type system_info = {
69 os_name : string;
70 os_version : string;
71 ocaml_version : string;
72 app_version : string option;
73 environment : string option;
74 region : string option;
75 container_id : string option;
76}
77
78type t = {
79 db : Sqlite3.db;
80 mutex : Eio.Mutex.t;
81}
82
83let get_system_info () =
84 {
85 os_name = Sys.os_type;
86 os_version =
87 (try
88 let ic = Unix.open_process_in "uname -r" in
89 let version = input_line ic in
90 close_in ic;
91 version
92 with _ -> "unknown");
93 ocaml_version = Sys.ocaml_version;
94 app_version = None;
95 environment = Sys.getenv_opt "ENVIRONMENT";
96 region = Sys.getenv_opt "REGION";
97 container_id = Sys.getenv_opt "HOSTNAME";
98 }
99
100let init ?(path="dancer_logs.db") () =
101 let db = Sqlite3.db_open path in
102
103 let schema =
104 try
105 let ic = open_in "lib/dancer_logs/schema.sql" in
106 let content = really_input_string ic (in_channel_length ic) in
107 close_in ic;
108 content
109 with _ ->
110 try
111 let ic = open_in "schema.sql" in
112 let content = really_input_string ic (in_channel_length ic) in
113 close_in ic;
114 content
115 with _ ->
116 failwith "Could not find schema.sql"
117 in
118
119 let statements = String.split_on_char ';' schema in
120 List.iter (fun stmt ->
121 let stmt = String.trim stmt in
122 if stmt <> "" then
123 match Sqlite3.exec db stmt with
124 | Sqlite3.Rc.OK -> ()
125 | rc -> Printf.eprintf "SQL error: %s\n%s\n" (Sqlite3.Rc.to_string rc) stmt
126 ) statements;
127
128 { db; mutex = Eio.Mutex.create () }
129
130let close t =
131 let _ = Sqlite3.db_close t.db in
132 ()
133
134let bind_text stmt idx = function
135 | None -> Sqlite3.bind stmt idx Sqlite3.Data.NULL
136 | Some s -> Sqlite3.bind stmt idx (Sqlite3.Data.TEXT s)
137
138let bind_int stmt idx = function
139 | None -> Sqlite3.bind stmt idx Sqlite3.Data.NULL
140 | Some i -> Sqlite3.bind stmt idx (Sqlite3.Data.INT (Int64.of_int i))
141
142let bind_float stmt idx = function
143 | None -> Sqlite3.bind stmt idx Sqlite3.Data.NULL
144 | Some f -> Sqlite3.bind stmt idx (Sqlite3.Data.FLOAT f)
145
146let log t ~level ~source ~message
147 ?(context=empty_context)
148 ?(location={file_path=None; line_number=None; column_number=None;
149 function_name=None; module_path=None})
150 ?(performance={duration_ms=None; memory_before=None; memory_after=None;
151 cpu_time_ms=None})
152 ?(network={client_ip=None; server_ip=None; host_name=None; port=None;
153 protocol=None; method_=None; path=None; status_code=None;
154 bytes_sent=None; bytes_received=None})
155 ?(error={error_type=None; error_code=None; error_hash=None; stack_trace=None})
156 () =
157
158 Eio.Mutex.use_rw ~protect:false t.mutex @@ fun () ->
159
160 let level_int = match level with
161 | Logs.App -> 0
162 | Logs.Error -> 1
163 | Logs.Warning -> 2
164 | Logs.Info -> 3
165 | Logs.Debug -> 4
166 in
167
168 let sql = "
169 INSERT INTO logs (
170 timestamp, level, source, message,
171 error_type, error_code, error_hash, stack_trace,
172 pid, ppid, thread_id, fiber_id, domain_id,
173 session_id, request_id, trace_id, span_id, parent_span_id,
174 file_path, file_name, line_number, column_number, function_name, module_path,
175 duration_ms, memory_before, memory_after, memory_delta, cpu_time_ms,
176 client_ip, server_ip, host_name, port, protocol, method, path,
177 status_code, bytes_sent, bytes_received,
178 user_id, tenant_id,
179 tags, labels, context, custom_fields
180 ) VALUES (
181 ?1, ?2, ?3, ?4,
182 ?5, ?6, ?7, ?8,
183 ?9, ?10, ?11, ?12, ?13,
184 ?14, ?15, ?16, ?17, ?18,
185 ?19, ?20, ?21, ?22, ?23, ?24,
186 ?25, ?26, ?27, ?28, ?29,
187 ?30, ?31, ?32, ?33, ?34, ?35, ?36,
188 ?37, ?38, ?39,
189 ?40, ?41,
190 ?42, ?43, ?44, ?45
191 )
192 " in
193
194 let stmt = Sqlite3.prepare t.db sql in
195
196 let timestamp = Unix.gettimeofday () in
197 let pid = Unix.getpid () in
198 let ppid = Unix.getppid () in
199
200 let memory_delta = match performance.memory_before, performance.memory_after with
201 | Some b, Some a -> Some (a - b)
202 | _ -> None
203 in
204
205 let file_name = match location.file_path with
206 | Some path -> Some (Filename.basename path)
207 | None -> None
208 in
209
210 let tags_json = match context.tags with
211 | [] -> None
212 | tags -> Some (Yojson.Safe.to_string (`List (List.map (fun t -> `String t) tags)))
213 in
214
215 let labels_json = match context.labels with
216 | [] -> None
217 | labels ->
218 let obj = `Assoc (List.map (fun (k, v) -> (k, `String v)) labels) in
219 Some (Yojson.Safe.to_string obj)
220 in
221
222 let custom_json = match context.custom with
223 | [] -> None
224 | custom -> Some (Yojson.Safe.to_string (`Assoc custom))
225 in
226
227 let _ = Sqlite3.bind stmt 1 (Sqlite3.Data.FLOAT timestamp) in
228 let _ = Sqlite3.bind stmt 2 (Sqlite3.Data.INT (Int64.of_int level_int)) in
229 let _ = Sqlite3.bind stmt 3 (Sqlite3.Data.TEXT source) in
230 let _ = Sqlite3.bind stmt 4 (Sqlite3.Data.TEXT message) in
231
232 let _ = bind_text stmt 5 error.error_type in
233 let _ = bind_text stmt 6 error.error_code in
234 let _ = bind_text stmt 7 error.error_hash in
235 let _ = bind_text stmt 8 error.stack_trace in
236
237 let _ = Sqlite3.bind stmt 9 (Sqlite3.Data.INT (Int64.of_int pid)) in
238 let _ = Sqlite3.bind stmt 10 (Sqlite3.Data.INT (Int64.of_int ppid)) in
239 let _ = bind_text stmt 11 None in
240 let _ = bind_text stmt 12 context.fiber_id in
241 let _ = bind_int stmt 13 context.domain_id in
242
243 let _ = bind_text stmt 14 context.session_id in
244 let _ = bind_text stmt 15 context.request_id in
245 let _ = bind_text stmt 16 context.trace_id in
246 let _ = bind_text stmt 17 context.span_id in
247 let _ = bind_text stmt 18 context.parent_span_id in
248
249 let _ = bind_text stmt 19 location.file_path in
250 let _ = bind_text stmt 20 file_name in
251 let _ = bind_int stmt 21 location.line_number in
252 let _ = bind_int stmt 22 location.column_number in
253 let _ = bind_text stmt 23 location.function_name in
254 let _ = bind_text stmt 24 location.module_path in
255
256 let _ = bind_float stmt 25 performance.duration_ms in
257 let _ = bind_int stmt 26 performance.memory_before in
258 let _ = bind_int stmt 27 performance.memory_after in
259 let _ = bind_int stmt 28 memory_delta in
260 let _ = bind_float stmt 29 performance.cpu_time_ms in
261
262 let _ = bind_text stmt 30 network.client_ip in
263 let _ = bind_text stmt 31 network.server_ip in
264 let _ = bind_text stmt 32 network.host_name in
265 let _ = bind_int stmt 33 network.port in
266 let _ = bind_text stmt 34 network.protocol in
267 let _ = bind_text stmt 35 network.method_ in
268 let _ = bind_text stmt 36 network.path in
269 let _ = bind_int stmt 37 network.status_code in
270 let _ = bind_int stmt 38 network.bytes_sent in
271 let _ = bind_int stmt 39 network.bytes_received in
272
273 let _ = bind_text stmt 40 context.user_id in
274 let _ = bind_text stmt 41 context.tenant_id in
275
276 let _ = bind_text stmt 42 tags_json in
277 let _ = bind_text stmt 43 labels_json in
278 let _ = bind_text stmt 44 None in
279 let _ = bind_text stmt 45 custom_json in
280
281 let _ = Sqlite3.step stmt in
282 let _ = Sqlite3.finalize stmt in
283 ()
284
285let reporter t =
286 let report src level ~over k msgf =
287 let source = Logs.Src.name src in
288 msgf @@ fun ?header ?tags fmt ->
289 Format.kasprintf (fun message ->
290 log t ~level ~source ~message ();
291 over ();
292 k ()
293 ) fmt
294 in
295 { Logs.report }
296
297let chain_reporter t next =
298 let report src level ~over k msgf =
299 let source = Logs.Src.name src in
300 msgf @@ fun ?header ?tags fmt ->
301 Format.kasprintf (fun message ->
302 log t ~level ~source ~message ();
303 next.Logs.report src level ~over k (fun f -> f "%s" message)
304 ) fmt
305 in
306 { Logs.report }
307
308module Context = struct
309 let with_session id ctx = { ctx with session_id = Some id }
310 let with_request id ctx = { ctx with request_id = Some id }
311 let with_trace id ctx = { ctx with trace_id = Some id }
312 let with_span id ?parent ctx =
313 { ctx with span_id = Some id; parent_span_id = parent }
314 let with_user id ctx = { ctx with user_id = Some id }
315 let with_tenant id ctx = { ctx with tenant_id = Some id }
316 let with_fiber id ctx = { ctx with fiber_id = Some id }
317 let with_domain id ctx = { ctx with domain_id = Some id }
318 let add_tag tag ctx = { ctx with tags = tag :: ctx.tags }
319 let add_label key value ctx = { ctx with labels = (key, value) :: ctx.labels }
320 let add_custom key json ctx = { ctx with custom = (key, json) :: ctx.custom }
321
322 let of_eio fiber =
323 let fiber_id = Eio.Fiber.id fiber in
324 { empty_context with
325 fiber_id = Some (string_of_int fiber_id);
326 domain_id = Some (Domain.self () |> Domain.get_id :> int)
327 }
328
329 let current_fiber_id () =
330 try
331 Some (string_of_int (Eio.Fiber.id (Eio.Fiber.self ())))
332 with _ -> None
333end
334
335module Pattern = struct
336 type t = {
337 id : int;
338 pattern_hash : string;
339 pattern : string;
340 first_seen : float;
341 last_seen : float;
342 occurrence_count : int;
343 severity_score : float option;
344 }
345
346 let normalize_message msg =
347 let msg = Str.global_replace (Str.regexp "[0-9]+") "N" msg in
348 let msg = Str.global_replace (Str.regexp "0x[0-9a-fA-F]+") "0xHEX" msg in
349 let msg = Str.global_replace (Str.regexp "[a-f0-9]{8}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{12}") "UUID" msg in
350 msg
351
352 let hash_pattern pattern =
353 Digestif.SHA256.digest_string pattern |> Digestif.SHA256.to_hex
354
355 let detect t =
356 ()
357
358 let list t ?(min_count=1) ?(since=0.0) () =
359 []
360
361 let mark_consulted t ~pattern_hash =
362 let sql = "UPDATE patterns SET last_consultation = ?1, consultation_count = consultation_count + 1 WHERE pattern_hash = ?2" in
363 let stmt = Sqlite3.prepare t.db sql in
364 let _ = Sqlite3.bind stmt 1 (Sqlite3.Data.FLOAT (Unix.gettimeofday ())) in
365 let _ = Sqlite3.bind stmt 2 (Sqlite3.Data.TEXT pattern_hash) in
366 let _ = Sqlite3.step stmt in
367 let _ = Sqlite3.finalize stmt in
368 ()
369end
370
371module Query = struct
372 type filter = {
373 level : Logs.level option;
374 source : string option;
375 since : float option;
376 until : float option;
377 session_id : string option;
378 request_id : string option;
379 trace_id : string option;
380 user_id : string option;
381 error_type : string option;
382 min_duration_ms : float option;
383 max_duration_ms : float option;
384 limit : int;
385 }
386
387 let default_filter = {
388 level = None;
389 source = None;
390 since = None;
391 until = None;
392 session_id = None;
393 request_id = None;
394 trace_id = None;
395 user_id = None;
396 error_type = None;
397 min_duration_ms = None;
398 max_duration_ms = None;
399 limit = 100;
400 }
401
402 let list t filter =
403 []
404
405 let search t query ?(limit=100) () =
406 let sql = Printf.sprintf "
407 SELECT logs.* FROM logs
408 JOIN logs_fts ON logs.id = logs_fts.rowid
409 WHERE logs_fts MATCH ?1
410 ORDER BY timestamp DESC
411 LIMIT %d
412 " limit in
413
414 let stmt = Sqlite3.prepare t.db sql in
415 let _ = Sqlite3.bind stmt 1 (Sqlite3.Data.TEXT query) in
416
417 let rec collect acc =
418 match Sqlite3.step stmt with
419 | Sqlite3.Rc.ROW -> collect (Sqlite3.row_data stmt :: acc)
420 | _ -> List.rev acc
421 in
422
423 let results = collect [] in
424 let _ = Sqlite3.finalize stmt in
425 results
426
427 let count_by_level t ?(since=0.0) () =
428 []
429
430 let recent_errors t ?(limit=100) () =
431 let sql = Printf.sprintf "SELECT * FROM recent_errors LIMIT %d" limit in
432 let stmt = Sqlite3.prepare t.db sql in
433
434 let rec collect acc =
435 match Sqlite3.step stmt with
436 | Sqlite3.Rc.ROW -> collect (Sqlite3.row_data stmt :: acc)
437 | _ -> List.rev acc
438 in
439
440 let results = collect [] in
441 let _ = Sqlite3.finalize stmt in
442 results
443
444 let slow_operations t ?(threshold_ms=100.0) () =
445 []
446
447 let error_trends t ?(days=7) () =
448 []
449
450 let session_summary t ~session_id =
451 []
452end
453
454module Metrics = struct
455 type system_snapshot = {
456 timestamp : float;
457 cpu_usage_percent : float option;
458 memory_used_bytes : int option;
459 memory_available_bytes : int option;
460 disk_usage_percent : float option;
461 network_rx_bytes_per_sec : float option;
462 network_tx_bytes_per_sec : float option;
463 gc_minor_collections : int option;
464 gc_major_collections : int option;
465 gc_heap_words : int option;
466 }
467
468 let snapshot () =
469 let gc_stat = Gc.stat () in
470 {
471 timestamp = Unix.gettimeofday ();
472 cpu_usage_percent = None;
473 memory_used_bytes = Some (gc_stat.Gc.heap_words * (Sys.word_size / 8));
474 memory_available_bytes = None;
475 disk_usage_percent = None;
476 network_rx_bytes_per_sec = None;
477 network_tx_bytes_per_sec = None;
478 gc_minor_collections = Some gc_stat.Gc.minor_collections;
479 gc_major_collections = Some gc_stat.Gc.major_collections;
480 gc_heap_words = Some gc_stat.Gc.heap_words;
481 }
482
483 let record t snapshot =
484 ()
485
486 let get_range t ~since ~until =
487 []
488end
489
490module Export = struct
491 let to_json rows =
492 `List (List.map (fun row ->
493 `List (List.map (function
494 | Sqlite3.Data.NULL -> `Null
495 | Sqlite3.Data.INT i -> `Int (Int64.to_int i)
496 | Sqlite3.Data.FLOAT f -> `Float f
497 | Sqlite3.Data.TEXT s -> `String s
498 | Sqlite3.Data.BLOB b -> `String (Bytes.to_string b)
499 ) row)
500 ) rows)
501
502 let to_csv rows =
503 ""
504
505 let for_claude t ?(limit=1000) ?(context_size=50000) () =
506 let sql = Printf.sprintf "
507 SELECT timestamp, level, source, message, error_type, stack_trace
508 FROM logs
509 WHERE level <= 2
510 ORDER BY timestamp DESC
511 LIMIT %d
512 " limit in
513
514 let stmt = Sqlite3.prepare t.db sql in
515
516 let rec collect acc size =
517 if size > context_size then acc
518 else match Sqlite3.step stmt with
519 | Sqlite3.Rc.ROW ->
520 let row = Sqlite3.row_data stmt in
521 let text = String.concat " | " (List.map (function
522 | Sqlite3.Data.NULL -> "NULL"
523 | Sqlite3.Data.INT i -> Int64.to_string i
524 | Sqlite3.Data.FLOAT f -> string_of_float f
525 | Sqlite3.Data.TEXT s -> s
526 | Sqlite3.Data.BLOB b -> Bytes.to_string b
527 ) row) in
528 collect (text :: acc) (size + String.length text)
529 | _ -> acc
530 in
531
532 let lines = collect [] 0 in
533 let _ = Sqlite3.finalize stmt in
534 String.concat "\n" (List.rev lines)
535end
536
537let vacuum t =
538 let _ = Sqlite3.exec t.db "VACUUM" in
539 ()
540
541let stats t =
542 []
543
544let prune t ~older_than ?(dry_run=false) () =
545 0