start fleshing out main API, starting with metrics

dune-project

@@ -15,9 +15,8 @@
  (depends
    (ocaml (>= "4.08"))
    (dune (>= "2.3"))
+   ptime
    (ocaml-protoc (>= 2.1)))
- (depopts
-   ptime)
  (tags
   (instrumentation tracing opentelemetry datadog jaeger)))
 

opentelemetry.opam

@@ -11,9 +11,9 @@ bug-reports:
 depends: [
   "ocaml" {>= "4.08"}
   "dune" {>= "2.3"}
+  "ptime"
   "ocaml-protoc" {>= "2.1"}
 ]
-depopts: ["ptime"]
 build: [
   ["dune" "subst"] {pinned}
   [

src/client/opentelemetry_client_ocurl.ml

@@ -12,6 +12,7 @@ let[@inline] (let@) f x = f x
 
 let default_url = "http://localhost:4318"
 let url = ref (try Sys.getenv "OTEL_EXPORTER_OTLP_ENDPOINT" with _ -> default_url)
+let get_url () = !url
 let set_url s = url := s
 
 let lock_ : (unit -> unit) ref = ref ignore
@@ -42,10 +43,16 @@ module Backend() : Opentelemetry.Collector.BACKEND = struct
 
   let cleanup () = Curl.cleanup curl
 
+  open Opentelemetry.Proto
   open Opentelemetry.Collector
 
+  type error = [
+    | `Status of int * Status.status
+    | `Failure of string
+  ]
+
   (* send the content to the remote endpoint/path *)
-  let send_ ~path ~decode (bod:string) : ('a, int * Status.status) result =
+  let send_ ~path ~decode (bod:string) : ('a, error) result =
     Curl.reset curl;
     Curl.set_url curl (!url ^ path);
     Curl.set_httppost curl [];
@@ -61,23 +68,29 @@ module Backend() : Opentelemetry.Collector.BACKEND = struct
     Buffer.clear buf_res;
     Curl.set_writefunction curl
       (fun s -> Buffer.add_string buf_res s; String.length s);
+    try
       match Curl.perform curl with
       | () ->
         let code = Curl.get_responsecode curl in
+        (* TODO: check content-encoding header *)
         let dec = Pbrt.Decoder.of_string (Buffer.contents buf_res) in
         if code >= 200 && code < 300 then (
           let res = decode dec in
           Ok res
         ) else (
           let status = Status.decode_status dec in
-        Error (code, status)
+          Error (`Status (code, status))
         )
       | exception Curl.CurlException (_, code, msg) ->
         let status = Status.default_status
             ~code:(Int32.of_int code) ~message:(Bytes.unsafe_of_string msg) () in
-      Error(code, status)
+        Error(`Status (code, status))
+    with e -> Error (`Failure (Printexc.to_string e))
 
-  let report_err_ code status =
+  let report_err_ = function
+    | `Failure msg ->
+      Format.eprintf "@[<2>opentelemetry: export failed: %s@]@." msg
+    | `Status (code, status) ->
       Format.eprintf "@[<2>opentelemetry: export failed with@ http code=%d@ status %a@]@."
         code Status.pp_status status
 
@@ -90,7 +103,7 @@ module Backend() : Opentelemetry.Collector.BACKEND = struct
         (Pbrt.Encoder.to_string encoder)
     with
     | Ok () -> ()
-    | Error (code, status) -> report_err_ code status
+    | Error err -> report_err_ err
 
   let send_metrics (m:Metrics_service.export_metrics_service_request) : unit =
     let@() = with_lock_ in
@@ -101,7 +114,7 @@ module Backend() : Opentelemetry.Collector.BACKEND = struct
         (Pbrt.Encoder.to_string encoder);
     with
     | Ok () -> ()
-    | Error (code, status) -> report_err_ code status
+    | Error err -> report_err_ err
 end
 
 let setup_ () =

src/client/opentelemetry_client_ocurl.mli

@@ -4,6 +4,8 @@
    https://opentelemetry.io/docs/reference/specification/protocol/exporter/
    *)
 
+val get_url : unit -> string
+
 val set_url : string -> unit
 (** Url of the endpoint. Default is "http://localhost:4318",
     or "OTEL_EXPORTER_OTLP_ENDPOINT" if set. *)

src/dune

@@ -2,11 +2,7 @@
  (name opentelemetry)
  (synopsis "API for opentelemetry instrumentation")
  (flags :standard -warn-error -a+8)
- (libraries
+ (libraries ptime ptime.clock.os ocaml-protoc)
-   (select timestamp_clock.ml from
-           (ptime ptime.clock.os -> timestamp_clock.ptime.ml)
-           (unix -> timestamp_clock.unix.ml))
-   ocaml-protoc)
  (public_name opentelemetry))
 
 ; ### protobuf rules ###

src/opentelemetry.ml

@@ -1,47 +1,29 @@
 
-(** Traces.
+(** Protobuf types *)
-
+module Proto = struct
-    See {{: https://opentelemetry.io/docs/reference/specification/overview/#tracing-signal} the spec} *)
+  module Common = struct
-module Trace = struct
-  include Trace_types
-  include Trace_pp
-  include Trace_pb
-end
-
-(** Metrics.
-
-    See {{: https://opentelemetry.io/docs/reference/specification/overview/#metric-signal} the spec} *)
-module Metrics = struct
-  include Metrics_types
-  include Metrics_pp
-  include Metrics_pb
-end
-
-module Common = struct
     include Common_types
     include Common_pp
     include Common_pb
-end
+  end
 
-
+  module Resource = struct
-module Resource = struct
     include Resource_types
     include Resource_pp
     include Resource_pb
-end
+  end
 
-(*
+  module Trace = struct
-module Span = Span
+    include Trace_types
-module Timestamp = Timestamp
+    include Trace_pp
-   *)
+    include Trace_pb
+  end
 
-(** Collector types
+  module Metrics = struct
-
+    include Metrics_types
-    These types are used by backend implementations, to send events to
+    include Metrics_pp
-    collectors such as Jaeger.
+    include Metrics_pb
-
+  end
-    Note: most users will not need to touch this module *)
-module Collector = struct
 
   module Trace_service = struct
     include Trace_service_types
@@ -60,10 +42,32 @@ module Collector = struct
     include Status_pp
     include Status_pb
   end
+end
+
+(** Utils *)
+module Util = struct
+  let ns_in_a_day = Int64.(mul 1_000_000_000L (of_int (24 * 3600)))
+
+  (** Current unix timestamp in nanoseconds *)
+  let[@inline] now_unix_ns () =
+    let span = Ptime_clock.now() |> Ptime.to_span in
+    let d, ps = Ptime.Span.to_d_ps span in
+    let d = Int64.(mul (of_int d) ns_in_a_day) in
+    let ns = Int64.(div ps 1_000L) in
+    Int64.(add d ns)
+end
+
+(** Collector types
+
+    These types are used by backend implementations, to send events to
+    collectors such as Jaeger.
+
+    Note: most users will not need to touch this module *)
+module Collector = struct
+  open Proto
 
   (** Collector client interface. *)
   module type BACKEND = sig
-
     val send_trace : Trace_service.export_trace_service_request -> unit
 
     val send_metrics : Metrics_service.export_metrics_service_request -> unit
@@ -75,5 +79,96 @@ module Collector = struct
 
   let backend : backend option ref = ref None
 
+  let send_trace (l:Trace.resource_spans list) : unit =
+    match !backend with
+    | None -> ()
+    | Some (module B) ->
+      let ev = Trace_service.default_export_trace_service_request
+          ~resource_spans:l () in
+      B.send_trace ev
+
+  let send_metrics (l:Metrics.resource_metrics list) : unit =
+    match !backend with
+    | None -> ()
+    | Some (module B) ->
+      let ev = Metrics_service.default_export_metrics_service_request
+          ~resource_metrics:l () in
+      B.send_metrics ev
 end
 
+(** Traces.
+
+    See {{: https://opentelemetry.io/docs/reference/specification/overview/#tracing-signal} the spec} *)
+module Trace = struct
+  open Proto.Trace
+end
+
+(** Metrics.
+
+    See {{: https://opentelemetry.io/docs/reference/specification/overview/#metric-signal} the spec} *)
+module Metrics = struct
+  open Metrics_types
+
+  type t = Metrics_types.metric
+
+  (** Number data point, as a float *)
+  let float ?start_time_unix_nano
+      ?(now=Util.now_unix_ns())
+      (d:float) : number_data_point =
+    default_number_data_point ?start_time_unix_nano ~time_unix_nano:now
+      ~value:(As_double d) ()
+
+  (** Number data point, as an int *)
+  let int ?start_time_unix_nano
+      ?(now=Util.now_unix_ns())
+      (i:int) : number_data_point =
+    default_number_data_point ?start_time_unix_nano ~time_unix_nano:now
+      ~value:(As_int (Int64.of_int i)) ()
+
+  (** Aggregation of a scalar metric, always with the current value *)
+  let gauge ~name ?description ?unit_ (l:number_data_point list) : t =
+    let data = Gauge (default_gauge ~data_points:l ()) in
+    default_metric ~name ?description ?unit_ ~data ()
+
+  type aggregation_temporality = Metrics_types.aggregation_temporality =
+    | Aggregation_temporality_unspecified
+    | Aggregation_temporality_delta
+    | Aggregation_temporality_cumulative
+
+  (** Sum of all reported measurements over a time interval *)
+  let sum ~name ?description ?unit_
+      ?aggregation_temporality ?is_monotonic
+      (l:number_data_point list) : t =
+    let data =
+      Sum (default_sum ~data_points:l ?is_monotonic
+             ?aggregation_temporality ()) in
+    default_metric ~name ?description ?unit_ ~data ()
+
+  (* TODO
+  let histogram ~name ?description ?unit_
+      ?aggregation_temporality
+      (l:number_data_point list) : t =
+    let data h=
+      Histogram (default_histogram ~data_points:l
+             ?aggregation_temporality ()) in
+    default_metric ~name ?description ?unit_ ~data ()
+     *)
+
+  (* TODO: exponential history *)
+  (* TODO: summary *)
+  (* TODO: exemplar *)
+
+  (** Emit a bunch of metrics to the collector. *)
+  let emit (l:t list) : unit =
+    let lm =
+      default_instrumentation_library_metrics ~metrics:l () in
+    let rm = default_resource_metrics
+        ~instrumentation_library_metrics:[lm] () in
+    Collector.send_metrics [rm]
+end
+
+(*
+module Span = Span
+module Timestamp = Timestamp
+   *)
+

src/timestamp.ml

@@ -1,4 +0,0 @@
-
-type t = float (* UTC *)
-
-let now = Timestamp_clock.now

src/timestamp.mli

@@ -1,5 +0,0 @@
-
-type t
-
-val now : unit -> t
-

src/timestamp_clock.mli

@@ -1,3 +0,0 @@
-
-val now : unit -> float
-(** unix time in seconds, GMT *)

src/timestamp_clock.ptime.ml

@@ -1 +0,0 @@
-let now () = Ptime_clock.now () |> Ptime.to_float_s

src/timestamp_clock.unix.ml

@@ -1,2 +0,0 @@
-
-let now () = Unix.gettimeofday()