gazagnaire.org
Generic TTL cache with Eio
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3 SPDX-License-Identifier: MIT
4 ---------------------------------------------------------------------------*)
5
6let log_src = Logs.Src.create "cache"
7
8module Log = (val Logs.src_log log_src : Logs.LOG)
9
10module type KEY = sig
11 type t
12
13 val equal : t -> t -> bool
14 val hash : t -> int
15end
16
17module type S = sig
18 type key
19 type 'a t
20
21 val create :
22 clock:_ Eio.Time.clock -> ?base_ttl:float -> ?jitter:float -> unit -> 'a t
23
24 val get : 'a t -> key -> 'a option
25 val set : 'a t -> key -> 'a -> unit
26 val remove : 'a t -> key -> unit
27 val get_or_compute : 'a t -> key -> (unit -> 'a) -> 'a
28 val gc : 'a t -> unit
29 val clear : 'a t -> unit
30 val stats : 'a t -> int * int
31end
32
33module Make (K : KEY) : S with type key = K.t = struct
34 type key = K.t
35
36 module H = Hashtbl.Make (K)
37
38 type 'a entry = { value : 'a; expires_at : float }
39
40 type 'a t = {
41 entries : 'a entry H.t;
42 mutex : Eio.Mutex.t;
43 base_ttl : float;
44 jitter : float;
45 now : unit -> float;
46 }
47
48 let create ~clock ?(base_ttl = 60.0) ?(jitter = 0.2) () =
49 {
50 entries = H.create 256;
51 mutex = Eio.Mutex.create ();
52 base_ttl;
53 jitter;
54 now = (fun () -> Eio.Time.now clock);
55 }
56
57 let now t = t.now ()
58
59 let ttl_with_jitter t =
60 let jitter_range = t.base_ttl *. t.jitter in
61 let random_jitter = Random.float jitter_range -. (jitter_range /. 2.0) in
62 t.base_ttl +. random_jitter
63
64 let get t key =
65 Eio.Mutex.use_ro t.mutex @@ fun () ->
66 match H.find_opt t.entries key with
67 | None -> None
68 | Some entry ->
69 if now t < entry.expires_at then Some entry.value
70 else begin
71 H.remove t.entries key;
72 None
73 end
74
75 let set t key value =
76 Eio.Mutex.use_rw ~protect:true t.mutex @@ fun () ->
77 let entry = { value; expires_at = now t +. ttl_with_jitter t } in
78 H.replace t.entries key entry
79
80 let remove t key =
81 Eio.Mutex.use_rw ~protect:true t.mutex @@ fun () -> H.remove t.entries key
82
83 let get_or_compute t key compute =
84 match get t key with
85 | Some v -> v
86 | None ->
87 let v = compute () in
88 set t key v;
89 v
90
91 let gc t =
92 Eio.Mutex.use_rw ~protect:true t.mutex @@ fun () ->
93 let current = now t in
94 let to_remove =
95 H.fold
96 (fun k entry acc ->
97 if current >= entry.expires_at then k :: acc else acc)
98 t.entries []
99 in
100 List.iter (H.remove t.entries) to_remove;
101 Log.debug (fun m ->
102 m "Cache GC: removed %d expired entries" (List.length to_remove))
103
104 let clear t =
105 Eio.Mutex.use_rw ~protect:true t.mutex @@ fun () -> H.clear t.entries
106
107 let stats t =
108 Eio.Mutex.use_ro t.mutex @@ fun () ->
109 let total = H.length t.entries in
110 let current = now t in
111 let valid =
112 H.fold
113 (fun _ entry acc -> if current < entry.expires_at then acc + 1 else acc)
114 t.entries 0
115 in
116 (total, valid)
117end
118
119module String = Make (struct
120 type t = string
121
122 let equal = String.equal
123 let hash = Hashtbl.hash
124end)