use logs + add static.ml + fmt

src/util.ml

@@ -35,7 +35,6 @@ module Bin_rsa = struct
 
     let z_array_to_octets (arr : Z.t array) =
       let nb = Array.length arr in
-      (*Fmt.epr "z_array_to_octets, nb=%d@." nb;*)
       let bits_arr = Array.map z_to_bits_be arr in
       let len_arr = Array.map String.length bits_arr in
       let len = (2 * nb) + Array.fold_left ( + ) 0 len_arr in
@@ -55,7 +54,6 @@ module Bin_rsa = struct
       Bytes.unsafe_to_string b
 
     let z_array_of_octets ~nb s =
-      (*Fmt.epr "z_array_of_octets, nb=%d@." nb;*)
       let s_len = String.length s in
       let* () = check (s_len > 2 * nb) in
       let pos = ref 0 in
@@ -114,3 +112,66 @@ module Bin_rsa = struct
     | Error (`Msg e) -> Fmt.failwith "rsa priv_of_octets failure: %s@." e
     | Ok v -> v
 end
+
+module Log_reporter = struct
+  let detail_tag : string Logs.Tag.def =
+    Logs.Tag.def "Detail tag" ~doc:"" Fmt.string
+
+  let detail s = Logs.Tag.(empty |> add detail_tag s)
+  let time_anchor = Ptime_clock.now () |> Ptime.to_span
+
+  let color_of_log_level = function
+    | Logs.App -> `White
+    | Error -> `Red
+    | Warning -> `Yellow
+    | Info -> `Blue
+    | Debug -> `Magenta
+
+  let reporter : Logs.reporter =
+    let open Fmt in
+    let pp_timestamp = styled `Faint (styled (`Fg `White) (fmt "%04.02f")) in
+    let pp_header ppf v =
+      let color = color_of_log_level (fst v) in
+      let pp = styled (`Fg color) Logs.pp_header in
+      pf ppf "%a" pp v
+    in
+    let pp_src_name =
+      let pp = using Logs.Src.name (styled `Cyan (fmt "%s: ")) in
+      fun ppf v -> if not @@ Logs.Src.equal Logs.default v then pp ppf v
+    in
+    let pp_detail = option (styled `Green (fmt " (%s)")) in
+    let report src lvl ~over k msgf =
+      let ppf =
+        match lvl with
+        | Logs.App -> stdout
+        | Error | Warning | Info | Debug -> stderr
+      in
+      let k _ppf = over (); k () in
+      let with_detail h tags k user_fmt =
+        let detail = Option.bind tags (Logs.Tag.find detail_tag) in
+        let timestamp =
+          Ptime.sub_span (Ptime_clock.now ()) time_anchor
+          |> Option.map Ptime.to_float_s
+          |> Option.value ~default:0.
+        in
+        let k ppf = kpf k ppf "%a@." pp_detail detail in
+        let k ppf = kpf k ppf user_fmt in
+        kpf k ppf "%a %a %a" pp_timestamp timestamp pp_header (lvl, h)
+          pp_src_name src
+      in
+      msgf @@ fun ?header ?tags fmt -> with_detail header tags k fmt
+    in
+    { report }
+
+  (* TODO logs
+     - vif shouldn't use/set the default reporter
+     - Log.err all `Internal_server_error response *)
+  let setup () =
+    let level = Some Logs.Info in
+    Logs.set_level ~all:false level;
+    Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ();
+    Logs.Src.set_level Logs.default level;
+    Logs_threaded.enable ();
+    Logs.set_reporter reporter;
+    ()
+end