Refine logger

basic/log.ml

@@ -1,8 +1,11 @@
 module Tag = struct
-  let ppf_str = Fun.flip Format.fprintf "%s"
-
   let str ~name =
-    let tag = Logs.Tag.def name ppf_str in
+    let tag = Logs.Tag.def name (Fun.flip Format.fprintf "%s") in
+    Logs.Tag.add tag
+  ;;
+
+  let int ~name =
+    let tag = Logs.Tag.def name (Fun.flip Format.fprintf "%d") in
     Logs.Tag.add tag
   ;;
 
@@ -11,7 +14,19 @@ module Tag = struct
     Logs.Tag.add tag
   ;;
 
-  let upstream_header = Logs.Tag.(def "upstream_header" Headers.pp |> add)
-  let downstream_header = Logs.Tag.(def "downstream_header" Headers.pp |> add)
   let empty = Logs.Tag.empty
 end
+
+(** set Logs logger to gRPC-Core log message callback with ["grpc.core"] for [src], ["grpc.core.file"] for file of the source, ["grpc.core.line"] for the line number of the file. *)
+let set_core_callback () =
+  let src = Logs.Src.create "grpc.core" in
+  let file_tag = Tag.str ~name:"grpc.core.file" in
+  let line_tag = Tag.int ~name:"grpc.core.line" in
+  Grpc_core.Log.set_log_callback
+  @@ fun ~file ~line ~log_level ~message ->
+  let tags = Tag.empty |> file_tag file |> line_tag line in
+  match log_level with
+  | `Error -> Logs.err ~src @@ fun m -> m ~tags "%s" message
+  | `Debug -> Logs.debug ~src @@ fun m -> m ~tags "%s" message
+  | `Info -> Logs.info ~src @@ fun m -> m ~tags "%s" message
+;;

server/handler.ml

@@ -43,7 +43,7 @@ Unary.add rpc @@ fun ctx req md ->
         let%lwt () =
           Logs_lwt.debug ~src:Log.default
           @@ fun m ->
-          let tags = default_tags context |> Log.Tag.upstream_header metadata in
+          let tags = default_tags context |> Log.Tag.upstream_headers metadata in
           m ~tags ~header:Log.header "get request on %s" methd
         in
         let%lwt res = handler context metadata call request in

server/log.ml

@@ -13,6 +13,16 @@ module Tag = struct
     let def = Logs.Tag.def "request" Grpc_basic.Headers.pp in
     Logs.Tag.add def
   ;;
+
+  let upstream_headers =
+    let def = Logs.Tag.def "grpc.server.upstream_headers" Grpc_basic.Headers.pp in
+    Logs.Tag.add def
+  ;;
+
+  let downstream_headers =
+    let def = Logs.Tag.def "grpc.server.downstream_headers" Grpc_basic.Headers.pp in
+    Logs.Tag.add def
+  ;;
 end
 
 module Export = struct