From cc0b101e79cb93d34aace1a5766ed6d9816d2d8f Mon Sep 17 00:00:00 2001
From: swrup <swrup@protonmail.com>
Date: Sun, 30 Nov 2025 02:21:17 +0100
Subject: [PATCH] wip logging

---
 dune-project |  1 +
 mte.opam     |  1 +
 src/dune     |  5 ++++-
 src/mte.ml   | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 63 insertions(+), 1 deletion(-)

diff --git a/dune-project b/dune-project
index 163a239d..5bd4e1f1 100644
--- a/dune-project
+++ b/dune-project
@@ -41,5 +41,6 @@
    jsont
    cohttp
    ptime
+   logs
   (ocamlformat :with-dev-setup)
    ))
diff --git a/mte.opam b/mte.opam
index 1c4d5904..8bdbc121 100644
--- a/mte.opam
+++ b/mte.opam
@@ -28,6 +28,7 @@ depends: [
   "jsont"
   "cohttp"
   "ptime"
+  "logs"
   "ocamlformat" {with-dev-setup}
   "odoc" {with-doc}
 ]
diff --git a/src/dune b/src/dune
index fb09a728..72488905 100644
--- a/src/dune
+++ b/src/dune
@@ -24,7 +24,10 @@
   fmt
   jsont
   cohttp
-  ptime))
+  ptime
+  logs
+  logs.fmt
+  fmt.tty))
 
 (library ; crockford base32
  (name b32)
diff --git a/src/mte.ml b/src/mte.ml
index b7b46b8a..a15b353c 100644
--- a/src/mte.ml
+++ b/src/mte.ml
@@ -13,6 +13,61 @@
     You should have received a copy of the GNU Affero General Public License
     along with this program.  If not, see <https://www.gnu.org/licenses/>. *)
 
+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 log_level_color = function
+  | Logs.App -> `White
+  | Error -> `Red
+  | Warning -> `Yellow
+  | Info -> `Blue
+  | Debug -> `Magenta
+
+let reporter ppf : Logs.reporter =
+  let report src lvl ~over k msgf =
+    let k _ppf = over (); k () in
+    let with_detail h tags k ppf user_fmt =
+      let detail =
+        Option.bind tags (Logs.Tag.find detail_tag) |> Option.value ~default:""
+      in
+      let dt =
+        Ptime.sub_span (Ptime_clock.now ()) time_anchor
+        |> Option.get
+        |> Ptime.to_float_s
+      in
+      let open Fmt in
+      let pp_header ppf v =
+        let color = fst v |> log_level_color in
+        let pp = styled (`Fg color) Logs.pp_header in
+        pf ppf "%a" pp v
+      in
+      let pp_src ppf src =
+        match Logs.Src.equal Logs.default src with
+        | true -> ()
+        | false -> pf ppf "%a: " (styled `Cyan string) (Logs.Src.name src)
+      in
+      let k ppf = kpf k ppf "%a@." (styled `Green (fmt " (%s)")) detail in
+      let k ppf = kpf k ppf user_fmt in
+      kpf k ppf "%a %a %a"
+        (styled `Faint (styled (`Fg `White) (fmt "%04.02f")))
+        dt pp_header (lvl, h) pp_src src
+    in
+    msgf @@ fun ?header ?tags fmt -> with_detail header tags k ppf fmt
+  in
+  { report }
+
+let () =
+  Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ();
+  Logs.set_reporter (reporter Fmt.stderr);
+  Logs.set_level ~all:false (Some Logs.Debug);
+  Logs.Src.set_level Logs.default (Some Logs.Debug);
+  (*Logs_threaded.enable ();*)
+  Printexc.record_backtrace true;
+  ()
+
 let error_detail ?hint _status =
   let open Api in
   let code = -1 in
@@ -116,6 +171,7 @@ let routes =
   ]
 
 let () =
+  (*Logs.set_reporter (Logs_fmt.reporter ());*)
   let cfg =
     let port = Config.Exchange.port in
     let sockaddr = Unix.(ADDR_INET (inet_addr_loopback, port)) in
@@ -131,4 +187,5 @@ let () =
       [ Devices.db_connection; Devices.secmod_signkey; Devices.secmod_denom ]
   in
   let middlewares = Vif.Middlewares.[] in
+  Logs.info (fun m -> m ~tags:(detail "~~!") "Starting MTE server");
   Vif.run ~cfg ~devices ~middlewares routes env