Use mtime to measure times

app/dune

@@ -1,7 +1,7 @@
 (library
  (name prometheus_app)
  (public_name prometheus-app)
- (libraries prometheus lwt cohttp-lwt fmt re)
+ (libraries prometheus lwt cohttp-lwt fmt re mirage-mtime)
  (modules Prometheus_app)
  (wrapped false))
 

app/prometheus_app.ml

@@ -156,6 +156,7 @@ module Cohttp(Server : Cohttp_lwt.S.Server) = struct
 end
 
 let () =
+  Prometheus.init ~gettime:Mirage_mtime.elapsed_ns ();
   CollectorRegistry.(register_pre_collect default) Runtime.update;
   let add (info, collector) =
     CollectorRegistry.(register default) info collector in

app/prometheus_app.mli

@@ -11,7 +11,8 @@
       GC statistics, as recommended by Prometheus.
 
     - This module does not depend on [Unix], and so can be used in unikernels.
-      For that case, you must remember to call {!Prometheus.init} yourself at start-up. *)
+
+    - This module calls {!Prometheus.init} automatically when linked. *)
 
 module TextFormat_0_0_4 : sig
   val output : Prometheus.CollectorRegistry.snapshot Fmt.t

app/prometheus_unix.ml

@@ -66,7 +66,6 @@ let listen_prometheus =
 let opts = listen_prometheus
 
 let () =
-  Prometheus.init ~gettime:Unix.gettimeofday ();
   let add (info, collector) =
     CollectorRegistry.(register default) info collector in
   List.iter add Unix_runtime.metrics

lwt/prometheus_lwt.ml

@@ -1,5 +1,8 @@
 [@@@alert "-deprecated"]
 
+let time_delta t0 t1 =
+  Int64.to_float (Int64.sub t1 t0) /. 1e9
+
 (* 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. *)
@@ -22,13 +25,37 @@ end
 module Gauge = struct
   let track_in_progress = Prometheus.Gauge.track_inprogress
 
-  let set_time t fn = Prometheus.Gauge.time t (Prometheus.get_gettime ()) fn
+  let set_time t fn =
+    let gettime = Prometheus.get_gettime () in
+    let start = gettime () in
+    Lwt.finalize fn
+      (fun () ->
+         let finish = gettime () in
+         Prometheus.Gauge.set t (time_delta start finish);
+         Lwt.return_unit
+      )
 end
 
 module Summary = struct
-  let observe_time t fn = Prometheus.Summary.time t (Prometheus.get_gettime ()) fn
+  let observe_time t fn =
+    let gettime = Prometheus.get_gettime () in
+    let start = gettime () in
+    Lwt.finalize fn
+      (fun () ->
+         let finish = gettime () in
+         Prometheus.Summary.observe t (time_delta start finish);
+         Lwt.return_unit
+      )
 end
 
 module Histogram (H : Prometheus.HISTOGRAM) = struct
-  let observe_time t fn = H.time t (Prometheus.get_gettime ()) fn
+  let observe_time t fn =
+    let gettime = Prometheus.get_gettime () in
+    let start = gettime () in
+    Lwt.finalize fn
+      (fun () ->
+         let finish = gettime () in
+         H.observe t (time_delta start finish);
+         Lwt.return_unit
+      )
 end

lwt/test/test_lwt.ml

@@ -3,10 +3,13 @@ open Prometheus_app
 
 open Lwt.Infix
 
-let clock = ref 0.0
+let clock = ref 0L
 let gettime () = !clock
 let () = Prometheus.init ~gettime ()
 
+let advance sec =
+  clock := Int64.add !clock (Int64.of_float (sec *. 1e9))
+
 let test_lwt_collectors () =
   let registry = Prometheus_lwt.CollectorRegistry.of_registry (CollectorRegistry.create ()) in
   let sync_counter =
@@ -49,7 +52,7 @@ let test_timers () =
   let core = Prometheus_lwt.CollectorRegistry.core registry in
   let gauge = Gauge.v ~registry:core ~help:"Time taken" "gauge_time" in
   Prometheus_lwt.Gauge.set_time gauge
