From b1728ff0e8b63ab11a3b7994f1267256e94bced6 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 27 Mar 2024 16:05:12 -0400 Subject: [PATCH] move `Time` into a proper module in the core, depopt on mtime --- src/core/dune | 3 +++ .../time_.default.ml => core/time.default.ml} | 2 ++ src/core/time.mli | 10 ++++++++++ src/core/time.mtime.ml | 7 +++++++ src/prometheus/common_p_.ml | 1 + src/prometheus/dune | 7 ++----- src/prometheus/time_.mli | 1 - src/prometheus/time_.mtime.ml | 3 --- src/prometheus/tiny_httpd_prometheus.ml | 4 ++-- 9 files changed, 27 insertions(+), 11 deletions(-) rename src/{prometheus/time_.default.ml => core/time.default.ml} (71%) create mode 100644 src/core/time.mli create mode 100644 src/core/time.mtime.ml delete mode 100644 src/prometheus/time_.mli delete mode 100644 src/prometheus/time_.mtime.ml diff --git a/src/core/dune b/src/core/dune index a04707ef..a8a7fb0c 100644 --- a/src/core/dune +++ b/src/core/dune @@ -4,6 +4,9 @@ (public_name tiny_httpd.core) (private_modules parse_ common_) (libraries threads seq hmap iostream + (select time.ml from + (mtime mtime.clock.os -> time.mtime.ml) + (unix -> time.default.ml)) (select log.ml from (logs -> log.logs.ml) (-> log.default.ml)))) diff --git a/src/prometheus/time_.default.ml b/src/core/time.default.ml similarity index 71% rename from src/prometheus/time_.default.ml rename to src/core/time.default.ml index 86dd302c..7c0959fd 100644 --- a/src/prometheus/time_.default.ml +++ b/src/core/time.default.ml @@ -1,3 +1,5 @@ +let now_s = Unix.gettimeofday + let[@inline] now_us () = let t = Unix.gettimeofday () in t *. 1e6 |> ceil diff --git a/src/core/time.mli b/src/core/time.mli new file mode 100644 index 00000000..18558346 --- /dev/null +++ b/src/core/time.mli @@ -0,0 +1,10 @@ +(** Basic time measurement. + + This provides a basic clock, monotonic if [mtime] is installed, + or based on [Unix.gettimeofday] otherwise *) + +val now_us : unit -> float +(** Current time in microseconds. The precision should be at least below the millisecond. *) + +val now_s : unit -> float +(** Current time in seconds. The precision should be at least below the millisecond. *) diff --git a/src/core/time.mtime.ml b/src/core/time.mtime.ml new file mode 100644 index 00000000..2c3202da --- /dev/null +++ b/src/core/time.mtime.ml @@ -0,0 +1,7 @@ +let[@inline] now_s () = + let t = Mtime_clock.now_ns () in + Int64.(div t 1_000_000_000L |> to_float) + +let[@inline] now_us () = + let t = Mtime_clock.now_ns () in + Int64.(div t 1000L |> to_float) diff --git a/src/prometheus/common_p_.ml b/src/prometheus/common_p_.ml index 812670ab..e610f671 100644 --- a/src/prometheus/common_p_.ml +++ b/src/prometheus/common_p_.ml @@ -1,3 +1,4 @@ module A = Tiny_httpd_core.Atomic_ +module Time = Tiny_httpd_core.Time let spf = Printf.sprintf diff --git a/src/prometheus/dune b/src/prometheus/dune index 3439a474..b415ed3e 100644 --- a/src/prometheus/dune +++ b/src/prometheus/dune @@ -4,10 +4,7 @@ (name tiny_httpd_prometheus) (public_name tiny_httpd.prometheus) (synopsis "Metrics using prometheus") - (private_modules common_p_ time_) + (private_modules common_p_) (flags :standard -open Tiny_httpd_core) (libraries - tiny_httpd.core unix - (select time_.ml from - (mtime mtime.clock.os -> time_.mtime.ml) - (-> time_.default.ml)))) + tiny_httpd.core unix)) diff --git a/src/prometheus/time_.mli b/src/prometheus/time_.mli deleted file mode 100644 index d6824fba..00000000 --- a/src/prometheus/time_.mli +++ /dev/null @@ -1 +0,0 @@ -val now_us : unit -> float diff --git a/src/prometheus/time_.mtime.ml b/src/prometheus/time_.mtime.ml deleted file mode 100644 index 65e2ec73..00000000 --- a/src/prometheus/time_.mtime.ml +++ /dev/null @@ -1,3 +0,0 @@ -let[@inline] now_us () = - let t = Mtime_clock.now_ns () in - Int64.(div t 1000L |> to_float) diff --git a/src/prometheus/tiny_httpd_prometheus.ml b/src/prometheus/tiny_httpd_prometheus.ml index b3ec4e39..b3529320 100644 --- a/src/prometheus/tiny_httpd_prometheus.ml +++ b/src/prometheus/tiny_httpd_prometheus.ml @@ -189,12 +189,12 @@ let http_middleware (reg : Registry.t) : Server.Middleware.t = fun h : Server.Middleware.handler -> fun req ~resp : unit -> - let start = Time_.now_us () in + let start = Time.now_us () in Counter.incr c_req; h req ~resp:(fun (response : Response.t) -> let code = response.code in - let elapsed_us = Time_.now_us () -. start in + let elapsed_us = Time.now_us () -. start in let elapsed_s = elapsed_us /. 1e6 in Histogram.add h_latency elapsed_s;