From 96c7441d717acc8da4ab03f7c83b51117a0c3c0e Mon Sep 17 00:00:00 2001 From: Lucas Pluvinage Date: Fri, 11 Feb 2022 15:26:21 +0100 Subject: [PATCH] add a /metrics endpoint for monitoring --- dune-project | 1 + lib/dune | 2 +- lib/metrics.ml | 150 ++++++++++++++++++++++++++++++++++++++++++++++++ lib/mirageio.ml | 70 ++++++++++++++++++---- mirageio.opam | 1 + 5 files changed, 213 insertions(+), 11 deletions(-) create mode 100644 lib/metrics.ml diff --git a/dune-project b/dune-project index 5ced97aa..29822600 100644 --- a/dune-project +++ b/dune-project @@ -28,6 +28,7 @@ mirage-kv-mem mirage-clock-unix mirage-unix + prometheus (crunch :build) (omd :build) (yaml :build) diff --git a/lib/dune b/lib/dune index 9263ea4e..5d85ce86 100644 --- a/lib/dune +++ b/lib/dune @@ -1,7 +1,7 @@ (library (name mirageio) (libraries dream-mirage mirage-time tcpip mirageio_template mirageio_data - mirage-kv-mem)) + mirage-kv-mem prometheus)) (rule (targets asset.ml asset.mli) diff --git a/lib/metrics.ml b/lib/metrics.ml new file mode 100644 index 00000000..b1ed8104 --- /dev/null +++ b/lib/metrics.ml @@ -0,0 +1,150 @@ +open Prometheus + +let failf fmt = + Fmt.kstr failwith fmt + +module TextFormat_0_0_4 = struct + let re_unquoted_escapes = Re.compile @@ Re.set "\\\n" + let re_quoted_escapes = Re.compile @@ Re.set "\"\\\n" + + let quote g = + match Re.Group.get g 0 with + | "\\" -> "\\\\" + | "\n" -> "\\n" + | "\"" -> "\\\"" + | x -> failf "Unexpected match %S" x + + let output_metric_type f = function + | Counter -> Fmt.string f "counter" + | Gauge -> Fmt.string f "gauge" + | Summary -> Fmt.string f "summary" + | Histogram -> Fmt.string f "histogram" + + let output_unquoted f s = + Fmt.string f @@ Re.replace re_unquoted_escapes ~f:quote s + + let output_quoted f s = + Fmt.string f @@ Re.replace re_quoted_escapes ~f:quote s + + (* Fmt.float by default prints floats using scientific exponential + * notation, which loses significant data on e.g. timestamp: + * Fmt.str "%a" Fmt.float 1575363850.57 --> 1.57536e+09 *) + let float_fmt f = + Fmt.pf f "%f" + + let output_value f v = + match classify_float v with + | FP_normal | FP_subnormal | FP_zero -> float_fmt f v + | FP_infinite when v > 0.0 -> Fmt.string f "+Inf" + | FP_infinite -> Fmt.string f "-Inf" + | FP_nan -> Fmt.string f "Nan" + + let output_pairs f (label_names, label_values) = + let cont = ref false in + let output_pair name value = + if !cont then Fmt.string f ", " + else cont := true; + Fmt.pf f "%a=\"%a\"" LabelName.pp name output_quoted value + in + List.iter2 output_pair label_names label_values + + let output_labels ~label_names f = function + | [] -> () + | label_values -> Fmt.pf f "{%a}" output_pairs (label_names, label_values) + + let output_sample ~base ~label_names ~label_values f { Sample_set.ext; value; bucket } = + let label_names, label_values = match bucket with + | None -> label_names, label_values + | Some (label_name, label_value) -> + let label_value_str = Fmt.str "%a" output_value label_value in + label_name :: label_names, label_value_str :: label_values + in + Fmt.pf f "%a%s%a %a@." + MetricName.pp base ext + (output_labels ~label_names) label_values + output_value value + + let output_metric ~name ~label_names f (label_values, samples) = + List.iter (output_sample ~base:name ~label_names ~label_values f) samples + + let output f = + MetricFamilyMap.iter (fun metric samples -> + let {MetricInfo.name; metric_type; help; label_names} = metric in + Fmt.pf f + "#HELP %a %a@.\ + #TYPE %a %a@.\ + %a" + MetricName.pp name output_unquoted help + MetricName.pp name output_metric_type metric_type + (LabelSetMap.pp ~sep:Fmt.nop (output_metric ~name ~label_names)) samples + ) +end + +module Runtime = struct + let current = ref (Gc.quick_stat ()) + let update () = + current := Gc.quick_stat () + + let simple_metric ~metric_type ~help name fn = + let info = { + MetricInfo. + name = MetricName.v name; + help; + metric_type; + label_names = []; + } + in + let collect () = + LabelSetMap.singleton [] [Sample_set.sample (fn ())] + in + info, collect + + let ocaml_gc_allocated_bytes = + simple_metric ~metric_type:Counter "ocaml_gc_allocated_bytes" Gc.allocated_bytes + ~help:"Total number of bytes allocated since the program was started." + + let ocaml_gc_major_words = + simple_metric ~metric_type:Counter "ocaml_gc_major_words" (fun () -> (!current).Gc.major_words) + ~help:"Number of words allocated in the major heap since the program was started." + + let ocaml_gc_minor_collections = + simple_metric ~metric_type:Counter "ocaml_gc_minor_collections" (fun () -> float_of_int (!current).Gc.minor_collections) + ~help:"Number of minor collection cycles completed since the program was started." + + let ocaml_gc_major_collections = + simple_metric ~metric_type:Counter "ocaml_gc_major_collections" (fun () -> float_of_int (!current).Gc.major_collections) + ~help:"Number of major collection cycles completed since the program was started." + + let ocaml_gc_heap_words = + simple_metric ~metric_type:Gauge "ocaml_gc_heap_words" (fun () -> float_of_int (!current).Gc.heap_words) + ~help:"Total size of the major heap, in words." + + let ocaml_gc_compactions = + simple_metric ~metric_type:Counter "ocaml_gc_compactions" (fun () -> float_of_int (!current).Gc.compactions) + ~help:"Number of heap compactions since the program was started." + + let ocaml_gc_top_heap_words = + simple_metric ~metric_type:Counter "ocaml_gc_top_heap_words" (fun () -> float_of_int (!current).Gc.top_heap_words) + ~help:"Maximum size reached by the major heap, in words." + + let process_cpu_seconds_total = + simple_metric ~metric_type:Counter "process_cpu_seconds_total" Sys.time + ~help:"Total user and system CPU time spent in seconds." + + let metrics = [ + ocaml_gc_allocated_bytes; + ocaml_gc_major_words; + ocaml_gc_minor_collections; + ocaml_gc_major_collections; + ocaml_gc_heap_words; + ocaml_gc_compactions; + ocaml_gc_top_heap_words; + process_cpu_seconds_total; + ] +end + +let () = + CollectorRegistry.(register_pre_collect default) Runtime.update; + let add (info, collector) = + CollectorRegistry.(register default) info collector in + List.iter add Runtime.metrics diff --git a/lib/mirageio.ml b/lib/mirageio.ml index a2c55d2a..5eda1be1 100644 --- a/lib/mirageio.ml +++ b/lib/mirageio.ml @@ -73,6 +73,13 @@ struct Dream.respond ~headers:[ ("Content-Type", "application/atom+xml") ] (Atom.render ~blog_posts ~contributors ~last_update) + + let metrics _req = + let data = Prometheus.CollectorRegistry.(collect default) in + let body = Fmt.to_to_string Metrics.TextFormat_0_0_4.output data in + Dream.respond + ~headers:[ ("Content-Type", "text/plain; version=0.0.4") ] + body end module Last_modified = struct @@ -147,19 +154,62 @@ struct asset) end + module Metrics = struct + open Prometheus + + let now () = Ptime.to_float_s (Ptime.v (Pclock.now_d_ps ())) + + let response_time = + Gauge.v ~help:"Mirage.io handler response time" "mirageio_response_time_s" + + let n_requests_pages = + Counter.v ~help:"Mirage.io number of page requests" + "mirageio_requests_pages" + + let n_requests_assets = + Counter.v ~help:"Mirage.io number of asset requests" + "mirageio_requests_assets" + + let n_cached = + Counter.v ~help:"Mirage.io number of cache match" "mirageio_cached" + + let n_errors = + Counter.v ~help:"Mirage.io number of errors" "mirageio_errors" + + let middleware counter handler req = + let open Lwt.Syntax in + let start = now () in + let+ response = handler req in + let elapsed = now () -. start in + Gauge.set response_time elapsed; + Counter.inc_one counter; + (match Dream.status response with + | `OK -> () + | `Not_Modified -> Counter.inc_one n_cached + | _ -> Counter.inc_one n_errors); + response + end + module Router = struct let routes = [ - Dream.get "/" Handler.index; - Dream.get "/blog" Handler.blog; - Dream.get "/blog/:permalink" Handler.blog_inner; - Dream.get "/community" Handler.community; - Dream.get "/docs" Handler.docs; - Dream.get "/docs/:permalink" Handler.docs_inner; - Dream.get "/weekly/:permalink" Handler.weekly; - Dream.get "/papers" Handler.papers; - Dream.get "/feed.xml" Handler.atom; - Dream.get "/**" (Dream.static ~loader:Static.loader ""); + Dream.get "/metrics" Handler.metrics; + Dream.scope "/" + [ Metrics.middleware Metrics.n_requests_pages ] + [ + Dream.get "/" Handler.index; + Dream.get "/blog" Handler.blog; + Dream.get "/blog/:permalink" Handler.blog_inner; + Dream.get "/community" Handler.community; + Dream.get "/docs" Handler.docs; + Dream.get "/docs/:permalink" Handler.docs_inner; + Dream.get "/weekly/:permalink" Handler.weekly; + Dream.get "/papers" Handler.papers; + Dream.get "/feed.xml" Handler.atom; + ]; + Dream.get "/**" + (Metrics.middleware Metrics.n_requests_assets + @@ Dream.static ~loader:Static.loader ""); ] let router = Dream.router routes diff --git a/mirageio.opam b/mirageio.opam index 6c24dccd..b36e57a4 100644 --- a/mirageio.opam +++ b/mirageio.opam @@ -16,6 +16,7 @@ depends: [ "mirage-kv-mem" "mirage-clock-unix" "mirage-unix" + "prometheus" "crunch" {build} "omd" {build} "yaml" {build}