initial commit

.gitignore

@@ -0,0 +1,7 @@
+_build
+_opam
+*.json
+*.gz
+*.db
+.merlin
+

.gitmodules

@@ -0,0 +1,3 @@
+[submodule "vendor/opentelemetry-proto"]
+	path = vendor/opentelemetry-proto
+	url = https://github.com/open-telemetry/opentelemetry-proto

Makefile

@@ -0,0 +1,14 @@
+
+OPTS=--profile=release
+all:
+	@dune build @all $(OPTS)
+
+test:
+	@dune runtest --force $(OPTS)
+
+clean:
+	@dune clean
+
+WATCH ?= @all
+watch:
+	@dune build $(WATCH) -w $(OPTS)

README.md

@@ -0,0 +1,24 @@
+
+# Opentelemetry
+
+This project provides an API for instrumenting server software
+using [opentelemetry](https://opentelemetry.io/docs), as well as
+connectors to talk to opentelemetry software such as [jaeger](https://www.jaegertracing.io/).
+
+## Use
+
+- [ ] TODO: basic traces
+- [ ] TODO: interface with `logs` (carry context around)
+- [ ] TODO: interface with `lwt`
+
+## License
+
+MIT
+
+## Semantic Conventions
+
+Not supported yet.
+
+- [ ] [metrics](https://opentelemetry.io/docs/reference/specification/metrics/semantic_conventions/)
+- [ ] [traces](https://opentelemetry.io/docs/reference/specification/trace/semantic_conventions/)
+- [ ] [resources](https://opentelemetry.io/docs/reference/specification/resource/semantic_conventions/)

dune

@@ -0,0 +1,3 @@
+
+(env
+  (_ (flags :standard -warn-error -a+8)))

dune-project

@@ -0,0 +1,32 @@
+(lang dune 2.3)
+(name opentelemetry)
+(generate_opam_files true)
+(source
+ (github aestheticintegration/ocaml-opentelemetry))
+
+(authors "the Imandra team")
+(maintainers "the Imandra team")
+(license MIT)
+;(documentation https://url/to/documentation)
+
+(package
+ (name opentelemetry)
+ (synopsis "Instrumentation for https://opentelemetry.io")
+ (depends
+   (ocaml (>= "4.08"))
+   (dune (>= "2.3"))
+   (ocaml-protoc (>= 2.1)))
+ (depopts
+   ptime)
+ (tags
+  (instrumentation tracing opentelemetry datadog jaeger)))
+
+(package
+  (name opentelemetry-client-ocurl)
+  (depends
+   (ocaml (>= "4.08"))
+   (dune (>= "2.3"))
+   (opentelemetry (= :version))
+   (ocaml-protoc (>= 2.1))
+   ocurl)
+  (synopsis "Collector client for opentelemetry, using http + ocurl"))

opentelemetry-client-ocurl.opam

@@ -0,0 +1,32 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "Collector client for opentelemetry, using http + ocurl"
+maintainer: ["the Imandra team"]
+authors: ["the Imandra team"]
+license: "MIT"
+homepage: "https://github.com/aestheticintegration/ocaml-opentelemetry"
+bug-reports:
+  "https://github.com/aestheticintegration/ocaml-opentelemetry/issues"
+depends: [
+  "ocaml" {>= "4.08"}
+  "dune" {>= "2.3"}
+  "opentelemetry" {= version}
+  "ocaml-protoc" {>= "2.1"}
+  "ocurl"
+]
+build: [
+  ["dune" "subst"] {pinned}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo:
+  "git+https://github.com/aestheticintegration/ocaml-opentelemetry.git"

opentelemetry.opam

@@ -0,0 +1,32 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "Instrumentation for https://opentelemetry.io"
+maintainer: ["the Imandra team"]
+authors: ["the Imandra team"]
+license: "MIT"
+tags: ["instrumentation" "tracing" "opentelemetry" "datadog" "jaeger"]
+homepage: "https://github.com/aestheticintegration/ocaml-opentelemetry"
+bug-reports:
+  "https://github.com/aestheticintegration/ocaml-opentelemetry/issues"
+depends: [
+  "ocaml" {>= "4.08"}
+  "dune" {>= "2.3"}
+  "ocaml-protoc" {>= "2.1"}
+]
+depopts: ["ptime"]
+build: [
+  ["dune" "subst"] {pinned}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo:
+  "git+https://github.com/aestheticintegration/ocaml-opentelemetry.git"

src/client/dune

@@ -0,0 +1,6 @@
+
+(library
+  (name opentelemetry_client_ocurl)
+  (public_name opentelemetry-client-ocurl)
+  (libraries opentelemetry curl ocaml-protoc))
+

src/client/opentelemetry_client_ocurl.ml

@@ -0,0 +1,118 @@
+
+(*
+   https://github.com/open-telemetry/oteps/blob/main/text/0035-opentelemetry-protocol.md
+   https://github.com/open-telemetry/oteps/blob/main/text/0099-otlp-http.md
+ *)
+
+(* TODO *)
+
+open Opentelemetry
+
+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 set_url s = url := s
+
+let lock_ : (unit -> unit) ref = ref ignore
+let unlock_ : (unit -> unit) ref = ref ignore
+let set_mutex ~lock ~unlock : unit =
+  lock_ := lock;
+  unlock_ := unlock
+
+let[@inline] with_lock_ f =
+  !lock_();
+  Fun.protect ~finally:!unlock_ f
+
+let _init = lazy (
+  Curl.global_init Curl.CURLINIT_GLOBALALL;
+  at_exit Curl.global_cleanup;
+)
+
+module Backend() : Opentelemetry.Collector.BACKEND = struct
+  let() = Lazy.force _init
+
+  (* TODO: use Curl.Multi, etc. *)
+
+  let encoder = Pbrt.Encoder.create()
+  let buf_res = Buffer.create 256
+
+  (* http client *)
+  let curl : Curl.t = Curl.init ()
+
+  let cleanup () = Curl.cleanup curl
+
+  open Opentelemetry.Collector
+
+  (* send the content to the remote endpoint/path *)
+  let send_ ~path ~decode (bod:string) : ('a, int * Status.status) result =
+    Curl.reset curl;
+    Curl.set_url curl (!url ^ path);
+    Curl.set_httppost curl [];
+    Curl.set_httpheader curl ["content-type: application/x-protobuf"];
+    (* write body *)
+    Curl.set_readfunction curl
+      begin
+        let i = ref 0 in
+        (fun n ->
+           let len = min n (String.length bod - !i) in
+           String.sub bod !i len)
+      end;
+    Buffer.clear buf_res;
+    Curl.set_writefunction curl
+      (fun s -> Buffer.add_string buf_res s; String.length s);
+    match Curl.perform curl with
+    | () ->
+      let code = Curl.get_responsecode curl in
+      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)
+      )
+    | 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)
+
+  let report_err_ code status =
+    Format.eprintf "@[<2>opentelemetry: export failed with@ http code=%d@ status %a@]@."
+      code Status.pp_status status
+
+  let send_trace (tr:Trace_service.export_trace_service_request) : unit =
+    let@() = with_lock_ in
+    Pbrt.Encoder.reset encoder;
+    Trace_service.encode_export_trace_service_request tr encoder;
+    match
+      send_ ~path:"/v1/traces" ~decode:(fun _ -> ())
+        (Pbrt.Encoder.to_string encoder)
+    with
+    | Ok () -> ()
+    | Error (code, status) -> report_err_ code status
+
+  let send_metrics (m:Metrics_service.export_metrics_service_request) : unit =
+    let@() = with_lock_ in
+    Pbrt.Encoder.reset encoder;
+    Metrics_service.encode_export_metrics_service_request m encoder;
+    match
+      send_ ~path:"/v1/metrics" ~decode:(fun _ -> ())
+        (Pbrt.Encoder.to_string encoder);
+    with
+    | Ok () -> ()
+    | Error (code, status) -> report_err_ code status
+end
+
+let setup_ () =
+  let module B = Backend() in
+  Opentelemetry.Collector.backend := Some (module B);
+  B.cleanup
+
+let setup() =
+  let cleanup = setup_() in
+  at_exit cleanup
+
+let with_setup f =
+  let cleanup = setup_() in
+  Fun.protect ~finally:cleanup f

src/client/opentelemetry_client_ocurl.mli

@@ -0,0 +1,16 @@
+
+(*
+   TODO: more options from
+   https://opentelemetry.io/docs/reference/specification/protocol/exporter/
+   *)
+
+val set_url : string -> unit
+(** Url of the endpoint. Default is "http://localhost:4318",
+    or "OTEL_EXPORTER_OTLP_ENDPOINT" if set. *)
+
+val set_mutex : lock:(unit -> unit) -> unlock:(unit -> unit) -> unit
+
+val setup : unit -> unit
+(** Setup endpoint. This modifies {!Opentelemetry.Collector.backend}. *)
+
+val with_setup : (unit -> 'a) -> 'a

src/dune

@@ -0,0 +1,78 @@
+(library
+ (name opentelemetry)
+ (synopsis "API for opentelemetry instrumentation")
+ (flags :standard -warn-error -a+8)
+ (libraries
+   (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 ###
+
+(rule
+  (targets status_types.ml status_types.mli
+           status_pb.ml status_pb.mli
+           status_pp.ml status_pp.mli)
+  (deps (:file status.proto))
+  (action (run ocaml-protoc %{file} -ml_out . -pp -binary)))
+
+(rule
+  (targets common_types.ml common_types.mli
+           common_pb.ml common_pb.mli
+           common_pp.ml common_pp.mli)
+  (deps
+    (:file %{project_root}/vendor/opentelemetry-proto/opentelemetry/proto/common/v1/common.proto))
+  (action (run ocaml-protoc %{file}
+               -I %{project_root}/vendor/opentelemetry-proto/
+               -ml_out . -pp -binary)))
+
+(rule
+  (targets resource_types.ml resource_types.mli
+           resource_pb.ml resource_pb.mli
+           resource_pp.ml resource_pp.mli)
+  (deps
+    (:file %{project_root}/vendor/opentelemetry-proto/opentelemetry/proto/resource/v1/resource.proto))
+  (action (run ocaml-protoc %{file}
+               -I %{project_root}/vendor/opentelemetry-proto/
+               -ml_out . -pp -binary)))
+
+(rule
+  (targets trace_types.ml trace_types.mli
+           trace_pb.ml trace_pb.mli
+           trace_pp.ml trace_pp.mli)
+  (deps
+    (:file %{project_root}/vendor/opentelemetry-proto/opentelemetry/proto/trace/v1/trace.proto))
+  (action (run ocaml-protoc %{file}
+               -I %{project_root}/vendor/opentelemetry-proto/
+               -ml_out . -pp -binary)))
+
+(rule
+  (targets metrics_types.ml metrics_types.mli
+           metrics_pb.ml metrics_pb.mli
+           metrics_pp.ml metrics_pp.mli)
+  (deps
+    (:file %{project_root}/vendor/opentelemetry-proto/opentelemetry/proto/metrics/v1/metrics.proto))
+  (action (run ocaml-protoc %{file}
+               -I %{project_root}/vendor/opentelemetry-proto/
+               -ml_out . -pp -binary)))
+
+(rule
+  (targets metrics_service_types.ml
+           metrics_service_pp.ml metrics_service_pp.mli
+           metrics_service_pb.ml metrics_service_pb.mli)
+  (deps (:file %{project_root}/vendor/opentelemetry-proto/opentelemetry/proto/collector/metrics/v1/metrics_service.proto))
+  (action (run ocaml-protoc %{file}
+               -I %{project_root}/vendor/opentelemetry-proto/
+               -ml_out . -pp -binary)))
+
+(rule
+  (targets trace_service_types.ml
+           trace_service_pp.ml trace_service_pp.mli
+           trace_service_pb.ml trace_service_pb.mli)
+  (deps
+    (:file %{project_root}/vendor/opentelemetry-proto/opentelemetry/proto/collector/trace/v1/trace_service.proto))
+  (action (run ocaml-protoc %{file}
+               -I %{project_root}/vendor/opentelemetry-proto/
+               -ml_out . -pp -binary)))

src/opentelemetry.ml

@@ -0,0 +1,79 @@
+
+(** Traces.
+
+    See {{: https://opentelemetry.io/docs/reference/specification/overview/#tracing-signal} the spec} *)
+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
+
+
+module Resource = struct
+  include Resource_types
+  include Resource_pp
+  include Resource_pb
+end
+
+(*
+module Span = Span
+module Timestamp = Timestamp
+   *)
+
+(** 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
+
+  module Trace_service = struct
+    include Trace_service_types
+    include Trace_service_pb
+    include Trace_service_pp
+  end
+
+  module Metrics_service = struct
+    include Metrics_service_types
+    include Metrics_service_pp
+    include Metrics_service_pb
+  end
+
+  module Status = struct
+    include Status_types
+    include Status_pp
+    include Status_pb
+  end
+
+  (** 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
+
+    val cleanup : unit -> unit
+  end
+
+  type backend = (module BACKEND)
+
+  let backend : backend option ref = ref None
+
+end
+

src/status.proto

@@ -0,0 +1,10 @@
+
+syntax = "proto3";
+
+// from https://pkg.go.dev/google.golang.org/genproto/googleapis/rpc/status?utm_source=godoc#Status
+
+message Status {
+  int32 code = 1;
+  bytes message = 2;
+  repeated bytes details = 3;
+}

src/timestamp.ml

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

src/timestamp.mli

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

src/timestamp_clock.mli

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

src/timestamp_clock.ptime.ml

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

src/timestamp_clock.unix.ml

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

vendor/opentelemetry-proto

@@ -0,0 +1 @@
+Subproject commit cc4ed55c082cb75e084d40b4ddf3805eda099f97