ocaml-opentelemetry/src/client/resource_signal.ml

open Common_
module Trace_service = Opentelemetry.Proto.Trace_service
module Metrics_service = Opentelemetry.Proto.Metrics_service
module Logs_service = Opentelemetry.Proto.Logs_service
module Span = Opentelemetry.Span

open struct
  let of_x_or_empty ?service_name ?attrs ~f l =
    if l = [] then
      []
    else
      [ f ?service_name ?attrs l ]
end

type t =
  | Traces of Proto.Trace.resource_spans list
  | Metrics of Proto.Metrics.resource_metrics list
  | Logs of Proto.Logs.resource_logs list

let of_logs ?service_name ?attrs logs : t =
  Logs [ Util_resources.make_resource_logs ?service_name ?attrs logs ]

let of_logs_or_empty ?service_name ?attrs logs =
  of_x_or_empty ?service_name ?attrs ~f:of_logs logs

let of_spans ?service_name ?attrs spans : t =
  Traces [ Util_resources.make_resource_spans ?service_name ?attrs spans ]

let of_spans_or_empty ?service_name ?attrs spans =
  of_x_or_empty ?service_name ?attrs ~f:of_spans spans

let of_metrics ?service_name ?attrs m : t =
  Metrics [ Util_resources.make_resource_metrics ?service_name ?attrs m ]

let of_metrics_or_empty ?service_name ?attrs ms =
  of_x_or_empty ?service_name ?attrs ~f:of_metrics ms

let to_traces = function
  | Traces xs -> Some xs
  | _ -> None

let to_metrics = function
  | Metrics xs -> Some xs
  | _ -> None

let to_logs = function
  | Logs xs -> Some xs
  | _ -> None

let is_traces = function
  | Traces _ -> true
  | _ -> false

let is_metrics = function
  | Metrics _ -> true
  | _ -> false

let is_logs = function
  | Logs _ -> true
  | _ -> false

let of_signal_l ?service_name ?attrs (s : OTEL.Any_signal_l.t) : t =
  match s with
  | Logs logs -> of_logs ?service_name ?attrs logs
  | Spans sp -> of_spans ?service_name ?attrs sp
  | Metrics ms -> of_metrics ?service_name ?attrs ms

type protocol = Exporter_config.protocol =
  | Http_protobuf
  | Http_json

module Encode = struct
  let resource_to_pb_string ~encoder ~ctor ~enc resource : string =
    let encoder =
      match encoder with
      | Some e ->
        Pbrt.Encoder.reset e;
        e
      | None -> Pbrt.Encoder.create ()
    in
    let x = ctor resource in
    let data =
      let@ _sc =
        Self_trace.with_ ~kind:Span.Span_kind_internal "encode-proto"
      in
      enc x encoder;
      let data = Pbrt.Encoder.to_string encoder in
      Span.add_attrs _sc [ "size", `Int (String.length data) ];
      Pbrt.Encoder.reset encoder;
      data
    in
    data

  let resource_to_json_string ~ctor ~enc resource : string =
    let x = ctor resource in
    let data =
      let@ _sc = Self_trace.with_ ~kind:Span.Span_kind_internal "encode-json" in
      let json = enc x in
      let data = Yojson.Basic.to_string json in
      Span.add_attrs _sc [ "size", `Int (String.length data) ];
      data
    in
    data

  let logs_pb ?encoder resource_logs =
    resource_to_pb_string ~encoder resource_logs
      ~ctor:(fun r ->
        Logs_service.make_export_logs_service_request ~resource_logs:r ())
      ~enc:Logs_service.encode_pb_export_logs_service_request

  let logs_json resource_logs =
    resource_to_json_string resource_logs
      ~ctor:(fun r ->
        Logs_service.make_export_logs_service_request ~resource_logs:r ())
      ~enc:Logs_service.encode_json_export_logs_service_request

  let metrics_pb ?encoder resource_metrics =
    resource_to_pb_string ~encoder resource_metrics
      ~ctor:(fun r ->
        Metrics_service.make_export_metrics_service_request ~resource_metrics:r
          ())
      ~enc:Metrics_service.encode_pb_export_metrics_service_request

  let metrics_json resource_metrics =
    resource_to_json_string resource_metrics
      ~ctor:(fun r ->
        Metrics_service.make_export_metrics_service_request ~resource_metrics:r
          ())
      ~enc:Metrics_service.encode_json_export_metrics_service_request

  let traces_pb ?encoder resource_spans =
    resource_to_pb_string ~encoder resource_spans
      ~ctor:(fun r ->
        Trace_service.make_export_trace_service_request ~resource_spans:r ())
      ~enc:Trace_service.encode_pb_export_trace_service_request

  let traces_json resource_spans =
    resource_to_json_string resource_spans
      ~ctor:(fun r ->
        Trace_service.make_export_trace_service_request ~resource_spans:r ())
      ~enc:Trace_service.encode_json_export_trace_service_request

  let logs ?encoder ?(protocol = Http_protobuf) resource_logs =
    match protocol with
    | Http_protobuf -> logs_pb ?encoder resource_logs
    | Http_json -> logs_json resource_logs

  let metrics ?encoder ?(protocol = Http_protobuf) resource_metrics =
    match protocol with
    | Http_protobuf -> metrics_pb ?encoder resource_metrics
    | Http_json -> metrics_json resource_metrics

  let traces ?encoder ?(protocol = Http_protobuf) resource_spans =
    match protocol with
    | Http_protobuf -> traces_pb ?encoder resource_spans
    | Http_json -> traces_json resource_spans

  let any ?encoder ?(protocol = Http_protobuf) (r : t) : string =
    match r with
    | Logs l -> logs ?encoder ~protocol l
    | Traces sp -> traces ?encoder ~protocol sp
    | Metrics ms -> metrics ?encoder ~protocol ms
end

module Decode = struct
  let resource_of_string ~dec s = Pbrt.Decoder.of_string s |> dec

  let logs data =
    (resource_of_string ~dec:Logs_service.decode_pb_export_logs_service_request
       data)
      .resource_logs

  let metrics data =
    (resource_of_string
       ~dec:Metrics_service.decode_pb_export_metrics_service_request data)
      .resource_metrics

  let traces data =
    (resource_of_string
       ~dec:Trace_service.decode_pb_export_trace_service_request data)
      .resource_spans
end

module Pp = struct
  let pp_sep fmt () = Format.fprintf fmt ",@."

  let pp_signal pp fmt t =
    Format.fprintf fmt "[@ @[";
    Format.pp_print_list ~pp_sep pp fmt t;
    Format.fprintf fmt "@ ]@]@."

  let logs = pp_signal Proto.Logs.pp_resource_logs

  let metrics = pp_signal Proto.Metrics.pp_resource_metrics

  let traces = pp_signal Proto.Trace.pp_resource_spans

  let pp fmt = function
    | Logs ls -> logs fmt ls
    | Metrics ms -> metrics fmt ms
    | Traces ts -> traces fmt ts
end

let pp = Pp.pp