Add http status metrics middleware

login
Robur 2 years ago
parent 8f4a45bf76
commit d986d614a8
  1. 1
      bin/builder_web_app.ml
  2. 2
      bin/dune
  3. 3
      http_status_middleware/dune
  4. 42
      http_status_middleware/http_status_metrics.ml

@ -95,6 +95,7 @@ let setup_app level influx port host datadir =
Dream.run ~port ~interface:host ~https:false
@@ Dream.logger
@@ Dream.sql_pool ("sqlite3:" ^ dbpath)
@@ Http_status_metrics.handle
@@ Builder_web.add_routes datadir
@@ Dream.not_found

@ -2,7 +2,7 @@
(public_name builder-web)
(name builder_web_app)
(modules builder_web_app)
(libraries builder_web mirage-crypto-rng.unix cmdliner logs.cli metrics metrics-lwt metrics-influx metrics-rusage ipaddr ipaddr.unix))
(libraries builder_web mirage-crypto-rng.unix cmdliner logs.cli metrics metrics-lwt metrics-influx metrics-rusage ipaddr ipaddr.unix http_status_metrics))
(executable
(public_name builder-db)

@ -0,0 +1,3 @@
(library
(name http_status_metrics)
(libraries dream metrics lwt))

@ -0,0 +1,42 @@
open Lwt.Infix
let create ~f =
let data : (string, int) Hashtbl.t = Hashtbl.create 7 in
(fun x ->
let key = f x in
let cur = match Hashtbl.find_opt data key with
| None -> 0
| Some x -> x
in
Hashtbl.replace data key (succ cur)),
(fun () ->
let data, total =
Hashtbl.fold (fun key value (acc, total) ->
(Metrics.uint key value :: acc), value + total)
data ([], 0)
in
Metrics.uint "total" total :: data)
let counter_metrics ~f name =
let open Metrics in
let doc = "Counter metrics" in
let incr, get = create ~f in
let data thing = incr thing; Data.v (get ()) in
Src.v ~doc ~tags:Metrics.Tags.[] ~data name
let add_http_status =
let f = function
| #Dream.informational -> "1xx"
| #Dream.successful -> "2xx"
| #Dream.redirection -> "3xx"
| #Dream.client_error -> "4xx"
| #Dream.server_error -> "5xx"
| `Status c -> Printf.sprintf "%dxx" (c / 100)
in
let src = counter_metrics ~f "http_response" in
(fun r -> Metrics.add src (fun x -> x) (fun d -> d r))
let handle next_handler req =
next_handler req >|= fun response ->
add_http_status (Dream.status response);
response
Loading…
Cancel
Save