diff --git a/src/lib/interval_limiter.mli b/src/lib/interval_limiter.mli index b07f7c68..8b63a169 100644 --- a/src/lib/interval_limiter.mli +++ b/src/lib/interval_limiter.mli @@ -1,3 +1,6 @@ +(** Interval limiter. This is a form of rate limiting where an event cannot be + followed by another event until a given interval of time has passed. *) + type t val create : min_interval:Mtime.span -> unit -> t diff --git a/src/lib/metrics_callbacks.ml b/src/lib/metrics_callbacks.ml index 81aa2055..4aae9bf5 100644 --- a/src/lib/metrics_callbacks.ml +++ b/src/lib/metrics_callbacks.ml @@ -6,31 +6,47 @@ let create () : t = { cbs = Alist.make () } let[@inline] add_metrics_cb (self : t) f = Alist.add self.cbs f -let add_to_exporter (exp : Exporter.t) (self : t) = - let on_tick () = - (* collect all metrics *) - let res = ref [] in - List.iter - (fun f -> - let f_metrics = f () in - res := List.rev_append f_metrics !res) - (Alist.get self.cbs); - let metrics = !res in +let minimum_min_interval = Mtime.Span.(100 * ms) - (* emit the metrics *) - Exporter.send_metrics exp metrics +let collect_and_send (self : t) (exp : Exporter.t) = + (* collect all metrics *) + let res = ref [] in + List.iter + (fun f -> + let f_metrics = f () in + res := List.rev_append f_metrics !res) + (Alist.get self.cbs); + let metrics = !res in + + (* emit the metrics *) + Exporter.send_metrics exp metrics + +let add_to_exporter ?(min_interval = Mtime.Span.(4 * s)) (exp : Exporter.t) + (self : t) = + let min_interval = + Mtime.Span.( + if is_shorter min_interval ~than:minimum_min_interval then + minimum_min_interval + else + min_interval) + in + + let limiter = Interval_limiter.create ~min_interval () in + let on_tick () = + if Interval_limiter.make_attempt limiter then collect_and_send self exp in Exporter.on_tick exp on_tick -let with_set_added_to_exporter (exp : Exporter.t) (f : t -> 'a) : 'a = +let with_set_added_to_exporter ?min_interval (exp : Exporter.t) (f : t -> 'a) : + 'a = let set = create () in - add_to_exporter exp set; + add_to_exporter ?min_interval exp set; f set -let with_set_added_to_main_exporter (f : t -> unit) : unit = +let with_set_added_to_main_exporter ?min_interval (f : t -> unit) : unit = match Main_exporter.get () with | None -> () - | Some exp -> with_set_added_to_exporter exp f + | Some exp -> with_set_added_to_exporter ?min_interval exp f module Main_set = struct let cur_set_ : t option Atomic.t = Atomic.make None diff --git a/src/lib/metrics_callbacks.mli b/src/lib/metrics_callbacks.mli index d66388ad..5a85cd44 100644 --- a/src/lib/metrics_callbacks.mli +++ b/src/lib/metrics_callbacks.mli @@ -16,14 +16,20 @@ val add_metrics_cb : t -> (unit -> Metrics.t list) -> unit metrics. It might be called regularly by the backend, in particular (but not only) when {!Exporter.tick} is called. *) -val add_to_exporter : Exporter.t -> t -> unit -(** Make sure we export metrics at every [tick] of the exporter *) +val add_to_exporter : ?min_interval:Mtime.span -> Exporter.t -> t -> unit +(** Make sure we try to export metrics at every [tick] of the exporter. + @param min_interval + the minimum duration between two consecutive exports, using + {!Interval_limiter}. We don't want a too frequent [tick] to spam metrics. + Default [4s], minimum [0.1s]. *) -val with_set_added_to_exporter : Exporter.t -> (t -> 'a) -> 'a +val with_set_added_to_exporter : + ?min_interval:Mtime.span -> Exporter.t -> (t -> 'a) -> 'a (** [with_set_added_to_exporter exp f] creates a set, adds it to the exporter, and calls [f] on it *) -val with_set_added_to_main_exporter : (t -> unit) -> unit +val with_set_added_to_main_exporter : + ?min_interval:Mtime.span -> (t -> unit) -> unit (** If there is a main exporter, add a set to it and call [f set], else do not call [f] at all *)