-    (fun () -> clock := !clock +. 1.5; Lwt.pause ())
+    (fun () -> advance 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

prometheus-app.opam

@@ -28,6 +28,7 @@ depends: [
   "ocaml" {>= "4.11.0"}
   "dune" {>= "2.3"}
   "prometheus" {= version}
+  "mirage-mtime" {>= "5.2.0"}
   "fmt" {>= "0.8.7"}
   "re"
   "cohttp-lwt" {>= "4.0.0"}

src/prometheus.ml

@@ -1,11 +1,14 @@
-let dummy_gettime = Fun.const 0.0
+let dummy_gettime = Fun.const 0L
 let gettime = ref dummy_gettime
 
 let init ~gettime:x () =
   gettime := x
 
 let get_gettime () = !gettime
 
+let time_delta t0 t1 =
+  Int64.to_float (Int64.sub t1 t0) /. 1e9
+
 module type NAME_SPEC = sig
   val valid : Re.re
 end
@@ -283,7 +286,7 @@ module Gauge = struct
     Fun.protect fn
       ~finally:(fun () ->
          let finish = gettime () in
-         set t (finish -. start)
+         set t (time_delta start finish)
       )
 end
 
@@ -327,7 +330,7 @@ module Summary = struct
     Fun.protect fn
       ~finally:(fun () ->
          let finish = gettime () in
-         observe t (finish -. start)
+         observe t (time_delta start finish)
       )
 end
 
@@ -441,7 +444,7 @@ module Histogram (Buckets : BUCKETS) = struct
     Fun.protect fn
       ~finally:(fun () ->
          let finish = gettime () in
-         observe t (finish -. start)
+         observe t (time_delta start finish)
       )
 end
 

src/prometheus.mli

@@ -15,12 +15,14 @@
       should use [Prometheus_lwt] or the synchronous variants.
 *)
 
-val init : gettime:(unit -> float) -> unit -> unit
-(** [init ~gettime ()] sets the global function for recording the current time.
+val init : gettime:(unit -> int64) -> unit -> unit
+(** [init ~gettime ()] sets the global function for recording the current time
+    (in nanosecods from an arbitrary base).
+    Typically this will be [Mirage_mtime.elapsed_ns].
 
-    {!Prometheus_unix} calls [init ~gettime:Unix.gettimeofday ()] at start-up,
-    but if you're collecting metrics manually then you MUST call [init]
-    yourself before using any time-based functions.
+    {!Prometheus_app} calls this at start-up, but if you're collecting metrics
+    manually then you MUST call [init] yourself before using any time-based
+    functions.
 
     Only the main application code that collects metrics should call this;
     libraries that merely report metrics should not call this function.
@@ -263,7 +265,7 @@ module Histogram (Buckets : sig val spec : Histogram_spec.t end) : HISTOGRAM
 module DefaultHistogram : HISTOGRAM
 (** A histogram configured with reasonable defaults for measuring network request times in seconds. *)
 
-val get_gettime : unit -> (unit -> float)
+val get_gettime : unit -> (unit -> int64)
 (** Get the time function passed to {!init}.
 
-    If [init] has not been called yet, the returned function always returns 0.0. *)
+    If [init] has not been called yet, the returned function always returns 0. *)

tests/test.ml

@@ -3,10 +3,13 @@ open Prometheus_app
 
 open Lwt.Infix
 
-let clock = ref 0.0
+let clock = ref 0L
 let gettime () = !clock
 let () = Prometheus.init ~gettime ()
 
+let advance sec =
+  clock := Int64.add !clock (Int64.of_float (sec *. 1e9))
+
 let test_metrics () =
   let registry = CollectorRegistry.create () in
   let tiny_gauge = Gauge.v ~registry ~help:"Tiny" ~namespace:"dkci" ~subsystem:"tests" "tiny" in
@@ -101,11 +104,11 @@ 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
-  Gauge.set_time gauge (fun () -> clock := !clock +. 1.3);
-  Gauge.set_time gauge (fun () -> clock := !clock +. 1.5);
+  Gauge.set_time gauge (fun () -> advance 1.3);
+  Gauge.set_time gauge (fun () -> advance 1.5);
   Gauge.track_in_progress gauge (fun () -> ());
-  Summary.observe_time summary (fun () -> clock := !clock +. 0.5);
-  Summary.observe_time summary (fun () -> clock := !clock +. 1.5);
+  Summary.observe_time summary (fun () -> advance 0.5);
+  Summary.observe_time summary (fun () -> advance 1.5);
   CollectorRegistry.collect_lwt registry >|= fun collected ->
   let output = Fmt.to_to_string TextFormat_0_0_4.output collected in
   Alcotest.(check string) "Text output"