From 012f8be68e50891114ef64c110998bc4a72139e0 Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Wed, 5 Aug 2026 20:30:55 +0000 Subject: [PATCH] Add prometheus-lwt as a forward-compatible Lwt interface Introduce the `prometheus-lwt` package with the API that the core will keep once its Lwt dependency is removed (#60 #65), but implemented for now via Lwt support still present in `prometheus`. Therefore nothing breaks in this release as existing users can migrate to `Prometheus_lwt` and also to the new synchronous functions at their own pace. The actual interface break will then happen in a later release without further source changes for migrated Lwt users. Also add synchronous variants of the timing helpers to the core since the existing Lwt-typed functions occupy the unsuffixed names until the break. Suggested by @talex5 in #65. Co-authored-by: Mark Elvers Co-authored-by: Thomas Leonard --- CHANGES.md | 17 +++++++++++ README.md | 11 +++++++ lwt/dune | 4 +++ lwt/prometheus_lwt.ml | 34 ++++++++++++++++++++++ lwt/prometheus_lwt.mli | 49 +++++++++++++++++++++++++++++++ lwt/test/dune | 4 +++ lwt/test/test_lwt.ml | 66 ++++++++++++++++++++++++++++++++++++++++++ prometheus-lwt.opam | 24 +++++++++++++++ src/prometheus.ml | 31 +++++++++++++++++++- src/prometheus.mli | 31 ++++++++++++++++++-- tests/test.ml | 36 ++++++++++++++++++----- 11 files changed, 295 insertions(+), 12 deletions(-) create mode 100644 lwt/dune create mode 100644 lwt/prometheus_lwt.ml create mode 100644 lwt/prometheus_lwt.mli create mode 100644 lwt/test/dune create mode 100644 lwt/test/test_lwt.ml create mode 100644 prometheus-lwt.opam diff --git a/CHANGES.md b/CHANGES.md index fd9d398..5a671a2 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,20 @@ +## dev + +- Add a new `prometheus-lwt` metrics package (@avsm @mtelvers @talex5 #66 #60 #65) + + This release is not a breaking change, but instead prepares for + deprecation of Lwt in the core package so a future release can remove Lwt + from the `prometheus` core. Users of the core's Lwt-typed functions + should migrate to `Prometheus_lwt` now. Code using the new interface will + keep working unchanged in future releases. + +- Add synchronous variants of the timing helpers to the core. Metric recording + is synchronous and these will become the only core timing helpers once the + Lwt-typed ones move to `prometheus-lwt`. + +To migrate existing code, add a dep on `prometheus-lwt` and rename following +the deprecation warnings from the compiler. + ## v1.3 (2025-12-08) - Make help / type information be OpenMetrics compatible (@Nymphium @tmcgilchrist #47). diff --git a/README.md b/README.md index 7d1a516..18c4c10 100644 --- a/README.md +++ b/README.md @@ -67,6 +67,17 @@ Tick! Unikernels can use `Prometheus_app` instead of `Prometheus_unix` to avoid the `Unix` dependency. +### Lwt collectors + +The `prometheus-lwt` opam package provides `Prometheus_lwt` with collectors +that may suspend before producing their samples, and also Lwt versions of the +timing helpers. + +A future release will remove Lwt from the `prometheus` core. Existing code +using the core's Lwt-typed functions should migrate to `Prometheus_lwt`, or to +the synchronous variants such as `Gauge.set_time` now. Code will then keep +working unchanged when the core switch happens. + ### API docs Generated API documentation is available at . diff --git a/lwt/dune b/lwt/dune new file mode 100644 index 0000000..838598b --- /dev/null +++ b/lwt/dune @@ -0,0 +1,4 @@ +(library + (name prometheus_lwt) + (public_name prometheus-lwt) + (libraries prometheus lwt)) diff --git a/lwt/prometheus_lwt.ml b/lwt/prometheus_lwt.ml new file mode 100644 index 0000000..d0cd169 --- /dev/null +++ b/lwt/prometheus_lwt.ml @@ -0,0 +1,34 @@ +[@@@alert "-deprecated"] + +(* This transition module reexports the core operations under their + new names to allow the core package to drop the Lwt dependency + in a future release. This interface will not change. *) +module CollectorRegistry = struct + type t = Prometheus.CollectorRegistry.t + + let of_registry core = core + + let default = Prometheus.CollectorRegistry.default + + let core t = t + + let collect = Prometheus.CollectorRegistry.collect + + let register = Prometheus.CollectorRegistry.register_lwt + + let register_pre_collect = Prometheus.CollectorRegistry.register_pre_collect_lwt +end + +module Gauge = struct + let track_in_progress = Prometheus.Gauge.track_inprogress + + let set_time = Prometheus.Gauge.time +end + +module Summary = struct + let observe_time = Prometheus.Summary.time +end + +module Histogram (H : Prometheus.HISTOGRAM) = struct + let observe_time = H.time +end diff --git a/lwt/prometheus_lwt.mli b/lwt/prometheus_lwt.mli new file mode 100644 index 0000000..355c981 --- /dev/null +++ b/lwt/prometheus_lwt.mli @@ -0,0 +1,49 @@ +(** Lwt support for Prometheus. + + Provide collectors that may suspend before producing their metrics. *) + +module CollectorRegistry : sig + type t + + val of_registry : Prometheus.CollectorRegistry.t -> t + (** [of_registry core] is the Lwt view over the existing registry [core]. *) + + val default : t + (** [default] is the view over {!Prometheus.CollectorRegistry.default}. *) + + val core : t -> Prometheus.CollectorRegistry.t + (** [core t] is the underlying core registry. Use it to register + synchronous metrics. *) + + val collect : t -> Prometheus.CollectorRegistry.snapshot Lwt.t + (** [collect t] reads the current value of every metric. *) + + val register : + t -> Prometheus.MetricInfo.t -> + (unit -> Prometheus.Sample_set.t Prometheus.LabelSetMap.t Lwt.t) -> unit + (** [register t info collector] registers a collector that may suspend + before producing its samples. *) + + val register_pre_collect : t -> (unit -> unit Lwt.t) -> unit + (** [register_pre_collect t f] arranges for [f ()] to run at the start + of each collection. *) +end + +module Gauge : sig + val track_in_progress : Prometheus.Gauge.t -> (unit -> 'a Lwt.t) -> 'a Lwt.t + (** [track_in_progress t f] increases [t] by one while [f ()] is running. *) + + val set_time : Prometheus.Gauge.t -> (unit -> float) -> (unit -> 'a Lwt.t) -> 'a Lwt.t + (** [set_time t gettime f] calls [gettime ()] before and after executing [f ()] and + sets [t] to the difference. *) +end + +module Summary : sig + val observe_time : Prometheus.Summary.t -> (unit -> float) -> (unit -> 'a Lwt.t) -> 'a Lwt.t + (** [observe_time t gettime f] observes the duration of [f ()]. *) +end + +module Histogram (H : Prometheus.HISTOGRAM) : sig + val observe_time : H.t -> (unit -> float) -> (unit -> 'a Lwt.t) -> 'a Lwt.t + (** [observe_time t gettime f] observes the duration of [f ()]. *) +end diff --git a/lwt/test/dune b/lwt/test/dune new file mode 100644 index 0000000..a15a2c3 --- /dev/null +++ b/lwt/test/dune @@ -0,0 +1,4 @@ +(test + (name test_lwt) + (package prometheus-lwt) + (libraries prometheus prometheus-app prometheus-lwt alcotest alcotest-lwt lwt fmt)) diff --git a/lwt/test/test_lwt.ml b/lwt/test/test_lwt.ml new file mode 100644 index 0000000..328937f --- /dev/null +++ b/lwt/test/test_lwt.ml @@ -0,0 +1,66 @@ +open Prometheus +open Prometheus_app + +open Lwt.Infix + +let test_lwt_collectors () = + let registry = Prometheus_lwt.CollectorRegistry.of_registry (CollectorRegistry.create ()) in + let sync_counter = + Counter.v ~registry:(Prometheus_lwt.CollectorRegistry.core registry) + ~help:"A synchronous counter" "counter_0" + in + Counter.inc_one sync_counter; + let register_counter ~name ~help value = + let metric_info = { + MetricInfo.name = MetricName.v name; + metric_type = Counter; + help; + label_names = [] + } + in + let collector () = + Lwt.pause () >|= fun () -> + LabelSetMap.singleton [] [Prometheus.Sample_set.sample value] + in + Prometheus_lwt.CollectorRegistry.register registry metric_info collector + in + register_counter ~name:"counter_1" ~help:"The first counter" 1.0; + register_counter ~name:"counter_2" ~help:"The second counter" 2.0; + Prometheus_lwt.CollectorRegistry.collect registry >|= fun collected -> + let output = Fmt.to_to_string TextFormat_0_0_4.output collected in + Alcotest.(check string) "Text output" + "# HELP counter_0 A synchronous counter\n\ + # TYPE counter_0 counter\n\ + counter_0 1\n\ + # HELP counter_1 The first counter\n\ + # TYPE counter_1 counter\n\ + counter_1 1\n\ + # HELP counter_2 The second counter\n\ + # TYPE counter_2 counter\n\ + counter_2 2\n" + output + +let test_timers () = + let registry = Prometheus_lwt.CollectorRegistry.of_registry (CollectorRegistry.create ()) in + let core = Prometheus_lwt.CollectorRegistry.core registry in + let gauge = Gauge.v ~registry:core ~help:"Time taken" "gauge_time" in + let clock = ref 0.0 in + let gettime () = !clock in + Prometheus_lwt.Gauge.set_time gauge gettime + (fun () -> clock := !clock +. 1.5; Lwt.pause ()) + >>= fun () -> + Prometheus_lwt.CollectorRegistry.collect registry >|= fun collected -> + let output = Fmt.to_to_string TextFormat_0_0_4.output collected in + Alcotest.(check string) "Text output" + "# HELP gauge_time Time taken\n\ + # TYPE gauge_time gauge\n\ + gauge_time 1.5\n" + output + +let () = + Lwt_main.run @@ Alcotest_lwt.run "prometheus-lwt" [ + "main", [ + "Lwt collectors", `Quick, test_lwt_collectors; + "Lwt timers", `Quick, test_timers; + ]; + ] diff --git a/prometheus-lwt.opam b/prometheus-lwt.opam new file mode 100644 index 0000000..4b40ac6 --- /dev/null +++ b/prometheus-lwt.opam @@ -0,0 +1,24 @@ +opam-version: "2.0" +synopsis: "Lwt support for Prometheus monitoring" +description: "Lwt collectors and timing helpers for Prometheus metrics." +maintainer: "talex5@gmail.com" +authors: ["Thomas Leonard" "Anil Madhavapeddy" "David Scott"] +license: "Apache-2.0" +homepage: "https://github.com/mirage/prometheus" +doc: "https://mirage.github.io/prometheus/" +bug-reports: "https://github.com/mirage/prometheus/issues" +depends: [ + "ocaml" {>= "4.11.0"} + "dune" {>= "2.3"} + "prometheus" {= version} + "lwt" {>= "2.5.0"} + "prometheus-app" {= version & with-test} + "fmt" {>= "0.8.7" & with-test} + "alcotest" {with-test} + "alcotest-lwt" {with-test} +] +build: [ + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +dev-repo: "git+https://github.com/mirage/prometheus.git" diff --git a/src/prometheus.ml b/src/prometheus.ml index 45da7fc..4b28582 100644 --- a/src/prometheus.ml +++ b/src/prometheus.ml @@ -253,6 +253,10 @@ module Gauge = struct inc_one t; Lwt.finalize fn (fun () -> dec_one t; Lwt.return_unit) + let track_in_progress t fn = + inc_one t; + Fun.protect fn ~finally:(fun () -> dec_one t) + let time t gettimeofday fn = let start = gettimeofday () in Lwt.finalize fn @@ -261,6 +265,14 @@ module Gauge = struct inc t (finish -. start); Lwt.return_unit ) + + let set_time t gettimeofday fn = + let start = gettimeofday () in + Fun.protect fn + ~finally:(fun () -> + let finish = gettimeofday () in + set t (finish -. start) + ) end module Summary = struct @@ -296,6 +308,14 @@ module Summary = struct observe t (finish -. start); Lwt.return_unit ) + + let observe_time t gettimeofday fn = + let start = gettimeofday () in + Fun.protect fn + ~finally:(fun () -> + let finish = gettimeofday () in + observe t (finish -. start) + ) end module Histogram_spec = struct @@ -344,7 +364,8 @@ end module type HISTOGRAM = sig include METRIC val observe : t -> float -> unit - val time : t -> (unit -> float) -> (unit -> 'a Lwt.t) -> 'a Lwt.t + val time : t -> (unit -> float) -> (unit -> 'a Lwt.t) -> 'a Lwt.t [@@deprecated] + val observe_time : t -> (unit -> float) -> (unit -> 'a) -> 'a end let bucket_label = LabelName.v "le" @@ -400,6 +421,14 @@ module Histogram (Buckets : BUCKETS) = struct observe t (finish -. start); Lwt.return_unit ) + + let observe_time t gettimeofday fn = + let start = gettimeofday () in + Fun.protect fn + ~finally:(fun () -> + let finish = gettimeofday () in + observe t (finish -. start) + ) end module DefaultHistogram = Histogram ( diff --git a/src/prometheus.mli b/src/prometheus.mli index 1efd0b7..14e1aa1 100644 --- a/src/prometheus.mli +++ b/src/prometheus.mli @@ -9,6 +9,10 @@ - This library is intended to be a dependency of any library that might need to report metrics, even though many applications will not enable it. Therefore it should have minimal dependencies. + + - The Lwt-typed functions here are superseded by the [prometheus-lwt] + package. A future release will remove Lwt from this library. New code + should use [Prometheus_lwt] or the synchronous variants. *) type metric_type = @@ -96,6 +100,7 @@ module CollectorRegistry : sig It will call [collector ()] to collect the values each time [collect] is called. *) val register_lwt : t -> MetricInfo.t -> (unit -> Sample_set.t LabelSetMap.t Lwt.t) -> unit + [@@deprecated "Use Prometheus_lwt.CollectorRegistry.register instead."] (** [register_lwt t metric collector] is the same as [register t metrics collector] but [collector] returns [Sample_set.t LabelSetMap.t Lwt.t]. *) @@ -105,7 +110,8 @@ module CollectorRegistry : sig information about multiple metrics. *) val register_pre_collect_lwt : t -> (unit -> unit Lwt.t) -> unit - (** [register_pre_collect t fn] same as [register_pre_collect] but [fn] returns [unit Lwt.t]. *) + [@@deprecated "Use Prometheus_lwt.CollectorRegistry.register_pre_collect instead."] + (** [register_pre_collect_lwt t fn] is like [register_pre_collect] but [fn] returns [unit Lwt.t]. *) end (** A collection of metric reporters. Usually, only {!CollectorRegistry.default} is used. *) @@ -162,12 +168,21 @@ module Gauge : sig (** [set t v] sets the current value of the gauge to [v]. *) val track_inprogress : t -> (unit -> 'a Lwt.t) -> 'a Lwt.t + [@@deprecated "Use track_in_progress (with two underscores in the name) instead if you don't need Lwt here, \ + or Prometheus_lwt.Gauge.track_in_progress if you do."] (** [track_inprogress t f] increases the value of the gauge by one while [f ()] is running. *) + val track_in_progress : t -> (unit -> 'a) -> 'a + (** [track_in_progress t f] increases the value of the gauge by one while [f ()] runs. *) + val time : t -> (unit -> float) -> (unit -> 'a Lwt.t) -> 'a Lwt.t + [@@deprecated "This increments the gauge, which is probably not what you want. Use set_time instead."] (** [time t gettime f] calls [gettime ()] before and after executing [f ()] and - increases the metric by the difference. - *) + increases the metric by the difference. *) + + val set_time : t -> (unit -> float) -> (unit -> 'a) -> 'a + (** [set_time t gettime f] calls [gettime ()] before and after executing [f ()] and + sets [t] to the difference. *) end (** A gauge is a metric that represents a single numerical value that can arbitrarily go up and down. *) @@ -178,8 +193,13 @@ module Summary : sig (** [observe t v] increases the total by [v] and the count by one. *) val time : t -> (unit -> float) -> (unit -> 'a Lwt.t) -> 'a Lwt.t + [@@deprecated "Use observe_time instead if you don't need Lwt here, or Prometheus_lwt.Summary.observe_time if you do."] (** [time t gettime f] calls [gettime ()] before and after executing [f ()] and observes the difference. *) + + val observe_time : t -> (unit -> float) -> (unit -> 'a) -> 'a + (** [observe_time t gettime f] calls [gettime ()] before and after executing [f ()] and + observes the difference. *) end (** A summary is a metric that records both the number of readings and their total. This allows calculating the average. *) @@ -211,8 +231,13 @@ module type HISTOGRAM = sig (** [observe t v] adds one to the appropriate bucket for v and adds v to the sum. *) val time : t -> (unit -> float) -> (unit -> 'a Lwt.t) -> 'a Lwt.t + [@@deprecated "Use observe_time instead if you don't need Lwt here, or Prometheus_lwt.HISTOGRAM.observe_time if you do."] (** [time t gettime f] calls [gettime ()] before and after executing [f ()] and observes the difference. *) + + val observe_time : t -> (unit -> float) -> (unit -> 'a) -> 'a + (** [observe_time t gettime f] calls [gettime ()] before and after executing [f ()] and + observes the difference. *) end module Histogram (Buckets : sig val spec : Histogram_spec.t end) : HISTOGRAM diff --git a/tests/test.ml b/tests/test.ml index 22ec5fb..9848dec 100644 --- a/tests/test.ml +++ b/tests/test.ml @@ -34,7 +34,7 @@ let test_metrics () = " output -let test_lwt_collectors () = +let test_collectors () = let registry = CollectorRegistry.create () in let register_counter ~name ~help value = let metric_info = { @@ -44,13 +44,9 @@ let test_lwt_collectors () = label_names = [] } in - let collector () = - Lwt.pause () >|= fun () -> - LabelSetMap.singleton [] [Prometheus.Sample_set.sample value] - in - CollectorRegistry.register_lwt registry metric_info collector + let collector () = LabelSetMap.singleton [] [Prometheus.Sample_set.sample value] in + CollectorRegistry.register registry metric_info collector in - (* Test register_lwt *) register_counter ~name:"counter_1" ~help:"The first counter" 1.0; register_counter ~name:"counter_2" ~help:"The second counter" 2.0; CollectorRegistry.collect registry >|= fun collected -> @@ -97,6 +93,29 @@ let test_histogram () = " output +let test_sync_timers () = + let registry = CollectorRegistry.create () in + let gauge = Gauge.v ~registry ~help:"Time taken" "gauge_time" in + let summary = Summary.v ~registry ~help:"Time taken" "summary_time" in + let clock = ref 0.0 in + let gettime () = !clock in + Gauge.set_time gauge gettime (fun () -> clock := !clock +. 1.3); + Gauge.set_time gauge gettime (fun () -> clock := !clock +. 1.5); + Gauge.track_in_progress gauge (fun () -> ()); + Summary.observe_time summary gettime (fun () -> clock := !clock +. 0.5); + Summary.observe_time summary gettime (fun () -> clock := !clock +. 1.5); + CollectorRegistry.collect registry >|= fun collected -> + let output = Fmt.to_to_string TextFormat_0_0_4.output collected in + Alcotest.(check string) "Text output" + "# HELP gauge_time Time taken\n\ + # TYPE gauge_time gauge\n\ + gauge_time 1.5\n\ + # HELP summary_time Time taken\n\ + # TYPE summary_time summary\n\ + summary_time_sum 2\n\ + summary_time_count 2\n" + output + (* "^[a-zA-Z_][a-zA-Z0-9_]*$" *) let valid_labels = [ "_"; @@ -169,8 +188,9 @@ let test_invalid_metrics_set = List.map (fun metric -> let test_set = [ "Metrics", `Quick, test_metrics; - "Lwt collectors",`Quick, test_lwt_collectors; + "Collectors",`Quick, test_collectors; "Histogram", `Quick, test_histogram; + "Sync timers", `Quick, test_sync_timers; ] let () =