├── .github ├── CODEOWNERS └── workflows │ ├── gh-pages.yml │ └── main.yml ├── .gitignore ├── .gitmodules ├── .ocamlformat ├── .ocamlformat-ignore ├── CHANGES.md ├── Makefile ├── README.md ├── dune ├── dune-project ├── emit1.sh ├── opentelemetry-client-cohttp-lwt.opam ├── opentelemetry-client-ocurl.opam ├── opentelemetry-cohttp-lwt.opam ├── opentelemetry-lwt.opam ├── opentelemetry.opam ├── src ├── ambient-context │ ├── dune │ ├── eio │ │ ├── dune │ │ ├── opentelemetry_ambient_context_eio.ml │ │ └── opentelemetry_ambient_context_eio.mli │ ├── hmap_key_.new.ml │ ├── lwt │ │ ├── dune │ │ ├── opentelemetry_ambient_context_lwt.ml │ │ └── opentelemetry_ambient_context_lwt.mli │ ├── opentelemetry_ambient_context.ml │ ├── opentelemetry_ambient_context.mli │ └── types │ │ ├── dune │ │ ├── opentelemetry_ambient_context_types.ml │ │ └── opentelemetry_ambient_context_types.mli ├── atomic │ ├── atomic.post412.mli │ ├── atomic.pre412.mli │ ├── dune │ └── gen.ml ├── client-cohttp-lwt │ ├── common_.ml │ ├── config.ml │ ├── config.mli │ ├── dune │ ├── opentelemetry_client_cohttp_lwt.ml │ └── opentelemetry_client_cohttp_lwt.mli ├── client-ocurl │ ├── b_queue.ml │ ├── b_queue.mli │ ├── batch.ml │ ├── batch.mli │ ├── common_.ml │ ├── config.ml │ ├── config.mli │ ├── dune │ ├── opentelemetry_client_ocurl.ml │ └── opentelemetry_client_ocurl.mli ├── core │ ├── AList.ml │ ├── AList.mli │ ├── dune │ ├── lock.ml │ ├── lock.mli │ ├── opentelemetry.ml │ ├── rand_bytes.ml │ └── rand_bytes.mli ├── integrations │ └── cohttp │ │ ├── README.md │ │ ├── dune │ │ └── opentelemetry_cohttp_lwt.ml ├── lwt │ ├── dune │ └── opentelemetry_lwt.ml ├── proto │ ├── .ocamlformat-ignore │ ├── common.ml │ ├── common.mli │ ├── dune │ ├── logs.ml │ ├── logs.mli │ ├── logs_service.ml │ ├── logs_service.mli │ ├── metrics.ml │ ├── metrics.mli │ ├── metrics_service.ml │ ├── metrics_service.mli │ ├── resource.ml │ ├── resource.mli │ ├── status.ml │ ├── status.mli │ ├── status.proto │ ├── trace.ml │ ├── trace.mli │ ├── trace_service.ml │ └── trace_service.mli └── trace │ ├── dune │ ├── opentelemetry_trace.ml │ └── opentelemetry_trace.mli ├── tests ├── bin │ ├── cohttp_client.ml │ ├── dune │ ├── emit1.ml │ └── emit1_cohttp.ml ├── cohttp │ ├── dune │ ├── test_urls.expected │ └── test_urls.ml ├── core │ ├── dune │ ├── test_trace_context.expected │ └── test_trace_context.ml ├── implicit_scope │ └── sync │ │ ├── dune │ │ └── test_implicit_scope_sync.ml └── ocurl │ ├── dune │ ├── test_urls.expected │ └── test_urls.ml └── vendor └── dune /.github/CODEOWNERS: -------------------------------------------------------------------------------- 1 | * @c-cube @mattjbray 2 | 3 | -------------------------------------------------------------------------------- /.github/workflows/gh-pages.yml: -------------------------------------------------------------------------------- 1 | name: github pages 2 | 3 | on: 4 | push: 5 | branches: 6 | - main 7 | 8 | jobs: 9 | deploy: 10 | runs-on: ubuntu-latest 11 | steps: 12 | - uses: actions/checkout@main 13 | 14 | # needed for depext to work 15 | - run: sudo apt-get update && sudo apt-get install mccs 16 | 17 | - uses: ocaml/setup-ocaml@v3 18 | with: 19 | ocaml-compiler: '5.1.x' 20 | dune-cache: true 21 | allow-prerelease-opam: true 22 | 23 | - name: Deps 24 | run: opam install odig opentelemetry opentelemetry-lwt opentelemetry-client-ocurl opentelemetry-cohttp-lwt 25 | 26 | - name: Build 27 | run: opam exec -- odig odoc --cache-dir=_doc/ opentelemetry opentelemetry-lwt opentelemetry-client-ocurl opentelemetry-cohttp-lwt 28 | 29 | - name: Deploy 30 | uses: peaceiris/actions-gh-pages@v3 31 | with: 32 | github_token: ${{ secrets.GITHUB_TOKEN }} 33 | publish_dir: ./_doc/html 34 | enable_jekyll: false 35 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: build 2 | 3 | on: 4 | pull_request: 5 | push: 6 | branches: 7 | - main 8 | 9 | jobs: 10 | build: 11 | strategy: 12 | fail-fast: true 13 | matrix: 14 | os: 15 | - ubuntu-latest 16 | #- windows-latest 17 | #- macos-latest 18 | ocaml-compiler: 19 | - 4.08.x 20 | - 4.13.x 21 | - 5.0.x 22 | - 5.3.x 23 | 24 | runs-on: ${{ matrix.os }} 25 | 26 | steps: 27 | - name: Checkout code 28 | uses: actions/checkout@v4 29 | with: 30 | submodules: recursive 31 | 32 | # needed for depext to work 33 | - run: sudo apt-get update && sudo apt-get install mccs 34 | if: ${{ matrix.os == 'ubuntu-latest' }} 35 | 36 | - name: Use OCaml ${{ matrix.ocaml-compiler }} 37 | uses: ocaml/setup-ocaml@v3 38 | with: 39 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 40 | opam-depext-flags: --with-test 41 | dune-cache: true 42 | allow-prerelease-opam: true 43 | 44 | - run: | 45 | opam pin ocaml-protoc 3.0.1 -y -n 46 | opam pin pbrt 3.0.1 -y -n 47 | opam install pbrt -y 48 | 49 | - run: opam install . --deps-only --with-test --solver=mccs 50 | 51 | - run: opam exec -- dune build @install -p opentelemetry,opentelemetry-lwt,opentelemetry-client-ocurl,opentelemetry-cohttp-lwt,opentelemetry-client-cohttp-lwt 52 | 53 | - run: opam pin trace --dev -y -n 54 | - run: opam install trace 55 | - run: opam exec -- dune build @install -p opentelemetry 56 | 57 | - run: opam install ocaml-protoc 58 | - run: opam exec -- dune build @lint 59 | 60 | # check that nothing changed 61 | - run: git diff --exit-code 62 | 63 | - run: opam exec -- dune build @runtest 64 | if: ${{ matrix.os == 'ubuntu-latest' }} 65 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | _opam 3 | *.json 4 | *.gz 5 | *.db 6 | .merlin 7 | *.install 8 | *.exe 9 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "vendor/opentelemetry-proto"] 2 | url = https://github.com/open-telemetry/opentelemetry-proto 3 | path = vendor/opentelemetry-proto 4 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | version = 0.27.0 2 | profile=conventional 3 | margin=80 4 | if-then-else=k-r 5 | parens-ite=true 6 | parens-tuple=multi-line-only 7 | sequence-style=terminator 8 | type-decl=sparse 9 | break-cases=toplevel 10 | cases-exp-indent=2 11 | field-space=tight-decl 12 | leading-nested-match-parens=true 13 | module-item-spacing=sparse 14 | quiet=true 15 | -------------------------------------------------------------------------------- /.ocamlformat-ignore: -------------------------------------------------------------------------------- 1 | src/*_pb.ml 2 | src/*_pb.mli 3 | src/*_types.ml 4 | src/*_types.mli 5 | src/*_pp.ml 6 | src/*_pp.mli 7 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | 2 | ## 0.11.2 3 | 4 | - fix: opentelemetry-client-ocurl: don't block signals on Windows 5 | - fix otel-client-ocurl: use ptime timestamps for self metrics 6 | 7 | ## 0.11.1 8 | 9 | - add missing sample argument to `Traceparent.to_value` 10 | 11 | ## 0.11 12 | 13 | - add `Span_kind.t`, add {kind,set_kind} to `Scope` 14 | - expose `Span_status` types 15 | - add `Scope.set_span_status` 16 | - add `record_exception` 17 | - otel.trace: extension points for links, record_exn, kind 18 | - otel.trace: set status of a span based on `exception.message` 19 | 20 | - add cohttp upper bound version constraint 21 | - in backends, call `tick()` before cleaning up 22 | - reduce memory usage of `Scope.t` (@tatchi) 23 | 24 | - remove dependency on ambient-context, vendor/inline/specialize it 25 | 26 | ## 0.10 27 | 28 | - feat: add support for per-signal urls (by @tatchi) 29 | - build: disable protobuf regeneration during normal library use 30 | - fix: emit GC metrics even in the absence of custom metrics 31 | 32 | ## 0.9 33 | 34 | - compat with trace 0.7 35 | 36 | ## 0.8 37 | 38 | - feat: add dep on `hmap`, add standard keys to carry around a span context or trace id 39 | - add semantic conventions for code and HTTP 40 | 41 | - better debug message in curl backend 42 | - make otel-trace a bit more lightweight 43 | 44 | ## 0.7 45 | 46 | - add Span_link.of_span_ctx, Scope.to_span_ctx, dummy values 47 | - feat: add Span_context, as required by OTEL API guidelines 48 | - feat: record backtraces in error spans 49 | - compat with trace 0.6 50 | - ocurl: add ticker_interval_ms config 51 | - ocurl: do some self-tracing optionally 52 | - move protobuf code to opentelemetry.proto 53 | 54 | - perf: rewrite parsing+printing for span ctx as w3c trace ctx 55 | - perf: when we get multiple messages, check batches only once 56 | - perf: use ocaml-protoc 3.0.1 for codegen, with faster pbrt 57 | 58 | ## 0.6 59 | 60 | - fix ticker thread shutdown 61 | - migrated to OTEL proto files v1.0 62 | - replace `Thread_local` with `ocaml-ambient-context`, allowing for implicit scope in Lwt/Eio contexts (#34) 63 | - update `ocaml-trace` interface to use the new `trace.0.3`-style API (breaking, see #34) 64 | 65 | ## 0.5 66 | 67 | - new implementation for ocurl backend, using ezcurl and queues 68 | - refactor lwt: Use `try%lwt` over `Lwt.catch` 69 | - add `opentelemetry.trace` (optional, depends on `ocaml-trace`) 70 | 71 | ## 0.4 72 | 73 | - expose `Scope.get_surrounding` 74 | - rehault of GC metrics 75 | - `Trace.with_` now has `force_new_trace_id` param 76 | - use thread-local storage to store global scope 77 | - add `Span_link` module 78 | - add a `Globals.default_span_kind` ref to specify default span kind 79 | 80 | - fix(otel-lwt): missing modules now re-exported 81 | - fix(client-ocurl): fix `tick` version used in the absence of bg thread 82 | 83 | - drop dep on ocaml-protoc as the generated code is checked-in 84 | - update vendored otel to 0.19 85 | 86 | ## 0.3 87 | 88 | - improve error reporting from ocurl exporter 89 | - improve GC sample collection 90 | - feat(ocurl): simpler, cleaner backend implementation, with graceful exit 91 | - config: make `Config.t` private (breaking) 92 | 93 | ## 0.2 94 | 95 | - require pbrt only, use ocaml-protoc as a lint 96 | - add `Metrics_callbacks` module 97 | - add histogram metrics (untested) 98 | - basic support for logs 99 | - expose `tick` function (useful in the absence of a background thread) 100 | - debug the library is set via `OTEL_OCAML_DEBUG` 101 | - provide conventions for standard metrics 102 | - add runtime attrs to GC stats 103 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | OPTS=--profile=release --ignore-promoted-rules 3 | 4 | all: 5 | @dune build @all $(OPTS) 6 | 7 | test: 8 | @dune runtest --force $(OPTS) 9 | 10 | clean: 11 | @dune clean 12 | 13 | protoc-gen: 14 | FORCE_GENPROTO=true @dune build @lint 15 | 16 | format: 17 | @dune build @fmt --auto-promote 18 | 19 | WATCH ?= @all 20 | watch: 21 | @dune build $(WATCH) -w $(OPTS) 22 | 23 | VERSION=$(shell awk '/^version:/ {print $$2}' opentelemetry.opam) 24 | update_next_tag: 25 | @echo "update version to $(VERSION)..." 26 | sed -i "s/NEXT_VERSION/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli) 27 | sed -i "s/NEXT_RELEASE/$(VERSION)/g" $(wildcard src/*.ml) $(wildcard src/**/*.ml) $(wildcard src/*.mli) $(wildcard src/**/*.mli) 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | # Opentelemetry [![build](https://github.com/imandra-ai/ocaml-opentelemetry/actions/workflows/main.yml/badge.svg)](https://github.com/imandra-ai/ocaml-opentelemetry/actions/workflows/main.yml) 3 | 4 | This project provides an API for instrumenting server software 5 | using [opentelemetry](https://opentelemetry.io/docs), as well as 6 | connectors to talk to opentelemetry software such as [jaeger](https://www.jaegertracing.io/). 7 | 8 | - library `opentelemetry` should be used to instrument your code 9 | and possibly libraries. It doesn't communicate with anything except 10 | a backend (default: dummy backend); 11 | - library `opentelemetry-client-ocurl` is a backend that communicates 12 | via http+protobuf with some collector (otelcol, datadog-agent, etc.) using cURL bindings; 13 | - library `opentelemetry-client-cohttp-lwt` is a backend that communicates 14 | via http+protobuf with some collector using cohttp. 15 | 16 | ## License 17 | 18 | MIT 19 | 20 | ## Features 21 | 22 | - [x] basic traces 23 | - [x] basic metrics 24 | - [x] basic logs 25 | - [ ] nice API 26 | - [x] interface with `lwt` 27 | - [x] sync collector relying on ocurl 28 | * [x] batching, perf, etc. 29 | - [ ] async collector relying on ocurl-multi 30 | - [ ] interface with `logs` (carry context around) 31 | - [x] implicit scope (via vendored `ambient-context`, see `opentelemetry.ambient-context`) 32 | 33 | ## Use 34 | 35 | For now, instrument traces/spans, logs, and metrics manually: 36 | 37 | ```ocaml 38 | module Otel = Opentelemetry 39 | let (let@) = (@@) 40 | 41 | let foo () = 42 | let@ scope = Otel.Trace.with_ "foo" 43 | ~attrs:["hello", `String "world"] in 44 | do_work(); 45 | Otel.Metrics.( 46 | emit [ 47 | gauge ~name:"foo.x" [int 42]; 48 | ]); 49 | do_more_work(); 50 | () 51 | ``` 52 | 53 | ### Setup 54 | 55 | If you're writing a top-level application, you need to perform some initial configuration. 56 | 57 | 1. Set the [`service_name`][]; 58 | 2. optionally configure [ambient-context][] with the appropriate storage for your environment — TLS, Lwt, Eio…; 59 | 3. and install a [`Collector`][] (usually by calling your collector's `with_setup` function.) 60 | 61 | For example, if your application is using Lwt, and you're using `ocurl` as your collector, you might do something like this: 62 | 63 | ```ocaml 64 | let main () = 65 | Otel.Globals.service_name := "my_service"; 66 | Otel.GC_metrics.basic_setup(); 67 | 68 | Opentelemetry_ambient_context.set_storage_provider (Opentelemetry_ambient_context_lwt.storage ()); 69 | Opentelemetry_client_ocurl.with_setup () @@ fun () -> 70 | (* … *) 71 | foo (); 72 | (* … *) 73 | ``` 74 | 75 | [`service_name`]: 76 | [`Collector`]: 77 | [ambient-context]: now vendored as `opentelemetry.ambient-context`, formerly 78 | 79 | ## Configuration 80 | 81 | The library is configurable via `Opentelemetry.Config`, via the standard 82 | opentelemetry env variables, or with some custom environment variables. 83 | 84 | - `OTEL_EXPORTER_OTLP_ENDPOINT` sets the http endpoint to send signals to 85 | - `OTEL_OCAML_DEBUG=1` to print some debug messages from the opentelemetry library ide 86 | - `OTEL_RESOURCE_ATTRIBUTES` sets a comma separated list of custom resource attributes 87 | 88 | ## Collector opentelemetry-client-ocurl 89 | 90 | This is a synchronous collector that uses the http+protobuf format 91 | to send signals (metrics, traces, logs) to some other collector (eg. `otelcol` 92 | or the datadog agent). 93 | 94 | Do note that this backend uses a thread pool and is incompatible 95 | with uses of `fork` on some Unixy systems. 96 | See [#68](https://github.com/imandra-ai/ocaml-opentelemetry/issues/68) for a possible workaround. 97 | 98 | ## Collector opentelemetry-client-cohttp-lwt 99 | 100 | This is a Lwt-friendly collector that uses cohttp to send 101 | signals to some other collector (e.g. `otelcol`). It must be run 102 | inside a `Lwt_main.run` scope. 103 | 104 | ## Opentelemetry-trace 105 | 106 | The optional library `opentelemetry.trace`, present if [trace](https://github.com/c-cube/trace) is 107 | installed, provides a collector for `trace`. This collector forwards and translates 108 | events from `trace` into `opentelemetry`. It's only useful if there also is also a OTEL collector. 109 | 110 | ## License 111 | 112 | MIT 113 | 114 | ## Semantic Conventions 115 | 116 | Not supported yet. 117 | 118 | - [ ] [metrics](https://opentelemetry.io/docs/reference/specification/metrics/semantic_conventions/) 119 | - [ ] [traces](https://opentelemetry.io/docs/reference/specification/trace/semantic_conventions/) 120 | - [ ] [resources](https://opentelemetry.io/docs/reference/specification/resource/semantic_conventions/) 121 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (env 2 | (_ 3 | (flags 4 | :standard 5 | -warn-error 6 | -a+8 7 | -w 8 | +a-4-30-40-41-42-44-48-70 9 | -strict-sequence))) 10 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.9) 2 | 3 | (name opentelemetry) 4 | 5 | (generate_opam_files true) 6 | 7 | (source 8 | (github imandra-ai/ocaml-opentelemetry)) 9 | 10 | (version 0.11.2) 11 | 12 | (authors "the Imandra team and contributors") 13 | 14 | (maintainers 15 | "Simon Cruanes " 16 | "Matt Bray " 17 | "ELLIOTTCABLE ") 18 | 19 | (license MIT) 20 | 21 | ;(documentation https://url/to/documentation) 22 | 23 | (package 24 | (name opentelemetry) 25 | (synopsis "Instrumentation for https://opentelemetry.io") 26 | (depends 27 | (ocaml 28 | (>= "4.08")) 29 | ptime 30 | hmap 31 | atomic 32 | (thread-local-storage 33 | (and 34 | (>= 0.2) 35 | (< 0.3))) 36 | (odoc :with-doc) 37 | (alcotest :with-test) 38 | (pbrt 39 | (and 40 | (>= 3.0) 41 | (< 4.0))) 42 | (ocaml-lsp-server :with-dev-setup) 43 | (ocamlformat 44 | (and 45 | :with-dev-setup 46 | (>= 0.27) 47 | (< 0.28)))) 48 | (depopts trace lwt eio) 49 | (conflicts 50 | (trace 51 | (< 0.10))) 52 | (tags 53 | (instrumentation tracing opentelemetry datadog jaeger))) 54 | 55 | (package 56 | (name opentelemetry-lwt) 57 | (synopsis "Lwt-compatible instrumentation for https://opentelemetry.io") 58 | (depends 59 | (ocaml 60 | (>= "4.08")) 61 | (opentelemetry 62 | (= :version)) 63 | (cohttp-lwt-unix :with-test) 64 | (odoc :with-doc) 65 | (lwt 66 | (>= "5.3")) 67 | (lwt_ppx 68 | (>= "2.0")) 69 | (alcotest :with-test)) 70 | (tags 71 | (instrumentation tracing opentelemetry datadog lwt))) 72 | 73 | (package 74 | (name opentelemetry-client-ocurl) 75 | (depends 76 | (ocaml 77 | (>= "4.08")) 78 | (mtime 79 | (>= "1.4")) 80 | ; for spans 81 | ; atomic ; vendored 82 | (opentelemetry 83 | (= :version)) 84 | (odoc :with-doc) 85 | (ezcurl 86 | (>= 0.2.3)) 87 | ocurl 88 | (alcotest :with-test)) 89 | (synopsis "Collector client for opentelemetry, using http + ezcurl")) 90 | 91 | (package 92 | (name opentelemetry-cohttp-lwt) 93 | (depends 94 | (ocaml 95 | (>= "4.08")) 96 | (opentelemetry 97 | (= :version)) 98 | (opentelemetry-lwt 99 | (= :version)) 100 | (odoc :with-doc) 101 | (lwt 102 | (>= "5.3")) 103 | (cohttp-lwt 104 | (>= "6.0.0")) 105 | (alcotest :with-test)) 106 | (synopsis "Opentelemetry tracing for Cohttp HTTP servers")) 107 | 108 | (package 109 | (name opentelemetry-client-cohttp-lwt) 110 | (depends 111 | (ocaml 112 | (>= "4.08")) 113 | (mtime 114 | (>= "1.4")) 115 | ; for spans 116 | (opentelemetry 117 | (= :version)) 118 | (odoc :with-doc) 119 | (lwt 120 | (>= "5.3")) 121 | (lwt_ppx 122 | (>= "2.0")) 123 | cohttp-lwt 124 | cohttp-lwt-unix 125 | (alcotest :with-test)) 126 | (synopsis "Collector client for opentelemetry, using cohttp + lwt")) 127 | -------------------------------------------------------------------------------- /emit1.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | exec dune exec --profile=release tests/bin/emit1.exe -- $@ 3 | -------------------------------------------------------------------------------- /opentelemetry-client-cohttp-lwt.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "0.11.2" 4 | synopsis: "Collector client for opentelemetry, using cohttp + lwt" 5 | maintainer: [ 6 | "Simon Cruanes " 7 | "Matt Bray " 8 | "ELLIOTTCABLE " 9 | ] 10 | authors: ["the Imandra team and contributors"] 11 | license: "MIT" 12 | homepage: "https://github.com/imandra-ai/ocaml-opentelemetry" 13 | bug-reports: "https://github.com/imandra-ai/ocaml-opentelemetry/issues" 14 | depends: [ 15 | "dune" {>= "2.9"} 16 | "ocaml" {>= "4.08"} 17 | "mtime" {>= "1.4"} 18 | "opentelemetry" {= version} 19 | "odoc" {with-doc} 20 | "lwt" {>= "5.3"} 21 | "lwt_ppx" {>= "2.0"} 22 | "cohttp-lwt" 23 | "cohttp-lwt-unix" 24 | "alcotest" {with-test} 25 | ] 26 | build: [ 27 | ["dune" "subst"] {dev} 28 | [ 29 | "dune" 30 | "build" 31 | "-p" 32 | name 33 | "-j" 34 | jobs 35 | "--promote-install-files=false" 36 | "@install" 37 | "@runtest" {with-test} 38 | "@doc" {with-doc} 39 | ] 40 | ["dune" "install" "-p" name "--create-install-files" name] 41 | ] 42 | dev-repo: "git+https://github.com/imandra-ai/ocaml-opentelemetry.git" 43 | -------------------------------------------------------------------------------- /opentelemetry-client-ocurl.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "0.11.2" 4 | synopsis: "Collector client for opentelemetry, using http + ezcurl" 5 | maintainer: [ 6 | "Simon Cruanes " 7 | "Matt Bray " 8 | "ELLIOTTCABLE " 9 | ] 10 | authors: ["the Imandra team and contributors"] 11 | license: "MIT" 12 | homepage: "https://github.com/imandra-ai/ocaml-opentelemetry" 13 | bug-reports: "https://github.com/imandra-ai/ocaml-opentelemetry/issues" 14 | depends: [ 15 | "dune" {>= "2.9"} 16 | "ocaml" {>= "4.08"} 17 | "mtime" {>= "1.4"} 18 | "opentelemetry" {= version} 19 | "odoc" {with-doc} 20 | "ezcurl" {>= "0.2.3"} 21 | "ocurl" 22 | "alcotest" {with-test} 23 | ] 24 | build: [ 25 | ["dune" "subst"] {dev} 26 | [ 27 | "dune" 28 | "build" 29 | "-p" 30 | name 31 | "-j" 32 | jobs 33 | "--promote-install-files=false" 34 | "@install" 35 | "@runtest" {with-test} 36 | "@doc" {with-doc} 37 | ] 38 | ["dune" "install" "-p" name "--create-install-files" name] 39 | ] 40 | dev-repo: "git+https://github.com/imandra-ai/ocaml-opentelemetry.git" 41 | -------------------------------------------------------------------------------- /opentelemetry-cohttp-lwt.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "0.11.2" 4 | synopsis: "Opentelemetry tracing for Cohttp HTTP servers" 5 | maintainer: [ 6 | "Simon Cruanes " 7 | "Matt Bray " 8 | "ELLIOTTCABLE " 9 | ] 10 | authors: ["the Imandra team and contributors"] 11 | license: "MIT" 12 | homepage: "https://github.com/imandra-ai/ocaml-opentelemetry" 13 | bug-reports: "https://github.com/imandra-ai/ocaml-opentelemetry/issues" 14 | depends: [ 15 | "dune" {>= "2.9"} 16 | "ocaml" {>= "4.08"} 17 | "opentelemetry" {= version} 18 | "opentelemetry-lwt" {= version} 19 | "odoc" {with-doc} 20 | "lwt" {>= "5.3"} 21 | "cohttp-lwt" {>= "6.0.0"} 22 | "alcotest" {with-test} 23 | ] 24 | build: [ 25 | ["dune" "subst"] {dev} 26 | [ 27 | "dune" 28 | "build" 29 | "-p" 30 | name 31 | "-j" 32 | jobs 33 | "--promote-install-files=false" 34 | "@install" 35 | "@runtest" {with-test} 36 | "@doc" {with-doc} 37 | ] 38 | ["dune" "install" "-p" name "--create-install-files" name] 39 | ] 40 | dev-repo: "git+https://github.com/imandra-ai/ocaml-opentelemetry.git" 41 | -------------------------------------------------------------------------------- /opentelemetry-lwt.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "0.11.2" 4 | synopsis: "Lwt-compatible instrumentation for https://opentelemetry.io" 5 | maintainer: [ 6 | "Simon Cruanes " 7 | "Matt Bray " 8 | "ELLIOTTCABLE " 9 | ] 10 | authors: ["the Imandra team and contributors"] 11 | license: "MIT" 12 | tags: ["instrumentation" "tracing" "opentelemetry" "datadog" "lwt"] 13 | homepage: "https://github.com/imandra-ai/ocaml-opentelemetry" 14 | bug-reports: "https://github.com/imandra-ai/ocaml-opentelemetry/issues" 15 | depends: [ 16 | "dune" {>= "2.9"} 17 | "ocaml" {>= "4.08"} 18 | "opentelemetry" {= version} 19 | "cohttp-lwt-unix" {with-test} 20 | "odoc" {with-doc} 21 | "lwt" {>= "5.3"} 22 | "lwt_ppx" {>= "2.0"} 23 | "alcotest" {with-test} 24 | ] 25 | build: [ 26 | ["dune" "subst"] {dev} 27 | [ 28 | "dune" 29 | "build" 30 | "-p" 31 | name 32 | "-j" 33 | jobs 34 | "--promote-install-files=false" 35 | "@install" 36 | "@runtest" {with-test} 37 | "@doc" {with-doc} 38 | ] 39 | ["dune" "install" "-p" name "--create-install-files" name] 40 | ] 41 | dev-repo: "git+https://github.com/imandra-ai/ocaml-opentelemetry.git" 42 | -------------------------------------------------------------------------------- /opentelemetry.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | version: "0.11.2" 4 | synopsis: "Instrumentation for https://opentelemetry.io" 5 | maintainer: [ 6 | "Simon Cruanes " 7 | "Matt Bray " 8 | "ELLIOTTCABLE " 9 | ] 10 | authors: ["the Imandra team and contributors"] 11 | license: "MIT" 12 | tags: ["instrumentation" "tracing" "opentelemetry" "datadog" "jaeger"] 13 | homepage: "https://github.com/imandra-ai/ocaml-opentelemetry" 14 | bug-reports: "https://github.com/imandra-ai/ocaml-opentelemetry/issues" 15 | depends: [ 16 | "dune" {>= "2.9"} 17 | "ocaml" {>= "4.08"} 18 | "ptime" 19 | "hmap" 20 | "atomic" 21 | "thread-local-storage" {>= "0.2" & < "0.3"} 22 | "odoc" {with-doc} 23 | "alcotest" {with-test} 24 | "pbrt" {>= "3.0" & < "4.0"} 25 | "ocaml-lsp-server" {with-dev-setup} 26 | "ocamlformat" {with-dev-setup & >= "0.27" & < "0.28"} 27 | ] 28 | depopts: ["trace" "lwt" "eio"] 29 | conflicts: [ 30 | "trace" {< "0.10"} 31 | ] 32 | build: [ 33 | ["dune" "subst"] {dev} 34 | [ 35 | "dune" 36 | "build" 37 | "-p" 38 | name 39 | "-j" 40 | jobs 41 | "--promote-install-files=false" 42 | "@install" 43 | "@runtest" {with-test} 44 | "@doc" {with-doc} 45 | ] 46 | ["dune" "install" "-p" name "--create-install-files" name] 47 | ] 48 | dev-repo: "git+https://github.com/imandra-ai/ocaml-opentelemetry.git" 49 | -------------------------------------------------------------------------------- /src/ambient-context/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name opentelemetry_ambient_context) 3 | (public_name opentelemetry.ambient-context) 4 | (synopsis 5 | "Abstraction over thread-local storage and fiber-local storage mechanisms") 6 | (private_modules hmap_key_) 7 | (libraries 8 | thread-local-storage 9 | threads 10 | atomic 11 | opentelemetry.ambient-context.types 12 | (select 13 | hmap_key_.ml 14 | from 15 | (-> hmap_key_.new.ml)))) 16 | -------------------------------------------------------------------------------- /src/ambient-context/eio/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name opentelemetry_ambient_context_eio) 3 | (public_name opentelemetry.ambient-context.eio) 4 | (synopsis 5 | "Storage backend for ambient-context using Eio's fibre-local storage") 6 | (optional) ; eio 7 | (libraries eio hmap opentelemetry.ambient-context thread-local-storage)) 8 | -------------------------------------------------------------------------------- /src/ambient-context/eio/opentelemetry_ambient_context_eio.ml: -------------------------------------------------------------------------------- 1 | module TLS = Thread_local_storage 2 | module Fiber = Eio.Fiber 3 | 4 | open struct 5 | let _internal_key : Hmap.t Fiber.key = Fiber.create_key () 6 | 7 | let ( let* ) = Option.bind 8 | end 9 | 10 | module M = struct 11 | let name = "Storage_eio" 12 | 13 | let[@inline] get_map () = Fiber.get _internal_key 14 | 15 | let[@inline] with_map m cb = Fiber.with_binding _internal_key m cb 16 | 17 | let create_key = Hmap.Key.create 18 | 19 | let get k = 20 | let* context = get_map () in 21 | Hmap.find k context 22 | 23 | let with_binding k v cb = 24 | let new_context = 25 | match get_map () with 26 | | None -> Hmap.singleton k v 27 | | Some old_context -> Hmap.add k v old_context 28 | in 29 | with_map new_context cb 30 | 31 | let without_binding k cb = 32 | let new_context = 33 | match get_map () with 34 | | None -> Hmap.empty 35 | | Some old_context -> Hmap.rem k old_context 36 | in 37 | with_map new_context cb 38 | end 39 | 40 | let storage () : Opentelemetry_ambient_context.storage = (module M) 41 | -------------------------------------------------------------------------------- /src/ambient-context/eio/opentelemetry_ambient_context_eio.mli: -------------------------------------------------------------------------------- 1 | val storage : unit -> Opentelemetry_ambient_context.storage 2 | (** Storage using Eio's fibers local storage *) 3 | -------------------------------------------------------------------------------- /src/ambient-context/hmap_key_.new.ml: -------------------------------------------------------------------------------- 1 | let key : Hmap.t Thread_local_storage.t = Thread_local_storage.create () 2 | -------------------------------------------------------------------------------- /src/ambient-context/lwt/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name opentelemetry_ambient_context_lwt) 3 | (public_name opentelemetry.ambient-context.lwt) 4 | (optional) ; lwt 5 | (synopsis 6 | "Storage backend for ambient-context using Lwt's sequence-associated storage") 7 | (libraries lwt opentelemetry.ambient-context thread-local-storage)) 8 | -------------------------------------------------------------------------------- /src/ambient-context/lwt/opentelemetry_ambient_context_lwt.ml: -------------------------------------------------------------------------------- 1 | open struct 2 | let _internal_key : Hmap.t Lwt.key = Lwt.new_key () 3 | 4 | let ( let* ) = Option.bind 5 | end 6 | 7 | module M = struct 8 | let name = "Storage_lwt" 9 | 10 | let[@inline] get_map () = Lwt.get _internal_key 11 | 12 | let[@inline] with_map m cb = Lwt.with_value _internal_key (Some m) cb 13 | 14 | let create_key = Hmap.Key.create 15 | 16 | let get k = 17 | let* context = get_map () in 18 | Hmap.find k context 19 | 20 | let with_binding k v cb = 21 | let new_context = 22 | match get_map () with 23 | | None -> Hmap.singleton k v 24 | | Some old_context -> Hmap.add k v old_context 25 | in 26 | with_map new_context cb 27 | 28 | let without_binding k cb = 29 | let new_context = 30 | match get_map () with 31 | | None -> Hmap.empty 32 | | Some old_context -> Hmap.rem k old_context 33 | in 34 | with_map new_context cb 35 | end 36 | 37 | let storage () : Opentelemetry_ambient_context.storage = (module M) 38 | -------------------------------------------------------------------------------- /src/ambient-context/lwt/opentelemetry_ambient_context_lwt.mli: -------------------------------------------------------------------------------- 1 | val storage : unit -> Opentelemetry_ambient_context.storage 2 | (** Storage using Lwt keys *) 3 | -------------------------------------------------------------------------------- /src/ambient-context/opentelemetry_ambient_context.ml: -------------------------------------------------------------------------------- 1 | module TLS = Thread_local_storage 2 | include Opentelemetry_ambient_context_types 3 | 4 | type 'a key = int * 'a Hmap.key 5 | 6 | let debug = 7 | match Sys.getenv_opt "OCAML_AMBIENT_CONTEXT_DEBUG" with 8 | | Some ("1" | "true") -> true 9 | | _ -> false 10 | 11 | let _debug_id_ = Atomic.make 0 12 | 13 | let[@inline] generate_debug_id () = Atomic.fetch_and_add _debug_id_ 1 14 | 15 | let compare_key : int -> int -> int = Stdlib.compare 16 | 17 | module Storage_tls_hmap = struct 18 | let[@inline] ( let* ) o f = 19 | match o with 20 | | None -> None 21 | | Some x -> f x 22 | 23 | let key : Hmap.t TLS.t = Hmap_key_.key 24 | 25 | let name = "Storage_tls" 26 | 27 | let[@inline] get_map () = TLS.get_opt key 28 | 29 | let[@inline] with_map m cb = 30 | let old = TLS.get_opt key |> Option.value ~default:Hmap.empty in 31 | TLS.set key m; 32 | Fun.protect ~finally:(fun () -> TLS.set key old) cb 33 | 34 | let create_key = Hmap.Key.create 35 | 36 | let get k = 37 | let* context = get_map () in 38 | Hmap.find k context 39 | 40 | let with_binding k v cb = 41 | let new_context = 42 | match get_map () with 43 | | None -> Hmap.singleton k v 44 | | Some old_context -> Hmap.add k v old_context 45 | in 46 | with_map new_context @@ fun _context -> cb () 47 | 48 | let without_binding k cb = 49 | match get_map () with 50 | | None -> cb () 51 | | Some old_context -> 52 | let new_context = Hmap.rem k old_context in 53 | with_map new_context @@ fun _context -> cb () 54 | end 55 | 56 | let default_storage : storage = (module Storage_tls_hmap) 57 | 58 | let k_current_storage : storage TLS.t = TLS.create () 59 | 60 | let get_current_storage () = 61 | match TLS.get_exn k_current_storage with 62 | | v -> v 63 | | exception TLS.Not_set -> 64 | let v = default_storage in 65 | TLS.set k_current_storage v; 66 | v 67 | 68 | let create_key () = 69 | let (module Store : STORAGE) = get_current_storage () in 70 | if not debug then 71 | 0, Store.create_key () 72 | else ( 73 | let id = generate_debug_id () in 74 | Printf.printf "%s: create_key %i\n%!" Store.name id; 75 | id, Store.create_key () 76 | ) 77 | 78 | let get (id, k) = 79 | let (module Store : STORAGE) = get_current_storage () in 80 | if not debug then 81 | Store.get k 82 | else ( 83 | let rv = Store.get k in 84 | (match rv with 85 | | Some _ -> Printf.printf "%s: get %i -> Some\n%!" Store.name id 86 | | None -> Printf.printf "%s: get %i -> None\n%!" Store.name id); 87 | rv 88 | ) 89 | 90 | let with_binding : 'a key -> 'a -> (unit -> 'r) -> 'r = 91 | fun (id, k) v cb -> 92 | let (module Store : STORAGE) = get_current_storage () in 93 | if not debug then 94 | Store.with_binding k v cb 95 | else ( 96 | Printf.printf "%s: with_binding %i enter\n%!" Store.name id; 97 | let rv = Store.with_binding k v cb in 98 | Printf.printf "%s: with_binding %i exit\n%!" Store.name id; 99 | rv 100 | ) 101 | 102 | let without_binding (id, k) cb = 103 | let (module Store : STORAGE) = get_current_storage () in 104 | if not debug then 105 | Store.without_binding k cb 106 | else ( 107 | Printf.printf "%s: without_binding %i enter\n%!" Store.name id; 108 | let rv = Store.without_binding k cb in 109 | Printf.printf "%s: without_binding %i exit\n%!" Store.name id; 110 | rv 111 | ) 112 | 113 | let set_storage_provider store_new = 114 | let store_before = get_current_storage () in 115 | if store_new == store_before then 116 | () 117 | else 118 | TLS.set k_current_storage store_new; 119 | if debug then ( 120 | let (module Store_before : STORAGE) = store_before in 121 | let (module Store_new : STORAGE) = store_new in 122 | Printf.printf "set_storage_provider %s (previously %s)\n%!" Store_new.name 123 | Store_before.name 124 | ) 125 | -------------------------------------------------------------------------------- /src/ambient-context/opentelemetry_ambient_context.mli: -------------------------------------------------------------------------------- 1 | (** Ambient context. 2 | 3 | The ambient context, like the Matrix, is everywhere around you. 4 | 5 | It is responsible for keeping track of that context in a manner that's 6 | consistent with the program's choice of control flow paradigm: 7 | 8 | - for synchronous/threaded/direct style code, {b TLS} ("thread local 9 | storage") keeps track of a global variable per thread. Each thread has its 10 | own copy of the variable and updates it independently of other threads. 11 | 12 | - for Lwt, any ['a Lwt.t] created inside the [with_binding k v (fun _ -> …)] 13 | will inherit the [k := v] assignment. 14 | 15 | - for Eio, fibers created inside [with_binding k v (fun () -> …)] will 16 | inherit the [k := v] assignment. This is consistent with the structured 17 | concurrency approach of Eio. 18 | 19 | The only data stored by this storage is a {!Hmap.t}, ie a heterogeneous map. 20 | Various users (libraries, user code, etc.) can create their own {!key} to 21 | store what they are interested in, without affecting other parts of the 22 | storage. *) 23 | 24 | module Types := Opentelemetry_ambient_context_types 25 | 26 | module type STORAGE = Types.STORAGE 27 | 28 | type storage = (module STORAGE) 29 | 30 | val default_storage : storage 31 | 32 | val get_current_storage : unit -> storage 33 | 34 | val set_storage_provider : storage -> unit 35 | 36 | type 'a key 37 | (** A key that can be mapped to values of type ['a] in the ambient context. *) 38 | 39 | val compare_key : int -> int -> int 40 | (** Total order on keys *) 41 | 42 | val create_key : unit -> 'a key 43 | (** Create a new fresh key, distinct from any previously created key. *) 44 | 45 | val get : 'a key -> 'a option 46 | (** Get the current value for a given key, or [None] if no value was associated 47 | with the key in the ambient context. *) 48 | 49 | val with_binding : 'a key -> 'a -> (unit -> 'r) -> 'r 50 | (** [with_binding k v cb] calls [cb()] in a context in which [k] is bound to 51 | [v]. This does not affect storage outside of [cb()]. *) 52 | 53 | val without_binding : 'a key -> (unit -> 'b) -> 'b 54 | (** [without_binding k cb] calls [cb()] in a context where [k] has no binding 55 | (possibly shadowing the current ambient binding of [k] if it exists). *) 56 | -------------------------------------------------------------------------------- /src/ambient-context/types/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name opentelemetry_ambient_context_types) 3 | (public_name opentelemetry.ambient-context.types) 4 | (libraries hmap thread-local-storage)) 5 | -------------------------------------------------------------------------------- /src/ambient-context/types/opentelemetry_ambient_context_types.ml: -------------------------------------------------------------------------------- 1 | type 'a key = 'a Hmap.key 2 | 3 | module type STORAGE = sig 4 | val name : string 5 | 6 | val get_map : unit -> Hmap.t option 7 | 8 | val with_map : Hmap.t -> (unit -> 'b) -> 'b 9 | 10 | val create_key : unit -> 'a key 11 | 12 | val get : 'a key -> 'a option 13 | 14 | val with_binding : 'a key -> 'a -> (unit -> 'b) -> 'b 15 | 16 | val without_binding : 'a key -> (unit -> 'b) -> 'b 17 | end 18 | 19 | type storage = (module STORAGE) 20 | -------------------------------------------------------------------------------- /src/ambient-context/types/opentelemetry_ambient_context_types.mli: -------------------------------------------------------------------------------- 1 | (** Storage implementation. 2 | 3 | There is a singleton storage for a given program, responsible for providing 4 | ambient context to the rest of the program. *) 5 | 6 | type 'a key = 'a Hmap.key 7 | 8 | module type STORAGE = sig 9 | val name : string 10 | (** Name of the storage implementation. *) 11 | 12 | val get_map : unit -> Hmap.t option 13 | (** Get the hmap from the current ambient context, or [None] if there is no 14 | ambient context. *) 15 | 16 | val with_map : Hmap.t -> (unit -> 'b) -> 'b 17 | (** [with_hmap h cb] calls [cb()] in an ambient context in which [get_map()] 18 | will return [h]. Once [cb()] returns, the storage is reset to its previous 19 | value. *) 20 | 21 | val create_key : unit -> 'a key 22 | (** Create a new storage key, guaranteed to be distinct from any previously 23 | created key. *) 24 | 25 | val get : 'a key -> 'a option 26 | 27 | val with_binding : 'a key -> 'a -> (unit -> 'b) -> 'b 28 | 29 | val without_binding : 'a key -> (unit -> 'b) -> 'b 30 | end 31 | 32 | type storage = (module STORAGE) 33 | -------------------------------------------------------------------------------- /src/atomic/atomic.post412.mli: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* OCaml *) 4 | (* *) 5 | (* Stephen Dolan, University of Cambridge *) 6 | (* Gabriel Scherer, projet Partout, INRIA Paris-Saclay *) 7 | (* *) 8 | (* Copyright 2017-2018 University of Cambridge. *) 9 | (* Copyright 2020 Institut National de Recherche en Informatique et *) 10 | (* en Automatique. *) 11 | (* *) 12 | (* All rights reserved. This file is distributed under the terms of *) 13 | (* the GNU Lesser General Public License version 2.1, with the *) 14 | (* special exception on linking described in the file LICENSE. *) 15 | (* *) 16 | (**************************************************************************) 17 | 18 | (** Atomic references. *) 19 | 20 | type 'a t = 'a Stdlib.Atomic.t 21 | (** An atomic (mutable) reference to a value of type ['a]. *) 22 | 23 | val make : 'a -> 'a t 24 | (** Create an atomic reference. *) 25 | 26 | val get : 'a t -> 'a 27 | (** Get the current value of the atomic reference. *) 28 | 29 | val set : 'a t -> 'a -> unit 30 | (** Set a new value for the atomic reference. *) 31 | 32 | val exchange : 'a t -> 'a -> 'a 33 | (** Set a new value for the atomic reference, and return the current value. *) 34 | 35 | val compare_and_set : 'a t -> 'a -> 'a -> bool 36 | (** [compare_and_set r seen v] sets the new value of [r] to [v] only if its 37 | current value is physically equal to [seen] -- the comparison and the set 38 | occur atomically. Returns [true] if the comparison succeeded (so the set 39 | happened) and [false] otherwise. *) 40 | 41 | val fetch_and_add : int t -> int -> int 42 | (** [fetch_and_add r n] atomically increments the value of [r] by [n], and 43 | returns the current value (before the increment). *) 44 | 45 | val incr : int t -> unit 46 | (** [incr r] atomically increments the value of [r] by [1]. *) 47 | 48 | val decr : int t -> unit 49 | (** [decr r] atomically decrements the value of [r] by [1]. *) 50 | -------------------------------------------------------------------------------- /src/atomic/atomic.pre412.mli: -------------------------------------------------------------------------------- 1 | (**************************************************************************) 2 | (* *) 3 | (* OCaml *) 4 | (* *) 5 | (* Stephen Dolan, University of Cambridge *) 6 | (* Gabriel Scherer, projet Partout, INRIA Paris-Saclay *) 7 | (* *) 8 | (* Copyright 2017-2018 University of Cambridge. *) 9 | (* Copyright 2020 Institut National de Recherche en Informatique et *) 10 | (* en Automatique. *) 11 | (* *) 12 | (* All rights reserved. This file is distributed under the terms of *) 13 | (* the GNU Lesser General Public License version 2.1, with the *) 14 | (* special exception on linking described in the file LICENSE. *) 15 | (* *) 16 | (**************************************************************************) 17 | 18 | (** Atomic references. *) 19 | 20 | type 'a t 21 | (** An atomic (mutable) reference to a value of type ['a]. *) 22 | 23 | val make : 'a -> 'a t 24 | (** Create an atomic reference. *) 25 | 26 | val get : 'a t -> 'a 27 | (** Get the current value of the atomic reference. *) 28 | 29 | val set : 'a t -> 'a -> unit 30 | (** Set a new value for the atomic reference. *) 31 | 32 | val exchange : 'a t -> 'a -> 'a 33 | (** Set a new value for the atomic reference, and return the current value. *) 34 | 35 | val compare_and_set : 'a t -> 'a -> 'a -> bool 36 | (** [compare_and_set r seen v] sets the new value of [r] to [v] only if its 37 | current value is physically equal to [seen] -- the comparison and the set 38 | occur atomically. Returns [true] if the comparison succeeded (so the set 39 | happened) and [false] otherwise. *) 40 | 41 | val fetch_and_add : int t -> int -> int 42 | (** [fetch_and_add r n] atomically increments the value of [r] by [n], and 43 | returns the current value (before the increment). *) 44 | 45 | val incr : int t -> unit 46 | (** [incr r] atomically increments the value of [r] by [1]. *) 47 | 48 | val decr : int t -> unit 49 | (** [decr r] atomically decrements the value of [r] by [1]. *) 50 | -------------------------------------------------------------------------------- /src/atomic/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name opentelemetry_atomic) 3 | (synopsis "Compatibility package for the Atomic module for opentelemetry") 4 | (public_name opentelemetry.atomic) 5 | (modules atomic)) 6 | 7 | (executable 8 | (modules gen) 9 | (name gen)) 10 | 11 | (rule 12 | (targets atomic.ml atomic.mli atomic.ml) 13 | (deps atomic.pre412.mli atomic.post412.mli) 14 | (action 15 | (run ./gen.exe))) 16 | -------------------------------------------------------------------------------- /src/atomic/gen.ml: -------------------------------------------------------------------------------- 1 | let atomic_before_412 = 2 | {| 3 | type 'a t = {mutable x: 'a} 4 | let[@inline] make x = {x} 5 | let[@inline] get {x} = x 6 | let[@inline] set r x = r.x <- x 7 | 8 | let[@inline never] exchange r x = 9 | (* critical section *) 10 | let y = r.x in 11 | r.x <- x; 12 | (* end critical section *) 13 | y 14 | 15 | let[@inline never] compare_and_set r seen v = 16 | (* critical section *) 17 | if r.x == seen then ( 18 | r.x <- v; 19 | true 20 | ) else false 21 | 22 | let[@inline never] fetch_and_add r x = 23 | let v = r.x in 24 | r.x <- x + r.x; 25 | v 26 | 27 | let[@inline never] incr r = r.x <- 1 + r.x 28 | let[@inline never] decr r = r.x <- r.x - 1 29 | |} 30 | 31 | let atomic_after_412 = {|include Stdlib.Atomic|} 32 | 33 | let write_file file s = 34 | let oc = open_out file in 35 | output_string oc s; 36 | close_out oc 37 | 38 | let copy_file file1 file2 = 39 | let oc = open_out file2 in 40 | let ic = open_in file1 in 41 | let buf = Bytes.create 1024 in 42 | try 43 | while true do 44 | let n = input ic buf 0 (Bytes.length buf) in 45 | if n = 0 then raise End_of_file; 46 | output oc buf 0 n 47 | done 48 | with End_of_file -> () 49 | 50 | let () = 51 | let version = Scanf.sscanf Sys.ocaml_version "%d.%d.%s" (fun x y _ -> x, y) in 52 | write_file "atomic.ml" 53 | (if version >= (4, 12) then 54 | atomic_after_412 55 | else 56 | atomic_before_412); 57 | copy_file 58 | (if version >= (4, 12) then 59 | "atomic.post412.mli" 60 | else 61 | "atomic.pre412.mli") 62 | "atomic.mli"; 63 | () 64 | -------------------------------------------------------------------------------- /src/client-cohttp-lwt/common_.ml: -------------------------------------------------------------------------------- 1 | module Atomic = Opentelemetry_atomic.Atomic 2 | 3 | let[@inline] ( let@ ) f x = f x 4 | 5 | let spf = Printf.sprintf 6 | 7 | let tid () = Thread.id @@ Thread.self () 8 | 9 | let debug_ = 10 | ref 11 | (match Sys.getenv_opt "OTEL_OCAML_DEBUG" with 12 | | Some ("1" | "true") -> true 13 | | _ -> false) 14 | 15 | let default_url = "http://localhost:4318" 16 | 17 | let make_get_from_env env_name = 18 | let value = ref None in 19 | fun () -> 20 | match !value with 21 | | None -> 22 | value := Sys.getenv_opt env_name; 23 | !value 24 | | Some value -> Some value 25 | 26 | let get_url_from_env = make_get_from_env "OTEL_EXPORTER_OTLP_ENDPOINT" 27 | 28 | let get_url_traces_from_env = 29 | make_get_from_env "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" 30 | 31 | let get_url_metrics_from_env = 32 | make_get_from_env "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT" 33 | 34 | let get_url_logs_from_env = make_get_from_env "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT" 35 | 36 | let remove_trailing_slash url = 37 | if url <> "" && String.get url (String.length url - 1) = '/' then 38 | String.sub url 0 (String.length url - 1) 39 | else 40 | url 41 | 42 | let parse_headers s = 43 | let parse_header s = 44 | match String.split_on_char '=' s with 45 | | [ key; value ] -> key, value 46 | | _ -> failwith "Unexpected format for header" 47 | in 48 | String.split_on_char ',' s |> List.map parse_header 49 | 50 | let default_headers = [] 51 | 52 | let headers = 53 | ref 54 | (try parse_headers (Sys.getenv "OTEL_EXPORTER_OTLP_HEADERS") 55 | with _ -> default_headers) 56 | 57 | let get_headers () = !headers 58 | 59 | let set_headers s = headers := s 60 | -------------------------------------------------------------------------------- /src/client-cohttp-lwt/config.ml: -------------------------------------------------------------------------------- 1 | open Common_ 2 | 3 | type t = { 4 | debug: bool; 5 | url_traces: string; 6 | url_metrics: string; 7 | url_logs: string; 8 | headers: (string * string) list; 9 | batch_traces: int option; 10 | batch_metrics: int option; 11 | batch_logs: int option; 12 | batch_timeout_ms: int; 13 | } 14 | 15 | let pp out self : unit = 16 | let ppiopt = Format.pp_print_option Format.pp_print_int in 17 | let pp_header ppf (a, b) = Format.fprintf ppf "@[%s: @,%s@]@." a b in 18 | let ppheaders = Format.pp_print_list pp_header in 19 | let { 20 | debug; 21 | url_traces; 22 | url_metrics; 23 | url_logs; 24 | headers; 25 | batch_traces; 26 | batch_metrics; 27 | batch_logs; 28 | batch_timeout_ms; 29 | } = 30 | self 31 | in 32 | Format.fprintf out 33 | "{@[ debug=%B;@ url_traces=%S;@ url_metrics=%S;@ url_logs=%S;@ \ 34 | headers=%a;@ batch_traces=%a;@ batch_metrics=%a;@ batch_logs=%a;@ \ 35 | batch_timeout_ms=%d; @]}" 36 | debug url_traces url_metrics url_logs ppheaders headers ppiopt batch_traces 37 | ppiopt batch_metrics ppiopt batch_logs batch_timeout_ms 38 | 39 | let make ?(debug = !debug_) ?url ?url_traces ?url_metrics ?url_logs 40 | ?(headers = get_headers ()) ?(batch_traces = Some 400) 41 | ?(batch_metrics = Some 20) ?(batch_logs = Some 400) 42 | ?(batch_timeout_ms = 500) () : t = 43 | let url_traces, url_metrics, url_logs = 44 | let base_url = 45 | let base_url = 46 | match get_url_from_env () with 47 | | None -> Option.value url ~default:default_url 48 | | Some url -> remove_trailing_slash url 49 | in 50 | remove_trailing_slash base_url 51 | in 52 | let url_traces = 53 | match get_url_traces_from_env () with 54 | | None -> Option.value url_traces ~default:(base_url ^ "/v1/traces") 55 | | Some url -> url 56 | in 57 | let url_metrics = 58 | match get_url_metrics_from_env () with 59 | | None -> Option.value url_metrics ~default:(base_url ^ "/v1/metrics") 60 | | Some url -> url 61 | in 62 | let url_logs = 63 | match get_url_logs_from_env () with 64 | | None -> Option.value url_logs ~default:(base_url ^ "/v1/logs") 65 | | Some url -> url 66 | in 67 | url_traces, url_metrics, url_logs 68 | in 69 | { 70 | debug; 71 | url_traces; 72 | url_metrics; 73 | url_logs; 74 | headers; 75 | batch_traces; 76 | batch_metrics; 77 | batch_timeout_ms; 78 | batch_logs; 79 | } 80 | -------------------------------------------------------------------------------- /src/client-cohttp-lwt/config.mli: -------------------------------------------------------------------------------- 1 | type t = private { 2 | debug: bool; 3 | url_traces: string; (** Url to send traces *) 4 | url_metrics: string; (** Url to send metrics*) 5 | url_logs: string; (** Url to send logs *) 6 | headers: (string * string) list; 7 | (** API headers sent to the endpoint. Default is none or 8 | "OTEL_EXPORTER_OTLP_HEADERS" if set. *) 9 | batch_traces: int option; 10 | (** Batch traces? If [Some i], then this produces batches of (at most) [i] 11 | items. If [None], there is no batching. 12 | 13 | Note that traces and metrics are batched separately. Default 14 | [Some 400]. *) 15 | batch_metrics: int option; 16 | (** Batch metrics? If [Some i], then this produces batches of (at most) 17 | [i] items. If [None], there is no batching. 18 | 19 | Note that traces and metrics are batched separately. Default [None]. 20 | *) 21 | batch_logs: int option; 22 | (** Batch logs? See {!batch_metrics} for details. Default [Some 400] *) 23 | batch_timeout_ms: int; 24 | (** Number of milliseconds after which we will emit a batch, even 25 | incomplete. Note that the batch might take longer than that, because 26 | this is only checked when a new event occurs. Default 500. *) 27 | } 28 | (** Configuration. 29 | 30 | To build one, use {!make} below. This might be extended with more fields in 31 | the future. *) 32 | 33 | val make : 34 | ?debug:bool -> 35 | ?url:string -> 36 | ?url_traces:string -> 37 | ?url_metrics:string -> 38 | ?url_logs:string -> 39 | ?headers:(string * string) list -> 40 | ?batch_traces:int option -> 41 | ?batch_metrics:int option -> 42 | ?batch_logs:int option -> 43 | ?batch_timeout_ms:int -> 44 | unit -> 45 | t 46 | (** Make a configuration. 47 | 48 | @param thread 49 | if true and [bg_threads] is not provided, we will pick a number of bg 50 | threads. Otherwise the number of [bg_threads] superseeds this option. 51 | 52 | @param url 53 | base url used to construct per-signal urls. Per-signal url options take 54 | precedence over this base url. Default is "http://localhost:4318", or 55 | "OTEL_EXPORTER_OTLP_ENDPOINT" if set. 56 | 57 | Example of constructed per-signal urls with the base url 58 | http://localhost:4318 59 | - Traces: http://localhost:4318/v1/traces 60 | - Metrics: http://localhost:4318/v1/metrics 61 | - Logs: http://localhost:4318/v1/logs 62 | 63 | Use per-signal url options if different urls are needed for each signal 64 | type. 65 | 66 | @param url_traces 67 | url to send traces, or "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" if set. The 68 | url is used as-is without any modification. 69 | 70 | @param url_metrics 71 | url to send metrics, or "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT" if set. The 72 | url is used as-is without any modification. 73 | 74 | @param url_logs 75 | url to send logs, or "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT" if set. The url is 76 | used as-is without any modification. *) 77 | 78 | val pp : Format.formatter -> t -> unit 79 | -------------------------------------------------------------------------------- /src/client-cohttp-lwt/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name opentelemetry_client_cohttp_lwt) 3 | (public_name opentelemetry-client-cohttp-lwt) 4 | (synopsis "Opentelemetry collector using cohttp+lwt+unix") 5 | (preprocess 6 | (pps lwt_ppx)) 7 | (libraries 8 | opentelemetry 9 | lwt 10 | cohttp-lwt 11 | cohttp-lwt-unix 12 | pbrt 13 | mtime 14 | mtime.clock.os)) 15 | -------------------------------------------------------------------------------- /src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.mli: -------------------------------------------------------------------------------- 1 | (* 2 | TODO: more options from 3 | https://opentelemetry.io/docs/reference/specification/protocol/exporter/ 4 | *) 5 | 6 | open Common_ 7 | 8 | val get_headers : unit -> (string * string) list 9 | 10 | val set_headers : (string * string) list -> unit 11 | (** Set http headers that are sent on every http query to the collector. *) 12 | 13 | module Config = Config 14 | 15 | val create_backend : 16 | ?stop:bool Atomic.t -> 17 | ?config:Config.t -> 18 | unit -> 19 | (module Opentelemetry.Collector.BACKEND) 20 | (** Create a new backend using lwt and cohttp 21 | 22 | NOTE [after_cleanup] optional parameter removed since NEXT_RELEASE *) 23 | 24 | val setup : 25 | ?stop:bool Atomic.t -> ?config:Config.t -> ?enable:bool -> unit -> unit 26 | (** Setup endpoint. This modifies {!Opentelemetry.Collector.backend}. 27 | @param enable 28 | actually setup the backend (default true). This can be used to 29 | enable/disable the setup depending on CLI arguments or environment. 30 | @param config configuration to use 31 | @param stop 32 | an atomic boolean. When it becomes true, background threads will all stop 33 | after a little while. *) 34 | 35 | val remove_backend : unit -> unit Lwt.t 36 | (** Shutdown current backend 37 | @since NEXT_RELEASE *) 38 | 39 | val with_setup : 40 | ?stop:bool Atomic.t -> 41 | ?config:Config.t -> 42 | ?enable:bool -> 43 | unit -> 44 | (unit -> 'a Lwt.t) -> 45 | 'a Lwt.t 46 | (** [with_setup () f] is like [setup(); f()] but takes care of cleaning up after 47 | [f()] returns See {!setup} for more details. *) 48 | -------------------------------------------------------------------------------- /src/client-ocurl/b_queue.ml: -------------------------------------------------------------------------------- 1 | type 'a t = { 2 | mutex: Mutex.t; 3 | cond: Condition.t; 4 | q: 'a Queue.t; 5 | mutable closed: bool; 6 | } 7 | 8 | exception Closed 9 | 10 | let create () : _ t = 11 | { 12 | mutex = Mutex.create (); 13 | cond = Condition.create (); 14 | q = Queue.create (); 15 | closed = false; 16 | } 17 | 18 | let close (self : _ t) = 19 | Mutex.lock self.mutex; 20 | if not self.closed then ( 21 | self.closed <- true; 22 | Condition.broadcast self.cond (* awake waiters so they fail *) 23 | ); 24 | Mutex.unlock self.mutex 25 | 26 | let push (self : _ t) x : unit = 27 | Mutex.lock self.mutex; 28 | if self.closed then ( 29 | Mutex.unlock self.mutex; 30 | raise Closed 31 | ) else ( 32 | Queue.push x self.q; 33 | Condition.signal self.cond; 34 | Mutex.unlock self.mutex 35 | ) 36 | 37 | let pop (self : 'a t) : 'a = 38 | Mutex.lock self.mutex; 39 | let rec loop () = 40 | if self.closed then ( 41 | Mutex.unlock self.mutex; 42 | raise Closed 43 | ) else if Queue.is_empty self.q then ( 44 | Condition.wait self.cond self.mutex; 45 | (loop [@tailcall]) () 46 | ) else ( 47 | let x = Queue.pop self.q in 48 | Mutex.unlock self.mutex; 49 | x 50 | ) 51 | in 52 | loop () 53 | 54 | let pop_all (self : 'a t) into : unit = 55 | Mutex.lock self.mutex; 56 | let rec loop () = 57 | if Queue.is_empty self.q then ( 58 | if self.closed then ( 59 | Mutex.unlock self.mutex; 60 | raise Closed 61 | ); 62 | Condition.wait self.cond self.mutex; 63 | (loop [@tailcall]) () 64 | ) else ( 65 | Queue.transfer self.q into; 66 | Mutex.unlock self.mutex 67 | ) 68 | in 69 | loop () 70 | -------------------------------------------------------------------------------- /src/client-ocurl/b_queue.mli: -------------------------------------------------------------------------------- 1 | (** Basic Blocking Queue *) 2 | 3 | type 'a t 4 | 5 | val create : unit -> _ t 6 | 7 | exception Closed 8 | 9 | val push : 'a t -> 'a -> unit 10 | (** [push q x] pushes [x] into [q], and returns [()]. 11 | @raise Closed if [close q] was previously called.*) 12 | 13 | val pop : 'a t -> 'a 14 | (** [pop q] pops the next element in [q]. It might block until an element comes. 15 | @raise Closed if the queue was closed before a new element was available. *) 16 | 17 | val pop_all : 'a t -> 'a Queue.t -> unit 18 | (** [pop_all q into] pops all the elements of [q] and moves them into [into]. It 19 | might block until an element comes. 20 | @raise Closed if the queue was closed before a new element was available. *) 21 | 22 | val close : _ t -> unit 23 | (** Close the queue, meaning there won't be any more [push] allowed. *) 24 | -------------------------------------------------------------------------------- /src/client-ocurl/batch.ml: -------------------------------------------------------------------------------- 1 | type 'a t = { 2 | mutable len: int; 3 | mutable l: 'a list list; 4 | mutable started: Mtime.t; 5 | } 6 | 7 | let create () = { len = 0; l = []; started = Mtime_clock.now () } 8 | 9 | let push self l = 10 | if l != [] then ( 11 | if self.l == [] then self.started <- Mtime_clock.now (); 12 | self.l <- l :: self.l; 13 | self.len <- self.len + List.length l 14 | ) 15 | 16 | let[@inline] len self = self.len 17 | 18 | let[@inline] time_started self = self.started 19 | 20 | let pop_all self = 21 | let l = self.l in 22 | self.l <- []; 23 | self.len <- 0; 24 | l 25 | -------------------------------------------------------------------------------- /src/client-ocurl/batch.mli: -------------------------------------------------------------------------------- 1 | (** List of lists with length *) 2 | 3 | type 'a t 4 | 5 | val create : unit -> 'a t 6 | 7 | val push : 'a t -> 'a list -> unit 8 | 9 | val len : _ t -> int 10 | 11 | val time_started : _ t -> Mtime.t 12 | (** Time at which the batch most recently became non-empty *) 13 | 14 | val pop_all : 'a t -> 'a list list 15 | -------------------------------------------------------------------------------- /src/client-ocurl/common_.ml: -------------------------------------------------------------------------------- 1 | module Atomic = Opentelemetry_atomic.Atomic 2 | include Opentelemetry.Lock 3 | 4 | let spf = Printf.sprintf 5 | 6 | let ( let@ ) = ( @@ ) 7 | 8 | let tid () = Thread.id @@ Thread.self () 9 | 10 | let debug_ = 11 | ref 12 | (match Sys.getenv_opt "OTEL_OCAML_DEBUG" with 13 | | Some ("1" | "true") -> true 14 | | _ -> false) 15 | 16 | let default_url = "http://localhost:4318" 17 | 18 | let make_get_from_env env_name = 19 | let value = ref None in 20 | fun () -> 21 | match !value with 22 | | None -> 23 | value := Sys.getenv_opt env_name; 24 | !value 25 | | Some value -> Some value 26 | 27 | let get_url_from_env = make_get_from_env "OTEL_EXPORTER_OTLP_ENDPOINT" 28 | 29 | let get_url_traces_from_env = 30 | make_get_from_env "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" 31 | 32 | let get_url_metrics_from_env = 33 | make_get_from_env "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT" 34 | 35 | let get_url_logs_from_env = make_get_from_env "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT" 36 | 37 | let remove_trailing_slash url = 38 | if url <> "" && String.get url (String.length url - 1) = '/' then 39 | String.sub url 0 (String.length url - 1) 40 | else 41 | url 42 | 43 | let parse_headers s = 44 | let parse_header s = 45 | match String.split_on_char '=' s with 46 | | [ key; value ] -> key, value 47 | | _ -> failwith "Unexpected format for header" 48 | in 49 | String.split_on_char ',' s |> List.map parse_header 50 | 51 | let default_headers = [] 52 | 53 | let headers = 54 | ref 55 | (try parse_headers (Sys.getenv "OTEL_EXPORTER_OTLP_HEADERS") 56 | with _ -> default_headers) 57 | 58 | let get_headers () = !headers 59 | 60 | let set_headers s = headers := s 61 | -------------------------------------------------------------------------------- /src/client-ocurl/config.ml: -------------------------------------------------------------------------------- 1 | open Common_ 2 | 3 | type t = { 4 | debug: bool; 5 | url_traces: string; 6 | url_metrics: string; 7 | url_logs: string; 8 | headers: (string * string) list; 9 | batch_timeout_ms: int; 10 | bg_threads: int; 11 | ticker_thread: bool; 12 | ticker_interval_ms: int; 13 | self_trace: bool; 14 | } 15 | 16 | let pp out self = 17 | let pp_header ppf (a, b) = Format.fprintf ppf "@[%s: @,%s@]@." a b in 18 | let ppheaders = Format.pp_print_list pp_header in 19 | let { 20 | debug; 21 | url_traces; 22 | url_metrics; 23 | url_logs; 24 | headers; 25 | batch_timeout_ms; 26 | bg_threads; 27 | ticker_thread; 28 | ticker_interval_ms; 29 | self_trace; 30 | } = 31 | self 32 | in 33 | Format.fprintf out 34 | "{@[ debug=%B;@ url_traces=%S;@ url_metrics=%S;@ url_logs=%S;@ \ 35 | headers=%a;@ batch_timeout_ms=%d; bg_threads=%d;@ ticker_thread=%B;@ \ 36 | ticker_interval_ms=%d;@ self_trace=%B @]}" 37 | debug url_traces url_metrics url_logs ppheaders headers batch_timeout_ms 38 | bg_threads ticker_thread ticker_interval_ms self_trace 39 | 40 | let make ?(debug = !debug_) ?url ?url_traces ?url_metrics ?url_logs 41 | ?(headers = get_headers ()) ?(batch_timeout_ms = 2_000) ?(bg_threads = 4) 42 | ?(ticker_thread = true) ?(ticker_interval_ms = 500) ?(self_trace = false) () 43 | : t = 44 | let bg_threads = max 1 (min bg_threads 32) in 45 | 46 | let url_traces, url_metrics, url_logs = 47 | let base_url = 48 | let base_url = 49 | match get_url_from_env () with 50 | | None -> Option.value url ~default:default_url 51 | | Some url -> remove_trailing_slash url 52 | in 53 | remove_trailing_slash base_url 54 | in 55 | let url_traces = 56 | match get_url_traces_from_env () with 57 | | None -> Option.value url_traces ~default:(base_url ^ "/v1/traces") 58 | | Some url -> url 59 | in 60 | let url_metrics = 61 | match get_url_metrics_from_env () with 62 | | None -> Option.value url_metrics ~default:(base_url ^ "/v1/metrics") 63 | | Some url -> url 64 | in 65 | let url_logs = 66 | match get_url_logs_from_env () with 67 | | None -> Option.value url_logs ~default:(base_url ^ "/v1/logs") 68 | | Some url -> url 69 | in 70 | url_traces, url_metrics, url_logs 71 | in 72 | { 73 | debug; 74 | url_traces; 75 | url_metrics; 76 | url_logs; 77 | headers; 78 | batch_timeout_ms; 79 | bg_threads; 80 | ticker_thread; 81 | ticker_interval_ms; 82 | self_trace; 83 | } 84 | -------------------------------------------------------------------------------- /src/client-ocurl/config.mli: -------------------------------------------------------------------------------- 1 | (** Configuration for the ocurl backend *) 2 | 3 | type t = private { 4 | debug: bool; 5 | url_traces: string; (** Url to send traces *) 6 | url_metrics: string; (** Url to send metrics*) 7 | url_logs: string; (** Url to send logs *) 8 | headers: (string * string) list; 9 | (** API headers sent to the endpoint. Default is none or 10 | "OTEL_EXPORTER_OTLP_HEADERS" if set. *) 11 | batch_timeout_ms: int; 12 | (** Number of milliseconds after which we will emit a batch, even 13 | incomplete. Note that the batch might take longer than that, because 14 | this is only checked when a new event occurs or when a tick is 15 | emitted. Default 2_000. *) 16 | bg_threads: int; 17 | (** Are there background threads, and how many? Default [4]. This will be 18 | adjusted to be at least [1] and at most [32]. *) 19 | ticker_thread: bool; 20 | (** If true, start a thread that regularly checks if signals should be 21 | sent to the collector. Default [true] *) 22 | ticker_interval_ms: int; 23 | (** Interval for ticker thread, in milliseconds. This is only useful if 24 | [ticker_thread] is [true]. This will be clamped between [2 ms] and 25 | some longer interval (maximum [60s] currently). Default 500. 26 | @since 0.7 *) 27 | self_trace: bool; 28 | (** If true, the OTEL library will also emit its own spans. Default 29 | [false]. 30 | @since 0.7 *) 31 | } 32 | (** Configuration. 33 | 34 | To build one, use {!make} below. This might be extended with more fields in 35 | the future. *) 36 | 37 | val make : 38 | ?debug:bool -> 39 | ?url:string -> 40 | ?url_traces:string -> 41 | ?url_metrics:string -> 42 | ?url_logs:string -> 43 | ?headers:(string * string) list -> 44 | ?batch_timeout_ms:int -> 45 | ?bg_threads:int -> 46 | ?ticker_thread:bool -> 47 | ?ticker_interval_ms:int -> 48 | ?self_trace:bool -> 49 | unit -> 50 | t 51 | (** Make a configuration. 52 | 53 | @param url 54 | base url used to construct per-signal urls. Per-signal url options take 55 | precedence over this base url. Default is "http://localhost:4318", or 56 | "OTEL_EXPORTER_OTLP_ENDPOINT" if set. 57 | 58 | Example of constructed per-signal urls with the base url 59 | http://localhost:4318 60 | - Traces: http://localhost:4318/v1/traces 61 | - Metrics: http://localhost:4318/v1/metrics 62 | - Logs: http://localhost:4318/v1/logs 63 | 64 | Use per-signal url options if different urls are needed for each signal 65 | type. 66 | 67 | @param url_traces 68 | url to send traces, or "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" if set. The 69 | url is used as-is without any modification. 70 | 71 | @param url_metrics 72 | url to send metrics, or "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT" if set. The 73 | url is used as-is without any modification. 74 | 75 | @param url_logs 76 | url to send logs, or "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT" if set. The url is 77 | used as-is without any modification. *) 78 | 79 | val pp : Format.formatter -> t -> unit 80 | -------------------------------------------------------------------------------- /src/client-ocurl/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name opentelemetry_client_ocurl) 3 | (public_name opentelemetry-client-ocurl) 4 | (libraries 5 | opentelemetry 6 | opentelemetry.atomic 7 | curl 8 | pbrt 9 | threads 10 | mtime 11 | mtime.clock.os 12 | ezcurl 13 | ezcurl.core)) 14 | -------------------------------------------------------------------------------- /src/client-ocurl/opentelemetry_client_ocurl.mli: -------------------------------------------------------------------------------- 1 | (* 2 | TODO: more options from 3 | https://opentelemetry.io/docs/reference/specification/protocol/exporter/ 4 | *) 5 | 6 | val get_headers : unit -> (string * string) list 7 | 8 | val set_headers : (string * string) list -> unit 9 | (** Set http headers that are sent on every http query to the collector. *) 10 | 11 | module Atomic = Opentelemetry_atomic.Atomic 12 | module Config = Config 13 | 14 | val create_backend : 15 | ?stop:bool Atomic.t -> 16 | ?config:Config.t -> 17 | unit -> 18 | (module Opentelemetry.Collector.BACKEND) 19 | 20 | val setup : 21 | ?stop:bool Atomic.t -> ?config:Config.t -> ?enable:bool -> unit -> unit 22 | (** Setup endpoint. This modifies {!Opentelemetry.Collector.backend}. 23 | @param enable 24 | actually setup the backend (default true). This can be used to 25 | enable/disable the setup depending on CLI arguments or environment. 26 | @param config configuration to use 27 | @param stop 28 | an atomic boolean. When it becomes true, background threads will all stop 29 | after a little while. *) 30 | 31 | val remove_backend : unit -> unit 32 | (** @since NEXT_RELEASE *) 33 | 34 | val with_setup : 35 | ?stop:bool Atomic.t -> 36 | ?config:Config.t -> 37 | ?enable:bool -> 38 | unit -> 39 | (unit -> 'a) -> 40 | 'a 41 | (** [with_setup () f] is like [setup(); f()] but takes care of cleaning up after 42 | [f()] returns See {!setup} for more details. *) 43 | -------------------------------------------------------------------------------- /src/core/AList.ml: -------------------------------------------------------------------------------- 1 | module Atomic = Opentelemetry_atomic.Atomic 2 | 3 | type 'a t = 'a list Atomic.t 4 | 5 | let make () = Atomic.make [] 6 | 7 | let[@inline] is_empty self : bool = 8 | match Atomic.get self with 9 | | [] -> true 10 | | _ :: _ -> false 11 | 12 | let get = Atomic.get 13 | 14 | let add self x = 15 | while 16 | let old = Atomic.get self in 17 | let l' = x :: old in 18 | not (Atomic.compare_and_set self old l') 19 | do 20 | () 21 | done 22 | 23 | let rec pop_all self = 24 | let l = Atomic.get self in 25 | if Atomic.compare_and_set self l [] then 26 | l 27 | else 28 | pop_all self 29 | -------------------------------------------------------------------------------- /src/core/AList.mli: -------------------------------------------------------------------------------- 1 | (** Atomic list *) 2 | 3 | type 'a t 4 | 5 | val get : 'a t -> 'a list 6 | (** Snapshot *) 7 | 8 | val is_empty : _ t -> bool 9 | 10 | val make : unit -> 'a t 11 | 12 | val add : 'a t -> 'a -> unit 13 | 14 | val pop_all : 'a t -> 'a list 15 | -------------------------------------------------------------------------------- /src/core/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name opentelemetry) 3 | (synopsis "API for opentelemetry instrumentation") 4 | (flags :standard -warn-error -a+8) 5 | (libraries 6 | opentelemetry.proto 7 | opentelemetry.ambient-context 8 | ptime 9 | ptime.clock.os 10 | pbrt 11 | threads 12 | opentelemetry.atomic 13 | hmap) 14 | (public_name opentelemetry)) 15 | -------------------------------------------------------------------------------- /src/core/lock.ml: -------------------------------------------------------------------------------- 1 | let lock_ : (unit -> unit) ref = ref ignore 2 | 3 | let unlock_ : (unit -> unit) ref = ref ignore 4 | 5 | let set_mutex ~lock ~unlock : unit = 6 | lock_ := lock; 7 | unlock_ := unlock 8 | 9 | let[@inline] with_lock f = 10 | !lock_ (); 11 | Fun.protect ~finally:!unlock_ f 12 | -------------------------------------------------------------------------------- /src/core/lock.mli: -------------------------------------------------------------------------------- 1 | val set_mutex : lock:(unit -> unit) -> unlock:(unit -> unit) -> unit 2 | (** Set a pair of lock/unlock functions that are used to protect access to 3 | global state, if needed. By default these do nothing. *) 4 | 5 | val with_lock : (unit -> 'a) -> 'a 6 | (** Call [f()] while holding the mutex defined {!set_mutex}, then release the 7 | mutex. *) 8 | -------------------------------------------------------------------------------- /src/core/rand_bytes.ml: -------------------------------------------------------------------------------- 1 | (* generate random IDs *) 2 | let rand_ = Random.State.make_self_init () 3 | 4 | let ( let@ ) = ( @@ ) 5 | 6 | let default_rand_bytes_8 () : bytes = 7 | let@ () = Lock.with_lock in 8 | let b = Bytes.create 8 in 9 | for i = 0 to 1 do 10 | let r = Random.State.bits rand_ in 11 | (* 30 bits, of which we use 24 *) 12 | Bytes.set b (i * 3) (Char.chr (r land 0xff)); 13 | Bytes.set b ((i * 3) + 1) (Char.chr ((r lsr 8) land 0xff)); 14 | Bytes.set b ((i * 3) + 2) (Char.chr ((r lsr 16) land 0xff)) 15 | done; 16 | let r = Random.State.bits rand_ in 17 | Bytes.set b 6 (Char.chr (r land 0xff)); 18 | Bytes.set b 7 (Char.chr ((r lsr 8) land 0xff)); 19 | b 20 | 21 | let default_rand_bytes_16 () : bytes = 22 | let@ () = Lock.with_lock in 23 | let b = Bytes.create 16 in 24 | for i = 0 to 4 do 25 | let r = Random.State.bits rand_ in 26 | (* 30 bits, of which we use 24 *) 27 | Bytes.set b (i * 3) (Char.chr (r land 0xff)); 28 | Bytes.set b ((i * 3) + 1) (Char.chr ((r lsr 8) land 0xff)); 29 | Bytes.set b ((i * 3) + 2) (Char.chr ((r lsr 16) land 0xff)) 30 | done; 31 | let r = Random.State.bits rand_ in 32 | Bytes.set b 15 (Char.chr (r land 0xff)); 33 | (* last byte *) 34 | b 35 | 36 | let rand_bytes_16 = ref default_rand_bytes_16 37 | 38 | let rand_bytes_8 = ref default_rand_bytes_8 39 | -------------------------------------------------------------------------------- /src/core/rand_bytes.mli: -------------------------------------------------------------------------------- 1 | (** Generate random identifiers. 2 | 3 | We need random identifiers for trace IDs and span IDs. *) 4 | 5 | val rand_bytes_16 : (unit -> bytes) ref 6 | (** Generate 16 bytes of random data. The implementation can be swapped to use 7 | any random generator. *) 8 | 9 | val rand_bytes_8 : (unit -> bytes) ref 10 | (** Generate 16 bytes of random data. The implementation can be swapped to use 11 | any random generator. *) 12 | 13 | val default_rand_bytes_8 : unit -> bytes 14 | (** Default implementation using {!Random} *) 15 | 16 | val default_rand_bytes_16 : unit -> bytes 17 | (** Default implementation using {!Random} *) 18 | -------------------------------------------------------------------------------- /src/integrations/cohttp/README.md: -------------------------------------------------------------------------------- 1 | # Opentelemetry tracing for Cohttp_lwt servers 2 | 3 | Wrap your server callback with `Opentelemetry_cohttp_lwt.Server.trace`: 4 | 5 | ```ocaml 6 | let my_server callback = 7 | let callback = 8 | Opentelemetry_cohttp_lwt.Server.trace ~service_name:"my-service" callback in 9 | Cohttp_lwt_unix.Server.create ~mode:(`TCP (`Port 8080)) 10 | (Server.make () ~callback) 11 | ``` 12 | -------------------------------------------------------------------------------- /src/integrations/cohttp/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name opentelemetry_cohttp_lwt) 3 | (public_name opentelemetry-cohttp-lwt) 4 | (libraries cohttp-lwt opentelemetry opentelemetry-lwt)) 5 | -------------------------------------------------------------------------------- /src/integrations/cohttp/opentelemetry_cohttp_lwt.ml: -------------------------------------------------------------------------------- 1 | module Otel = Opentelemetry 2 | module Otel_lwt = Opentelemetry_lwt 3 | open Cohttp 4 | 5 | module Server : sig 6 | val trace : 7 | ?service_name:string -> 8 | ?attrs:Otel.Span.key_value list -> 9 | ('conn -> Request.t -> 'body -> (Response.t * 'body) Lwt.t) -> 10 | 'conn -> 11 | Request.t -> 12 | 'body -> 13 | (Response.t * 'body) Lwt.t 14 | (** Trace requests to a Cohttp server. 15 | 16 | Use it like this: 17 | 18 | {[ 19 | let my_server callback = 20 | let callback_traced = 21 | Opentelemetry_cohttp_lwt.Server.trace ~service_name:"my-service" 22 | (fun _scope -> callback) 23 | in 24 | Cohttp_lwt_unix.Server.create 25 | ~mode:(`TCP (`Port 8080)) 26 | (Server.make () ~callback:callback_traced) 27 | ]} *) 28 | 29 | val with_ : 30 | ?trace_state:string -> 31 | ?service_name:string -> 32 | ?attrs:Otel.Span.key_value list -> 33 | ?kind:Otel.Span.kind -> 34 | ?links:Otel.Span_link.t list -> 35 | string -> 36 | Request.t -> 37 | (Request.t -> 'a Lwt.t) -> 38 | 'a Lwt.t 39 | (** Trace a new internal span. 40 | 41 | Identical to [Opentelemetry_lwt.Trace.with_], but fetches/stores the trace 42 | scope in the [x-ocaml-otel-traceparent] header in the request for 43 | convenience. *) 44 | 45 | val get_trace_context : 46 | ?from:[ `Internal | `External ] -> Request.t -> Otel.Scope.t option 47 | (** Get the tracing scope from the custom [x-ocaml-otel-traceparent] header 48 | added by [trace] and [with_]. *) 49 | 50 | val set_trace_context : Otel.Scope.t -> Request.t -> Request.t 51 | (** Set the tracing scope in the custom [x-ocaml-otel-traceparent] header used 52 | by [trace] and [with_]. *) 53 | 54 | val remove_trace_context : Request.t -> Request.t 55 | (** Strip the custom [x-ocaml-otel-traceparent] header added by [trace] and 56 | [with_]. *) 57 | end = struct 58 | let attrs_of_request (req : Request.t) = 59 | let meth = req |> Request.meth |> Code.string_of_method in 60 | let referer = Header.get (Request.headers req) "referer" in 61 | let host = Header.get (Request.headers req) "host" in 62 | let ua = Header.get (Request.headers req) "user-agent" in 63 | let uri = Request.uri req in 64 | List.concat 65 | [ 66 | [ "http.method", `String meth ]; 67 | (match host with 68 | | None -> [] 69 | | Some h -> [ "http.host", `String h ]); 70 | [ "http.url", `String (Uri.to_string uri) ]; 71 | (match ua with 72 | | None -> [] 73 | | Some ua -> [ "http.user_agent", `String ua ]); 74 | (match referer with 75 | | None -> [] 76 | | Some r -> [ "http.request.header.referer", `String r ]); 77 | ] 78 | 79 | let attrs_of_response (res : Response.t) = 80 | let code = Response.status res in 81 | let code = Code.code_of_status code in 82 | [ "http.status_code", `Int code ] 83 | 84 | let header_x_ocaml_otel_traceparent = "x-ocaml-otel-traceparent" 85 | 86 | let set_trace_context (scope : Otel.Scope.t) req = 87 | let module Traceparent = Otel.Trace_context.Traceparent in 88 | let headers = 89 | Header.add (Request.headers req) header_x_ocaml_otel_traceparent 90 | (Traceparent.to_value ~trace_id:scope.trace_id ~parent_id:scope.span_id 91 | ()) 92 | in 93 | { req with headers } 94 | 95 | let get_trace_context ?(from = `Internal) req = 96 | let module Traceparent = Otel.Trace_context.Traceparent in 97 | let name = 98 | match from with 99 | | `Internal -> header_x_ocaml_otel_traceparent 100 | | `External -> Traceparent.name 101 | in 102 | match Header.get (Request.headers req) name with 103 | | None -> None 104 | | Some v -> 105 | (match Traceparent.of_value v with 106 | | Ok (trace_id, parent_id) -> 107 | Some (Otel.Scope.make ~trace_id ~span_id:parent_id ()) 108 | | Error _ -> None) 109 | 110 | let remove_trace_context req = 111 | let headers = 112 | Header.remove (Request.headers req) header_x_ocaml_otel_traceparent 113 | in 114 | { req with headers } 115 | 116 | let trace ?service_name ?(attrs = []) callback conn req body = 117 | let scope = get_trace_context ~from:`External req in 118 | Otel_lwt.Trace.with_ ?service_name "request" ~kind:Span_kind_server 119 | ?trace_id:(Option.map (fun scope -> scope.Otel.Trace.trace_id) scope) 120 | ?parent:(Option.map (fun scope -> scope.Otel.Trace.span_id) scope) 121 | ~attrs:(attrs @ attrs_of_request req) 122 | (fun scope -> 123 | let open Lwt.Syntax in 124 | let req = set_trace_context scope req in 125 | let* res, body = callback conn req body in 126 | Otel.Scope.add_attrs scope (fun () -> attrs_of_response res); 127 | Lwt.return (res, body)) 128 | 129 | let with_ ?trace_state ?service_name ?attrs 130 | ?(kind = Otel.Span.Span_kind_internal) ?links name req 131 | (f : Request.t -> 'a Lwt.t) = 132 | let scope = get_trace_context ~from:`Internal req in 133 | Otel_lwt.Trace.with_ ?trace_state ?service_name ?attrs ~kind 134 | ?trace_id:(Option.map (fun scope -> scope.Otel.Trace.trace_id) scope) 135 | ?parent:(Option.map (fun scope -> scope.Otel.Trace.span_id) scope) 136 | ?links name 137 | (fun scope -> 138 | let req = set_trace_context scope req in 139 | f req) 140 | end 141 | 142 | let client ?(scope : Otel.Scope.t option) (module C : Cohttp_lwt.S.Client) = 143 | let module Traced = struct 144 | open Lwt.Syntax 145 | 146 | (* These types and values are not customized by our client, but are required to satisfy 147 | [Cohttp_lwt.S.Client]. *) 148 | include (C : sig 149 | type ctx = C.ctx 150 | type 'a io = 'a C.io 151 | type 'a with_context = 'a C.with_context 152 | type body = C.body 153 | val map_context : 'a with_context -> ('a -> 'b) -> 'b with_context 154 | val set_cache : Cohttp_lwt.S.call -> unit 155 | end) 156 | 157 | let attrs_for ~uri ~meth:_ () = 158 | [ 159 | "http.method", `String (Code.string_of_method `GET); 160 | "http.url", `String (Uri.to_string uri); 161 | ] 162 | 163 | let context_for ~uri ~meth = 164 | let trace_id = 165 | match scope with 166 | | Some scope -> Some scope.trace_id 167 | | None -> None 168 | in 169 | let parent = 170 | match scope with 171 | | Some scope -> Some scope.span_id 172 | | None -> None 173 | in 174 | let attrs = attrs_for ~uri ~meth () in 175 | trace_id, parent, attrs 176 | 177 | let add_traceparent (scope : Otel.Scope.t) headers = 178 | let module Traceparent = Otel.Trace_context.Traceparent in 179 | let headers = 180 | match headers with 181 | | None -> Header.init () 182 | | Some headers -> headers 183 | in 184 | Header.add headers Traceparent.name 185 | (Traceparent.to_value ~trace_id:scope.trace_id ~parent_id:scope.span_id 186 | ()) 187 | 188 | let call ?ctx ?headers ?body ?chunked meth (uri : Uri.t) : 189 | (Response.t * Cohttp_lwt.Body.t) Lwt.t = 190 | let trace_id, parent, attrs = context_for ~uri ~meth in 191 | Otel_lwt.Trace.with_ "request" ~kind:Span_kind_client ?trace_id ?parent 192 | ~attrs (fun scope -> 193 | let headers = add_traceparent scope headers in 194 | let* res, body = C.call ?ctx ~headers ?body ?chunked meth uri in 195 | Otel.Scope.add_attrs scope (fun () -> 196 | let code = Response.status res in 197 | let code = Code.code_of_status code in 198 | [ "http.status_code", `Int code ]); 199 | Lwt.return (res, body)) 200 | 201 | let head ?ctx ?headers uri = 202 | let open Lwt.Infix in 203 | call ?ctx ?headers `HEAD uri >|= fst 204 | 205 | let get ?ctx ?headers uri = call ?ctx ?headers `GET uri 206 | 207 | let delete ?ctx ?body ?chunked ?headers uri = 208 | call ?ctx ?headers ?body ?chunked `DELETE uri 209 | 210 | let post ?ctx ?body ?chunked ?headers uri = 211 | call ?ctx ?headers ?body ?chunked `POST uri 212 | 213 | let put ?ctx ?body ?chunked ?headers uri = 214 | call ?ctx ?headers ?body ?chunked `PUT uri 215 | 216 | let patch ?ctx ?body ?chunked ?headers uri = 217 | call ?ctx ?headers ?body ?chunked `PATCH uri 218 | 219 | let post_form ?ctx ?headers ~params uri = 220 | let trace_id, parent, attrs = context_for ~uri ~meth:`POST in 221 | Otel_lwt.Trace.with_ "request" ~kind:Span_kind_client ?trace_id ?parent 222 | ~attrs (fun scope -> 223 | let headers = add_traceparent scope headers in 224 | let* res, body = C.post_form ?ctx ~headers ~params uri in 225 | Otel.Scope.add_attrs scope (fun () -> 226 | let code = Response.status res in 227 | let code = Code.code_of_status code in 228 | [ "http.status_code", `Int code ]); 229 | Lwt.return (res, body)) 230 | 231 | let callv = C.callv (* TODO *) 232 | end in 233 | (module Traced : Cohttp_lwt.S.Client) 234 | -------------------------------------------------------------------------------- /src/lwt/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name opentelemetry_lwt) 3 | (public_name opentelemetry-lwt) 4 | (synopsis "Lwt frontend for opentelemetry") 5 | (preprocess 6 | (pps lwt_ppx)) 7 | (libraries lwt opentelemetry)) 8 | -------------------------------------------------------------------------------- /src/lwt/opentelemetry_lwt.ml: -------------------------------------------------------------------------------- 1 | open Opentelemetry 2 | open Lwt.Syntax 3 | module Span_id = Span_id 4 | module Trace_id = Trace_id 5 | module Event = Event 6 | module Span = Span 7 | module Span_link = Span_link 8 | module Globals = Globals 9 | module Timestamp_ns = Timestamp_ns 10 | module GC_metrics = GC_metrics 11 | module Metrics_callbacks = Metrics_callbacks 12 | module Trace_context = Trace_context 13 | 14 | external reraise : exn -> 'a = "%reraise" 15 | (** This is equivalent to [Lwt.reraise]. We inline it here so we don't force to 16 | use Lwt's latest version *) 17 | 18 | module Trace = struct 19 | include Trace 20 | 21 | (** Sync span guard *) 22 | let with_ ?force_new_trace_id ?trace_state ?service_name ?attrs ?kind 23 | ?trace_id ?parent ?scope ?links name (cb : Scope.t -> 'a Lwt.t) : 'a Lwt.t 24 | = 25 | let thunk, finally = 26 | with_' ?force_new_trace_id ?trace_state ?service_name ?attrs ?kind 27 | ?trace_id ?parent ?scope ?links name cb 28 | in 29 | 30 | try%lwt 31 | let* rv = thunk () in 32 | let () = finally (Ok ()) in 33 | Lwt.return rv 34 | with e -> 35 | let bt = Printexc.get_raw_backtrace () in 36 | let () = finally (Error (e, bt)) in 37 | reraise e 38 | end 39 | 40 | module Metrics = struct 41 | include Metrics 42 | end 43 | 44 | module Logs = struct 45 | include Proto.Logs 46 | include Logs 47 | end 48 | -------------------------------------------------------------------------------- /src/proto/.ocamlformat-ignore: -------------------------------------------------------------------------------- 1 | * 2 | -------------------------------------------------------------------------------- /src/proto/common.ml: -------------------------------------------------------------------------------- 1 | [@@@ocaml.warning "-27-30-39"] 2 | 3 | type any_value = 4 | | String_value of string 5 | | Bool_value of bool 6 | | Int_value of int64 7 | | Double_value of float 8 | | Array_value of array_value 9 | | Kvlist_value of key_value_list 10 | | Bytes_value of bytes 11 | 12 | and array_value = { 13 | values : any_value list; 14 | } 15 | 16 | and key_value_list = { 17 | values : key_value list; 18 | } 19 | 20 | and key_value = { 21 | key : string; 22 | value : any_value option; 23 | } 24 | 25 | type instrumentation_scope = { 26 | name : string; 27 | version : string; 28 | attributes : key_value list; 29 | dropped_attributes_count : int32; 30 | } 31 | 32 | let rec default_any_value () : any_value = String_value ("") 33 | 34 | and default_array_value 35 | ?values:((values:any_value list) = []) 36 | () : array_value = { 37 | values; 38 | } 39 | 40 | and default_key_value_list 41 | ?values:((values:key_value list) = []) 42 | () : key_value_list = { 43 | values; 44 | } 45 | 46 | and default_key_value 47 | ?key:((key:string) = "") 48 | ?value:((value:any_value option) = None) 49 | () : key_value = { 50 | key; 51 | value; 52 | } 53 | 54 | let rec default_instrumentation_scope 55 | ?name:((name:string) = "") 56 | ?version:((version:string) = "") 57 | ?attributes:((attributes:key_value list) = []) 58 | ?dropped_attributes_count:((dropped_attributes_count:int32) = 0l) 59 | () : instrumentation_scope = { 60 | name; 61 | version; 62 | attributes; 63 | dropped_attributes_count; 64 | } 65 | 66 | type array_value_mutable = { 67 | mutable values : any_value list; 68 | } 69 | 70 | let default_array_value_mutable () : array_value_mutable = { 71 | values = []; 72 | } 73 | 74 | type key_value_list_mutable = { 75 | mutable values : key_value list; 76 | } 77 | 78 | let default_key_value_list_mutable () : key_value_list_mutable = { 79 | values = []; 80 | } 81 | 82 | type key_value_mutable = { 83 | mutable key : string; 84 | mutable value : any_value option; 85 | } 86 | 87 | let default_key_value_mutable () : key_value_mutable = { 88 | key = ""; 89 | value = None; 90 | } 91 | 92 | type instrumentation_scope_mutable = { 93 | mutable name : string; 94 | mutable version : string; 95 | mutable attributes : key_value list; 96 | mutable dropped_attributes_count : int32; 97 | } 98 | 99 | let default_instrumentation_scope_mutable () : instrumentation_scope_mutable = { 100 | name = ""; 101 | version = ""; 102 | attributes = []; 103 | dropped_attributes_count = 0l; 104 | } 105 | 106 | 107 | (** {2 Make functions} *) 108 | 109 | 110 | let rec make_array_value 111 | ~(values:any_value list) 112 | () : array_value = { 113 | values; 114 | } 115 | 116 | and make_key_value_list 117 | ~(values:key_value list) 118 | () : key_value_list = { 119 | values; 120 | } 121 | 122 | and make_key_value 123 | ~(key:string) 124 | ?value:((value:any_value option) = None) 125 | () : key_value = { 126 | key; 127 | value; 128 | } 129 | 130 | let rec make_instrumentation_scope 131 | ~(name:string) 132 | ~(version:string) 133 | ~(attributes:key_value list) 134 | ~(dropped_attributes_count:int32) 135 | () : instrumentation_scope = { 136 | name; 137 | version; 138 | attributes; 139 | dropped_attributes_count; 140 | } 141 | 142 | [@@@ocaml.warning "-27-30-39"] 143 | 144 | (** {2 Formatters} *) 145 | 146 | let rec pp_any_value fmt (v:any_value) = 147 | match v with 148 | | String_value x -> Format.fprintf fmt "@[String_value(@,%a)@]" Pbrt.Pp.pp_string x 149 | | Bool_value x -> Format.fprintf fmt "@[Bool_value(@,%a)@]" Pbrt.Pp.pp_bool x 150 | | Int_value x -> Format.fprintf fmt "@[Int_value(@,%a)@]" Pbrt.Pp.pp_int64 x 151 | | Double_value x -> Format.fprintf fmt "@[Double_value(@,%a)@]" Pbrt.Pp.pp_float x 152 | | Array_value x -> Format.fprintf fmt "@[Array_value(@,%a)@]" pp_array_value x 153 | | Kvlist_value x -> Format.fprintf fmt "@[Kvlist_value(@,%a)@]" pp_key_value_list x 154 | | Bytes_value x -> Format.fprintf fmt "@[Bytes_value(@,%a)@]" Pbrt.Pp.pp_bytes x 155 | 156 | and pp_array_value fmt (v:array_value) = 157 | let pp_i fmt () = 158 | Pbrt.Pp.pp_record_field ~first:true "values" (Pbrt.Pp.pp_list pp_any_value) fmt v.values; 159 | in 160 | Pbrt.Pp.pp_brk pp_i fmt () 161 | 162 | and pp_key_value_list fmt (v:key_value_list) = 163 | let pp_i fmt () = 164 | Pbrt.Pp.pp_record_field ~first:true "values" (Pbrt.Pp.pp_list pp_key_value) fmt v.values; 165 | in 166 | Pbrt.Pp.pp_brk pp_i fmt () 167 | 168 | and pp_key_value fmt (v:key_value) = 169 | let pp_i fmt () = 170 | Pbrt.Pp.pp_record_field ~first:true "key" Pbrt.Pp.pp_string fmt v.key; 171 | Pbrt.Pp.pp_record_field ~first:false "value" (Pbrt.Pp.pp_option pp_any_value) fmt v.value; 172 | in 173 | Pbrt.Pp.pp_brk pp_i fmt () 174 | 175 | let rec pp_instrumentation_scope fmt (v:instrumentation_scope) = 176 | let pp_i fmt () = 177 | Pbrt.Pp.pp_record_field ~first:true "name" Pbrt.Pp.pp_string fmt v.name; 178 | Pbrt.Pp.pp_record_field ~first:false "version" Pbrt.Pp.pp_string fmt v.version; 179 | Pbrt.Pp.pp_record_field ~first:false "attributes" (Pbrt.Pp.pp_list pp_key_value) fmt v.attributes; 180 | Pbrt.Pp.pp_record_field ~first:false "dropped_attributes_count" Pbrt.Pp.pp_int32 fmt v.dropped_attributes_count; 181 | in 182 | Pbrt.Pp.pp_brk pp_i fmt () 183 | 184 | [@@@ocaml.warning "-27-30-39"] 185 | 186 | (** {2 Protobuf Encoding} *) 187 | 188 | let rec encode_pb_any_value (v:any_value) encoder = 189 | begin match v with 190 | | String_value x -> 191 | Pbrt.Encoder.string x encoder; 192 | Pbrt.Encoder.key 1 Pbrt.Bytes encoder; 193 | | Bool_value x -> 194 | Pbrt.Encoder.bool x encoder; 195 | Pbrt.Encoder.key 2 Pbrt.Varint encoder; 196 | | Int_value x -> 197 | Pbrt.Encoder.int64_as_varint x encoder; 198 | Pbrt.Encoder.key 3 Pbrt.Varint encoder; 199 | | Double_value x -> 200 | Pbrt.Encoder.float_as_bits64 x encoder; 201 | Pbrt.Encoder.key 4 Pbrt.Bits64 encoder; 202 | | Array_value x -> 203 | Pbrt.Encoder.nested encode_pb_array_value x encoder; 204 | Pbrt.Encoder.key 5 Pbrt.Bytes encoder; 205 | | Kvlist_value x -> 206 | Pbrt.Encoder.nested encode_pb_key_value_list x encoder; 207 | Pbrt.Encoder.key 6 Pbrt.Bytes encoder; 208 | | Bytes_value x -> 209 | Pbrt.Encoder.bytes x encoder; 210 | Pbrt.Encoder.key 7 Pbrt.Bytes encoder; 211 | end 212 | 213 | and encode_pb_array_value (v:array_value) encoder = 214 | Pbrt.List_util.rev_iter_with (fun x encoder -> 215 | Pbrt.Encoder.nested encode_pb_any_value x encoder; 216 | Pbrt.Encoder.key 1 Pbrt.Bytes encoder; 217 | ) v.values encoder; 218 | () 219 | 220 | and encode_pb_key_value_list (v:key_value_list) encoder = 221 | Pbrt.List_util.rev_iter_with (fun x encoder -> 222 | Pbrt.Encoder.nested encode_pb_key_value x encoder; 223 | Pbrt.Encoder.key 1 Pbrt.Bytes encoder; 224 | ) v.values encoder; 225 | () 226 | 227 | and encode_pb_key_value (v:key_value) encoder = 228 | Pbrt.Encoder.string v.key encoder; 229 | Pbrt.Encoder.key 1 Pbrt.Bytes encoder; 230 | begin match v.value with 231 | | Some x -> 232 | Pbrt.Encoder.nested encode_pb_any_value x encoder; 233 | Pbrt.Encoder.key 2 Pbrt.Bytes encoder; 234 | | None -> (); 235 | end; 236 | () 237 | 238 | let rec encode_pb_instrumentation_scope (v:instrumentation_scope) encoder = 239 | Pbrt.Encoder.string v.name encoder; 240 | Pbrt.Encoder.key 1 Pbrt.Bytes encoder; 241 | Pbrt.Encoder.string v.version encoder; 242 | Pbrt.Encoder.key 2 Pbrt.Bytes encoder; 243 | Pbrt.List_util.rev_iter_with (fun x encoder -> 244 | Pbrt.Encoder.nested encode_pb_key_value x encoder; 245 | Pbrt.Encoder.key 3 Pbrt.Bytes encoder; 246 | ) v.attributes encoder; 247 | Pbrt.Encoder.int32_as_varint v.dropped_attributes_count encoder; 248 | Pbrt.Encoder.key 4 Pbrt.Varint encoder; 249 | () 250 | 251 | [@@@ocaml.warning "-27-30-39"] 252 | 253 | (** {2 Protobuf Decoding} *) 254 | 255 | let rec decode_pb_any_value d = 256 | let rec loop () = 257 | let ret:any_value = match Pbrt.Decoder.key d with 258 | | None -> Pbrt.Decoder.malformed_variant "any_value" 259 | | Some (1, _) -> (String_value (Pbrt.Decoder.string d) : any_value) 260 | | Some (2, _) -> (Bool_value (Pbrt.Decoder.bool d) : any_value) 261 | | Some (3, _) -> (Int_value (Pbrt.Decoder.int64_as_varint d) : any_value) 262 | | Some (4, _) -> (Double_value (Pbrt.Decoder.float_as_bits64 d) : any_value) 263 | | Some (5, _) -> (Array_value (decode_pb_array_value (Pbrt.Decoder.nested d)) : any_value) 264 | | Some (6, _) -> (Kvlist_value (decode_pb_key_value_list (Pbrt.Decoder.nested d)) : any_value) 265 | | Some (7, _) -> (Bytes_value (Pbrt.Decoder.bytes d) : any_value) 266 | | Some (n, payload_kind) -> ( 267 | Pbrt.Decoder.skip d payload_kind; 268 | loop () 269 | ) 270 | in 271 | ret 272 | in 273 | loop () 274 | 275 | and decode_pb_array_value d = 276 | let v = default_array_value_mutable () in 277 | let continue__= ref true in 278 | while !continue__ do 279 | match Pbrt.Decoder.key d with 280 | | None -> ( 281 | v.values <- List.rev v.values; 282 | ); continue__ := false 283 | | Some (1, Pbrt.Bytes) -> begin 284 | v.values <- (decode_pb_any_value (Pbrt.Decoder.nested d)) :: v.values; 285 | end 286 | | Some (1, pk) -> 287 | Pbrt.Decoder.unexpected_payload "Message(array_value), field(1)" pk 288 | | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind 289 | done; 290 | ({ 291 | values = v.values; 292 | } : array_value) 293 | 294 | and decode_pb_key_value_list d = 295 | let v = default_key_value_list_mutable () in 296 | let continue__= ref true in 297 | while !continue__ do 298 | match Pbrt.Decoder.key d with 299 | | None -> ( 300 | v.values <- List.rev v.values; 301 | ); continue__ := false 302 | | Some (1, Pbrt.Bytes) -> begin 303 | v.values <- (decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.values; 304 | end 305 | | Some (1, pk) -> 306 | Pbrt.Decoder.unexpected_payload "Message(key_value_list), field(1)" pk 307 | | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind 308 | done; 309 | ({ 310 | values = v.values; 311 | } : key_value_list) 312 | 313 | and decode_pb_key_value d = 314 | let v = default_key_value_mutable () in 315 | let continue__= ref true in 316 | while !continue__ do 317 | match Pbrt.Decoder.key d with 318 | | None -> ( 319 | ); continue__ := false 320 | | Some (1, Pbrt.Bytes) -> begin 321 | v.key <- Pbrt.Decoder.string d; 322 | end 323 | | Some (1, pk) -> 324 | Pbrt.Decoder.unexpected_payload "Message(key_value), field(1)" pk 325 | | Some (2, Pbrt.Bytes) -> begin 326 | v.value <- Some (decode_pb_any_value (Pbrt.Decoder.nested d)); 327 | end 328 | | Some (2, pk) -> 329 | Pbrt.Decoder.unexpected_payload "Message(key_value), field(2)" pk 330 | | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind 331 | done; 332 | ({ 333 | key = v.key; 334 | value = v.value; 335 | } : key_value) 336 | 337 | let rec decode_pb_instrumentation_scope d = 338 | let v = default_instrumentation_scope_mutable () in 339 | let continue__= ref true in 340 | while !continue__ do 341 | match Pbrt.Decoder.key d with 342 | | None -> ( 343 | v.attributes <- List.rev v.attributes; 344 | ); continue__ := false 345 | | Some (1, Pbrt.Bytes) -> begin 346 | v.name <- Pbrt.Decoder.string d; 347 | end 348 | | Some (1, pk) -> 349 | Pbrt.Decoder.unexpected_payload "Message(instrumentation_scope), field(1)" pk 350 | | Some (2, Pbrt.Bytes) -> begin 351 | v.version <- Pbrt.Decoder.string d; 352 | end 353 | | Some (2, pk) -> 354 | Pbrt.Decoder.unexpected_payload "Message(instrumentation_scope), field(2)" pk 355 | | Some (3, Pbrt.Bytes) -> begin 356 | v.attributes <- (decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes; 357 | end 358 | | Some (3, pk) -> 359 | Pbrt.Decoder.unexpected_payload "Message(instrumentation_scope), field(3)" pk 360 | | Some (4, Pbrt.Varint) -> begin 361 | v.dropped_attributes_count <- Pbrt.Decoder.int32_as_varint d; 362 | end 363 | | Some (4, pk) -> 364 | Pbrt.Decoder.unexpected_payload "Message(instrumentation_scope), field(4)" pk 365 | | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind 366 | done; 367 | ({ 368 | name = v.name; 369 | version = v.version; 370 | attributes = v.attributes; 371 | dropped_attributes_count = v.dropped_attributes_count; 372 | } : instrumentation_scope) 373 | -------------------------------------------------------------------------------- /src/proto/common.mli: -------------------------------------------------------------------------------- 1 | 2 | (** Code for common.proto *) 3 | 4 | (* generated from "../../vendor/opentelemetry-proto/opentelemetry/proto/common/v1/common.proto", do not edit *) 5 | 6 | 7 | 8 | (** {2 Types} *) 9 | 10 | type any_value = 11 | | String_value of string 12 | | Bool_value of bool 13 | | Int_value of int64 14 | | Double_value of float 15 | | Array_value of array_value 16 | | Kvlist_value of key_value_list 17 | | Bytes_value of bytes 18 | 19 | and array_value = { 20 | values : any_value list; 21 | } 22 | 23 | and key_value_list = { 24 | values : key_value list; 25 | } 26 | 27 | and key_value = { 28 | key : string; 29 | value : any_value option; 30 | } 31 | 32 | type instrumentation_scope = { 33 | name : string; 34 | version : string; 35 | attributes : key_value list; 36 | dropped_attributes_count : int32; 37 | } 38 | 39 | 40 | (** {2 Basic values} *) 41 | 42 | val default_any_value : unit -> any_value 43 | (** [default_any_value ()] is the default value for type [any_value] *) 44 | 45 | val default_array_value : 46 | ?values:any_value list -> 47 | unit -> 48 | array_value 49 | (** [default_array_value ()] is the default value for type [array_value] *) 50 | 51 | val default_key_value_list : 52 | ?values:key_value list -> 53 | unit -> 54 | key_value_list 55 | (** [default_key_value_list ()] is the default value for type [key_value_list] *) 56 | 57 | val default_key_value : 58 | ?key:string -> 59 | ?value:any_value option -> 60 | unit -> 61 | key_value 62 | (** [default_key_value ()] is the default value for type [key_value] *) 63 | 64 | val default_instrumentation_scope : 65 | ?name:string -> 66 | ?version:string -> 67 | ?attributes:key_value list -> 68 | ?dropped_attributes_count:int32 -> 69 | unit -> 70 | instrumentation_scope 71 | (** [default_instrumentation_scope ()] is the default value for type [instrumentation_scope] *) 72 | 73 | 74 | (** {2 Make functions} *) 75 | 76 | 77 | val make_array_value : 78 | values:any_value list -> 79 | unit -> 80 | array_value 81 | (** [make_array_value … ()] is a builder for type [array_value] *) 82 | 83 | val make_key_value_list : 84 | values:key_value list -> 85 | unit -> 86 | key_value_list 87 | (** [make_key_value_list … ()] is a builder for type [key_value_list] *) 88 | 89 | val make_key_value : 90 | key:string -> 91 | ?value:any_value option -> 92 | unit -> 93 | key_value 94 | (** [make_key_value … ()] is a builder for type [key_value] *) 95 | 96 | val make_instrumentation_scope : 97 | name:string -> 98 | version:string -> 99 | attributes:key_value list -> 100 | dropped_attributes_count:int32 -> 101 | unit -> 102 | instrumentation_scope 103 | (** [make_instrumentation_scope … ()] is a builder for type [instrumentation_scope] *) 104 | 105 | 106 | (** {2 Formatters} *) 107 | 108 | val pp_any_value : Format.formatter -> any_value -> unit 109 | (** [pp_any_value v] formats v *) 110 | 111 | val pp_array_value : Format.formatter -> array_value -> unit 112 | (** [pp_array_value v] formats v *) 113 | 114 | val pp_key_value_list : Format.formatter -> key_value_list -> unit 115 | (** [pp_key_value_list v] formats v *) 116 | 117 | val pp_key_value : Format.formatter -> key_value -> unit 118 | (** [pp_key_value v] formats v *) 119 | 120 | val pp_instrumentation_scope : Format.formatter -> instrumentation_scope -> unit 121 | (** [pp_instrumentation_scope v] formats v *) 122 | 123 | 124 | (** {2 Protobuf Encoding} *) 125 | 126 | val encode_pb_any_value : any_value -> Pbrt.Encoder.t -> unit 127 | (** [encode_pb_any_value v encoder] encodes [v] with the given [encoder] *) 128 | 129 | val encode_pb_array_value : array_value -> Pbrt.Encoder.t -> unit 130 | (** [encode_pb_array_value v encoder] encodes [v] with the given [encoder] *) 131 | 132 | val encode_pb_key_value_list : key_value_list -> Pbrt.Encoder.t -> unit 133 | (** [encode_pb_key_value_list v encoder] encodes [v] with the given [encoder] *) 134 | 135 | val encode_pb_key_value : key_value -> Pbrt.Encoder.t -> unit 136 | (** [encode_pb_key_value v encoder] encodes [v] with the given [encoder] *) 137 | 138 | val encode_pb_instrumentation_scope : instrumentation_scope -> Pbrt.Encoder.t -> unit 139 | (** [encode_pb_instrumentation_scope v encoder] encodes [v] with the given [encoder] *) 140 | 141 | 142 | (** {2 Protobuf Decoding} *) 143 | 144 | val decode_pb_any_value : Pbrt.Decoder.t -> any_value 145 | (** [decode_pb_any_value decoder] decodes a [any_value] binary value from [decoder] *) 146 | 147 | val decode_pb_array_value : Pbrt.Decoder.t -> array_value 148 | (** [decode_pb_array_value decoder] decodes a [array_value] binary value from [decoder] *) 149 | 150 | val decode_pb_key_value_list : Pbrt.Decoder.t -> key_value_list 151 | (** [decode_pb_key_value_list decoder] decodes a [key_value_list] binary value from [decoder] *) 152 | 153 | val decode_pb_key_value : Pbrt.Decoder.t -> key_value 154 | (** [decode_pb_key_value decoder] decodes a [key_value] binary value from [decoder] *) 155 | 156 | val decode_pb_instrumentation_scope : Pbrt.Decoder.t -> instrumentation_scope 157 | (** [decode_pb_instrumentation_scope decoder] decodes a [instrumentation_scope] binary value from [decoder] *) 158 | -------------------------------------------------------------------------------- /src/proto/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name opentelemetry_proto) 3 | (public_name opentelemetry.proto) 4 | (synopsis "Protobuf generated code for opentelemetry") 5 | (flags :standard -warn-error -a+8) 6 | (libraries pbrt)) 7 | 8 | ; ### protobuf rules ### 9 | 10 | (rule 11 | (alias lint) 12 | (mode promote) 13 | (enabled_if %{env:FORCE_GENPROTO=false}) 14 | (targets status.ml status.mli) 15 | (deps 16 | (:file status.proto) 17 | (source_tree %{project_root}/vendor/opentelemetry-proto/)) 18 | (action 19 | (run ocaml-protoc %{file} --ml_out . --pp --make --binary))) 20 | 21 | (rule 22 | (alias lint) 23 | (mode promote) 24 | (enabled_if %{env:FORCE_GENPROTO=false}) 25 | (targets common.ml common.mli) 26 | (deps 27 | (:file 28 | %{project_root}/vendor/opentelemetry-proto/opentelemetry/proto/common/v1/common.proto) 29 | (source_tree %{project_root}/vendor/opentelemetry-proto/)) 30 | (action 31 | (run 32 | ocaml-protoc 33 | %{file} 34 | -I 35 | %{project_root}/vendor/opentelemetry-proto/ 36 | --ml_out 37 | . 38 | --pp 39 | --make 40 | --binary))) 41 | 42 | (rule 43 | (alias lint) 44 | (mode promote) 45 | (enabled_if %{env:FORCE_GENPROTO=false}) 46 | (targets resource.ml resource.mli) 47 | (deps 48 | (:file 49 | %{project_root}/vendor/opentelemetry-proto/opentelemetry/proto/resource/v1/resource.proto) 50 | (source_tree %{project_root}/vendor/opentelemetry-proto/)) 51 | (action 52 | (run 53 | ocaml-protoc 54 | %{file} 55 | -I 56 | %{project_root}/vendor/opentelemetry-proto/ 57 | --ml_out 58 | . 59 | --pp 60 | --make 61 | --binary))) 62 | 63 | (rule 64 | (alias lint) 65 | (mode promote) 66 | (enabled_if %{env:FORCE_GENPROTO=false}) 67 | (targets trace.ml trace.mli) 68 | (deps 69 | (:file 70 | %{project_root}/vendor/opentelemetry-proto/opentelemetry/proto/trace/v1/trace.proto) 71 | (source_tree %{project_root}/vendor/opentelemetry-proto/)) 72 | (action 73 | (run 74 | ocaml-protoc 75 | %{file} 76 | -I 77 | %{project_root}/vendor/opentelemetry-proto/ 78 | --ml_out 79 | . 80 | --pp 81 | --make 82 | --binary))) 83 | 84 | (rule 85 | (alias lint) 86 | (mode promote) 87 | (enabled_if %{env:FORCE_GENPROTO=false}) 88 | (targets metrics.ml metrics.mli) 89 | (deps 90 | (:file 91 | %{project_root}/vendor/opentelemetry-proto/opentelemetry/proto/metrics/v1/metrics.proto) 92 | (source_tree %{project_root}/vendor/opentelemetry-proto/)) 93 | (action 94 | (run 95 | ocaml-protoc 96 | %{file} 97 | -I 98 | %{project_root}/vendor/opentelemetry-proto/ 99 | --ml_out 100 | . 101 | --pp 102 | --make 103 | --binary))) 104 | 105 | (rule 106 | (alias lint) 107 | (mode promote) 108 | (enabled_if %{env:FORCE_GENPROTO=false}) 109 | (targets logs.ml logs.mli) 110 | (deps 111 | (:file 112 | %{project_root}/vendor/opentelemetry-proto/opentelemetry/proto/logs/v1/logs.proto) 113 | (source_tree %{project_root}/vendor/opentelemetry-proto/)) 114 | (action 115 | (run 116 | ocaml-protoc 117 | %{file} 118 | -I 119 | %{project_root}/vendor/opentelemetry-proto/ 120 | --ml_out 121 | . 122 | --pp 123 | --make 124 | --binary))) 125 | 126 | (rule 127 | (alias lint) 128 | (mode promote) 129 | (enabled_if %{env:FORCE_GENPROTO=false}) 130 | (targets metrics_service.ml metrics_service.mli) 131 | (deps 132 | (:file 133 | %{project_root}/vendor/opentelemetry-proto/opentelemetry/proto/collector/metrics/v1/metrics_service.proto) 134 | (source_tree %{project_root}/vendor/opentelemetry-proto/)) 135 | (action 136 | (run 137 | ocaml-protoc 138 | %{file} 139 | -I 140 | %{project_root}/vendor/opentelemetry-proto/ 141 | --ml_out 142 | . 143 | --pp 144 | --make 145 | --binary))) 146 | 147 | (rule 148 | (alias lint) 149 | (mode promote) 150 | (enabled_if %{env:FORCE_GENPROTO=false}) 151 | (targets trace_service.ml trace_service.mli) 152 | (deps 153 | (:file 154 | %{project_root}/vendor/opentelemetry-proto/opentelemetry/proto/collector/trace/v1/trace_service.proto) 155 | (source_tree %{project_root}/vendor/opentelemetry-proto/)) 156 | (action 157 | (run 158 | ocaml-protoc 159 | %{file} 160 | -I 161 | %{project_root}/vendor/opentelemetry-proto/ 162 | --ml_out 163 | . 164 | --pp 165 | --make 166 | --binary))) 167 | 168 | (rule 169 | (alias lint) 170 | (mode promote) 171 | (enabled_if %{env:FORCE_GENPROTO=false}) 172 | (targets logs_service.ml logs_service.mli) 173 | (deps 174 | (:file 175 | %{project_root}/vendor/opentelemetry-proto/opentelemetry/proto/collector/logs/v1/logs_service.proto) 176 | (source_tree %{project_root}/vendor/opentelemetry-proto/)) 177 | (action 178 | (run 179 | ocaml-protoc 180 | %{file} 181 | -I 182 | %{project_root}/vendor/opentelemetry-proto/ 183 | --ml_out 184 | . 185 | --pp 186 | --make 187 | --binary))) 188 | -------------------------------------------------------------------------------- /src/proto/logs.mli: -------------------------------------------------------------------------------- 1 | 2 | (** Code for logs.proto *) 3 | 4 | (* generated from "../../vendor/opentelemetry-proto/opentelemetry/proto/logs/v1/logs.proto", do not edit *) 5 | 6 | 7 | 8 | (** {2 Types} *) 9 | 10 | type severity_number = 11 | | Severity_number_unspecified 12 | | Severity_number_trace 13 | | Severity_number_trace2 14 | | Severity_number_trace3 15 | | Severity_number_trace4 16 | | Severity_number_debug 17 | | Severity_number_debug2 18 | | Severity_number_debug3 19 | | Severity_number_debug4 20 | | Severity_number_info 21 | | Severity_number_info2 22 | | Severity_number_info3 23 | | Severity_number_info4 24 | | Severity_number_warn 25 | | Severity_number_warn2 26 | | Severity_number_warn3 27 | | Severity_number_warn4 28 | | Severity_number_error 29 | | Severity_number_error2 30 | | Severity_number_error3 31 | | Severity_number_error4 32 | | Severity_number_fatal 33 | | Severity_number_fatal2 34 | | Severity_number_fatal3 35 | | Severity_number_fatal4 36 | 37 | type log_record = { 38 | time_unix_nano : int64; 39 | observed_time_unix_nano : int64; 40 | severity_number : severity_number; 41 | severity_text : string; 42 | body : Common.any_value option; 43 | attributes : Common.key_value list; 44 | dropped_attributes_count : int32; 45 | flags : int32; 46 | trace_id : bytes; 47 | span_id : bytes; 48 | } 49 | 50 | type scope_logs = { 51 | scope : Common.instrumentation_scope option; 52 | log_records : log_record list; 53 | schema_url : string; 54 | } 55 | 56 | type resource_logs = { 57 | resource : Resource.resource option; 58 | scope_logs : scope_logs list; 59 | schema_url : string; 60 | } 61 | 62 | type logs_data = { 63 | resource_logs : resource_logs list; 64 | } 65 | 66 | type log_record_flags = 67 | | Log_record_flags_do_not_use 68 | | Log_record_flags_trace_flags_mask 69 | 70 | 71 | (** {2 Basic values} *) 72 | 73 | val default_severity_number : unit -> severity_number 74 | (** [default_severity_number ()] is the default value for type [severity_number] *) 75 | 76 | val default_log_record : 77 | ?time_unix_nano:int64 -> 78 | ?observed_time_unix_nano:int64 -> 79 | ?severity_number:severity_number -> 80 | ?severity_text:string -> 81 | ?body:Common.any_value option -> 82 | ?attributes:Common.key_value list -> 83 | ?dropped_attributes_count:int32 -> 84 | ?flags:int32 -> 85 | ?trace_id:bytes -> 86 | ?span_id:bytes -> 87 | unit -> 88 | log_record 89 | (** [default_log_record ()] is the default value for type [log_record] *) 90 | 91 | val default_scope_logs : 92 | ?scope:Common.instrumentation_scope option -> 93 | ?log_records:log_record list -> 94 | ?schema_url:string -> 95 | unit -> 96 | scope_logs 97 | (** [default_scope_logs ()] is the default value for type [scope_logs] *) 98 | 99 | val default_resource_logs : 100 | ?resource:Resource.resource option -> 101 | ?scope_logs:scope_logs list -> 102 | ?schema_url:string -> 103 | unit -> 104 | resource_logs 105 | (** [default_resource_logs ()] is the default value for type [resource_logs] *) 106 | 107 | val default_logs_data : 108 | ?resource_logs:resource_logs list -> 109 | unit -> 110 | logs_data 111 | (** [default_logs_data ()] is the default value for type [logs_data] *) 112 | 113 | val default_log_record_flags : unit -> log_record_flags 114 | (** [default_log_record_flags ()] is the default value for type [log_record_flags] *) 115 | 116 | 117 | (** {2 Make functions} *) 118 | 119 | 120 | val make_log_record : 121 | time_unix_nano:int64 -> 122 | observed_time_unix_nano:int64 -> 123 | severity_number:severity_number -> 124 | severity_text:string -> 125 | ?body:Common.any_value option -> 126 | attributes:Common.key_value list -> 127 | dropped_attributes_count:int32 -> 128 | flags:int32 -> 129 | trace_id:bytes -> 130 | span_id:bytes -> 131 | unit -> 132 | log_record 133 | (** [make_log_record … ()] is a builder for type [log_record] *) 134 | 135 | val make_scope_logs : 136 | ?scope:Common.instrumentation_scope option -> 137 | log_records:log_record list -> 138 | schema_url:string -> 139 | unit -> 140 | scope_logs 141 | (** [make_scope_logs … ()] is a builder for type [scope_logs] *) 142 | 143 | val make_resource_logs : 144 | ?resource:Resource.resource option -> 145 | scope_logs:scope_logs list -> 146 | schema_url:string -> 147 | unit -> 148 | resource_logs 149 | (** [make_resource_logs … ()] is a builder for type [resource_logs] *) 150 | 151 | val make_logs_data : 152 | resource_logs:resource_logs list -> 153 | unit -> 154 | logs_data 155 | (** [make_logs_data … ()] is a builder for type [logs_data] *) 156 | 157 | 158 | 159 | (** {2 Formatters} *) 160 | 161 | val pp_severity_number : Format.formatter -> severity_number -> unit 162 | (** [pp_severity_number v] formats v *) 163 | 164 | val pp_log_record : Format.formatter -> log_record -> unit 165 | (** [pp_log_record v] formats v *) 166 | 167 | val pp_scope_logs : Format.formatter -> scope_logs -> unit 168 | (** [pp_scope_logs v] formats v *) 169 | 170 | val pp_resource_logs : Format.formatter -> resource_logs -> unit 171 | (** [pp_resource_logs v] formats v *) 172 | 173 | val pp_logs_data : Format.formatter -> logs_data -> unit 174 | (** [pp_logs_data v] formats v *) 175 | 176 | val pp_log_record_flags : Format.formatter -> log_record_flags -> unit 177 | (** [pp_log_record_flags v] formats v *) 178 | 179 | 180 | (** {2 Protobuf Encoding} *) 181 | 182 | val encode_pb_severity_number : severity_number -> Pbrt.Encoder.t -> unit 183 | (** [encode_pb_severity_number v encoder] encodes [v] with the given [encoder] *) 184 | 185 | val encode_pb_log_record : log_record -> Pbrt.Encoder.t -> unit 186 | (** [encode_pb_log_record v encoder] encodes [v] with the given [encoder] *) 187 | 188 | val encode_pb_scope_logs : scope_logs -> Pbrt.Encoder.t -> unit 189 | (** [encode_pb_scope_logs v encoder] encodes [v] with the given [encoder] *) 190 | 191 | val encode_pb_resource_logs : resource_logs -> Pbrt.Encoder.t -> unit 192 | (** [encode_pb_resource_logs v encoder] encodes [v] with the given [encoder] *) 193 | 194 | val encode_pb_logs_data : logs_data -> Pbrt.Encoder.t -> unit 195 | (** [encode_pb_logs_data v encoder] encodes [v] with the given [encoder] *) 196 | 197 | val encode_pb_log_record_flags : log_record_flags -> Pbrt.Encoder.t -> unit 198 | (** [encode_pb_log_record_flags v encoder] encodes [v] with the given [encoder] *) 199 | 200 | 201 | (** {2 Protobuf Decoding} *) 202 | 203 | val decode_pb_severity_number : Pbrt.Decoder.t -> severity_number 204 | (** [decode_pb_severity_number decoder] decodes a [severity_number] binary value from [decoder] *) 205 | 206 | val decode_pb_log_record : Pbrt.Decoder.t -> log_record 207 | (** [decode_pb_log_record decoder] decodes a [log_record] binary value from [decoder] *) 208 | 209 | val decode_pb_scope_logs : Pbrt.Decoder.t -> scope_logs 210 | (** [decode_pb_scope_logs decoder] decodes a [scope_logs] binary value from [decoder] *) 211 | 212 | val decode_pb_resource_logs : Pbrt.Decoder.t -> resource_logs 213 | (** [decode_pb_resource_logs decoder] decodes a [resource_logs] binary value from [decoder] *) 214 | 215 | val decode_pb_logs_data : Pbrt.Decoder.t -> logs_data 216 | (** [decode_pb_logs_data decoder] decodes a [logs_data] binary value from [decoder] *) 217 | 218 | val decode_pb_log_record_flags : Pbrt.Decoder.t -> log_record_flags 219 | (** [decode_pb_log_record_flags decoder] decodes a [log_record_flags] binary value from [decoder] *) 220 | -------------------------------------------------------------------------------- /src/proto/logs_service.ml: -------------------------------------------------------------------------------- 1 | [@@@ocaml.warning "-27-30-39"] 2 | 3 | type export_logs_service_request = { 4 | resource_logs : Logs.resource_logs list; 5 | } 6 | 7 | type export_logs_partial_success = { 8 | rejected_log_records : int64; 9 | error_message : string; 10 | } 11 | 12 | type export_logs_service_response = { 13 | partial_success : export_logs_partial_success option; 14 | } 15 | 16 | let rec default_export_logs_service_request 17 | ?resource_logs:((resource_logs:Logs.resource_logs list) = []) 18 | () : export_logs_service_request = { 19 | resource_logs; 20 | } 21 | 22 | let rec default_export_logs_partial_success 23 | ?rejected_log_records:((rejected_log_records:int64) = 0L) 24 | ?error_message:((error_message:string) = "") 25 | () : export_logs_partial_success = { 26 | rejected_log_records; 27 | error_message; 28 | } 29 | 30 | let rec default_export_logs_service_response 31 | ?partial_success:((partial_success:export_logs_partial_success option) = None) 32 | () : export_logs_service_response = { 33 | partial_success; 34 | } 35 | 36 | type export_logs_service_request_mutable = { 37 | mutable resource_logs : Logs.resource_logs list; 38 | } 39 | 40 | let default_export_logs_service_request_mutable () : export_logs_service_request_mutable = { 41 | resource_logs = []; 42 | } 43 | 44 | type export_logs_partial_success_mutable = { 45 | mutable rejected_log_records : int64; 46 | mutable error_message : string; 47 | } 48 | 49 | let default_export_logs_partial_success_mutable () : export_logs_partial_success_mutable = { 50 | rejected_log_records = 0L; 51 | error_message = ""; 52 | } 53 | 54 | type export_logs_service_response_mutable = { 55 | mutable partial_success : export_logs_partial_success option; 56 | } 57 | 58 | let default_export_logs_service_response_mutable () : export_logs_service_response_mutable = { 59 | partial_success = None; 60 | } 61 | 62 | 63 | (** {2 Make functions} *) 64 | 65 | let rec make_export_logs_service_request 66 | ~(resource_logs:Logs.resource_logs list) 67 | () : export_logs_service_request = { 68 | resource_logs; 69 | } 70 | 71 | let rec make_export_logs_partial_success 72 | ~(rejected_log_records:int64) 73 | ~(error_message:string) 74 | () : export_logs_partial_success = { 75 | rejected_log_records; 76 | error_message; 77 | } 78 | 79 | let rec make_export_logs_service_response 80 | ?partial_success:((partial_success:export_logs_partial_success option) = None) 81 | () : export_logs_service_response = { 82 | partial_success; 83 | } 84 | 85 | [@@@ocaml.warning "-27-30-39"] 86 | 87 | (** {2 Formatters} *) 88 | 89 | let rec pp_export_logs_service_request fmt (v:export_logs_service_request) = 90 | let pp_i fmt () = 91 | Pbrt.Pp.pp_record_field ~first:true "resource_logs" (Pbrt.Pp.pp_list Logs.pp_resource_logs) fmt v.resource_logs; 92 | in 93 | Pbrt.Pp.pp_brk pp_i fmt () 94 | 95 | let rec pp_export_logs_partial_success fmt (v:export_logs_partial_success) = 96 | let pp_i fmt () = 97 | Pbrt.Pp.pp_record_field ~first:true "rejected_log_records" Pbrt.Pp.pp_int64 fmt v.rejected_log_records; 98 | Pbrt.Pp.pp_record_field ~first:false "error_message" Pbrt.Pp.pp_string fmt v.error_message; 99 | in 100 | Pbrt.Pp.pp_brk pp_i fmt () 101 | 102 | let rec pp_export_logs_service_response fmt (v:export_logs_service_response) = 103 | let pp_i fmt () = 104 | Pbrt.Pp.pp_record_field ~first:true "partial_success" (Pbrt.Pp.pp_option pp_export_logs_partial_success) fmt v.partial_success; 105 | in 106 | Pbrt.Pp.pp_brk pp_i fmt () 107 | 108 | [@@@ocaml.warning "-27-30-39"] 109 | 110 | (** {2 Protobuf Encoding} *) 111 | 112 | let rec encode_pb_export_logs_service_request (v:export_logs_service_request) encoder = 113 | Pbrt.List_util.rev_iter_with (fun x encoder -> 114 | Pbrt.Encoder.nested Logs.encode_pb_resource_logs x encoder; 115 | Pbrt.Encoder.key 1 Pbrt.Bytes encoder; 116 | ) v.resource_logs encoder; 117 | () 118 | 119 | let rec encode_pb_export_logs_partial_success (v:export_logs_partial_success) encoder = 120 | Pbrt.Encoder.int64_as_varint v.rejected_log_records encoder; 121 | Pbrt.Encoder.key 1 Pbrt.Varint encoder; 122 | Pbrt.Encoder.string v.error_message encoder; 123 | Pbrt.Encoder.key 2 Pbrt.Bytes encoder; 124 | () 125 | 126 | let rec encode_pb_export_logs_service_response (v:export_logs_service_response) encoder = 127 | begin match v.partial_success with 128 | | Some x -> 129 | Pbrt.Encoder.nested encode_pb_export_logs_partial_success x encoder; 130 | Pbrt.Encoder.key 1 Pbrt.Bytes encoder; 131 | | None -> (); 132 | end; 133 | () 134 | 135 | [@@@ocaml.warning "-27-30-39"] 136 | 137 | (** {2 Protobuf Decoding} *) 138 | 139 | let rec decode_pb_export_logs_service_request d = 140 | let v = default_export_logs_service_request_mutable () in 141 | let continue__= ref true in 142 | while !continue__ do 143 | match Pbrt.Decoder.key d with 144 | | None -> ( 145 | v.resource_logs <- List.rev v.resource_logs; 146 | ); continue__ := false 147 | | Some (1, Pbrt.Bytes) -> begin 148 | v.resource_logs <- (Logs.decode_pb_resource_logs (Pbrt.Decoder.nested d)) :: v.resource_logs; 149 | end 150 | | Some (1, pk) -> 151 | Pbrt.Decoder.unexpected_payload "Message(export_logs_service_request), field(1)" pk 152 | | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind 153 | done; 154 | ({ 155 | resource_logs = v.resource_logs; 156 | } : export_logs_service_request) 157 | 158 | let rec decode_pb_export_logs_partial_success d = 159 | let v = default_export_logs_partial_success_mutable () in 160 | let continue__= ref true in 161 | while !continue__ do 162 | match Pbrt.Decoder.key d with 163 | | None -> ( 164 | ); continue__ := false 165 | | Some (1, Pbrt.Varint) -> begin 166 | v.rejected_log_records <- Pbrt.Decoder.int64_as_varint d; 167 | end 168 | | Some (1, pk) -> 169 | Pbrt.Decoder.unexpected_payload "Message(export_logs_partial_success), field(1)" pk 170 | | Some (2, Pbrt.Bytes) -> begin 171 | v.error_message <- Pbrt.Decoder.string d; 172 | end 173 | | Some (2, pk) -> 174 | Pbrt.Decoder.unexpected_payload "Message(export_logs_partial_success), field(2)" pk 175 | | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind 176 | done; 177 | ({ 178 | rejected_log_records = v.rejected_log_records; 179 | error_message = v.error_message; 180 | } : export_logs_partial_success) 181 | 182 | let rec decode_pb_export_logs_service_response d = 183 | let v = default_export_logs_service_response_mutable () in 184 | let continue__= ref true in 185 | while !continue__ do 186 | match Pbrt.Decoder.key d with 187 | | None -> ( 188 | ); continue__ := false 189 | | Some (1, Pbrt.Bytes) -> begin 190 | v.partial_success <- Some (decode_pb_export_logs_partial_success (Pbrt.Decoder.nested d)); 191 | end 192 | | Some (1, pk) -> 193 | Pbrt.Decoder.unexpected_payload "Message(export_logs_service_response), field(1)" pk 194 | | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind 195 | done; 196 | ({ 197 | partial_success = v.partial_success; 198 | } : export_logs_service_response) 199 | -------------------------------------------------------------------------------- /src/proto/logs_service.mli: -------------------------------------------------------------------------------- 1 | 2 | (** Code for logs_service.proto *) 3 | 4 | (* generated from "../../vendor/opentelemetry-proto/opentelemetry/proto/collector/logs/v1/logs_service.proto", do not edit *) 5 | 6 | 7 | 8 | (** {2 Types} *) 9 | 10 | type export_logs_service_request = { 11 | resource_logs : Logs.resource_logs list; 12 | } 13 | 14 | type export_logs_partial_success = { 15 | rejected_log_records : int64; 16 | error_message : string; 17 | } 18 | 19 | type export_logs_service_response = { 20 | partial_success : export_logs_partial_success option; 21 | } 22 | 23 | 24 | (** {2 Basic values} *) 25 | 26 | val default_export_logs_service_request : 27 | ?resource_logs:Logs.resource_logs list -> 28 | unit -> 29 | export_logs_service_request 30 | (** [default_export_logs_service_request ()] is the default value for type [export_logs_service_request] *) 31 | 32 | val default_export_logs_partial_success : 33 | ?rejected_log_records:int64 -> 34 | ?error_message:string -> 35 | unit -> 36 | export_logs_partial_success 37 | (** [default_export_logs_partial_success ()] is the default value for type [export_logs_partial_success] *) 38 | 39 | val default_export_logs_service_response : 40 | ?partial_success:export_logs_partial_success option -> 41 | unit -> 42 | export_logs_service_response 43 | (** [default_export_logs_service_response ()] is the default value for type [export_logs_service_response] *) 44 | 45 | 46 | (** {2 Make functions} *) 47 | 48 | val make_export_logs_service_request : 49 | resource_logs:Logs.resource_logs list -> 50 | unit -> 51 | export_logs_service_request 52 | (** [make_export_logs_service_request … ()] is a builder for type [export_logs_service_request] *) 53 | 54 | val make_export_logs_partial_success : 55 | rejected_log_records:int64 -> 56 | error_message:string -> 57 | unit -> 58 | export_logs_partial_success 59 | (** [make_export_logs_partial_success … ()] is a builder for type [export_logs_partial_success] *) 60 | 61 | val make_export_logs_service_response : 62 | ?partial_success:export_logs_partial_success option -> 63 | unit -> 64 | export_logs_service_response 65 | (** [make_export_logs_service_response … ()] is a builder for type [export_logs_service_response] *) 66 | 67 | 68 | (** {2 Formatters} *) 69 | 70 | val pp_export_logs_service_request : Format.formatter -> export_logs_service_request -> unit 71 | (** [pp_export_logs_service_request v] formats v *) 72 | 73 | val pp_export_logs_partial_success : Format.formatter -> export_logs_partial_success -> unit 74 | (** [pp_export_logs_partial_success v] formats v *) 75 | 76 | val pp_export_logs_service_response : Format.formatter -> export_logs_service_response -> unit 77 | (** [pp_export_logs_service_response v] formats v *) 78 | 79 | 80 | (** {2 Protobuf Encoding} *) 81 | 82 | val encode_pb_export_logs_service_request : export_logs_service_request -> Pbrt.Encoder.t -> unit 83 | (** [encode_pb_export_logs_service_request v encoder] encodes [v] with the given [encoder] *) 84 | 85 | val encode_pb_export_logs_partial_success : export_logs_partial_success -> Pbrt.Encoder.t -> unit 86 | (** [encode_pb_export_logs_partial_success v encoder] encodes [v] with the given [encoder] *) 87 | 88 | val encode_pb_export_logs_service_response : export_logs_service_response -> Pbrt.Encoder.t -> unit 89 | (** [encode_pb_export_logs_service_response v encoder] encodes [v] with the given [encoder] *) 90 | 91 | 92 | (** {2 Protobuf Decoding} *) 93 | 94 | val decode_pb_export_logs_service_request : Pbrt.Decoder.t -> export_logs_service_request 95 | (** [decode_pb_export_logs_service_request decoder] decodes a [export_logs_service_request] binary value from [decoder] *) 96 | 97 | val decode_pb_export_logs_partial_success : Pbrt.Decoder.t -> export_logs_partial_success 98 | (** [decode_pb_export_logs_partial_success decoder] decodes a [export_logs_partial_success] binary value from [decoder] *) 99 | 100 | val decode_pb_export_logs_service_response : Pbrt.Decoder.t -> export_logs_service_response 101 | (** [decode_pb_export_logs_service_response decoder] decodes a [export_logs_service_response] binary value from [decoder] *) 102 | -------------------------------------------------------------------------------- /src/proto/metrics_service.ml: -------------------------------------------------------------------------------- 1 | [@@@ocaml.warning "-27-30-39"] 2 | 3 | type export_metrics_service_request = { 4 | resource_metrics : Metrics.resource_metrics list; 5 | } 6 | 7 | type export_metrics_partial_success = { 8 | rejected_data_points : int64; 9 | error_message : string; 10 | } 11 | 12 | type export_metrics_service_response = { 13 | partial_success : export_metrics_partial_success option; 14 | } 15 | 16 | let rec default_export_metrics_service_request 17 | ?resource_metrics:((resource_metrics:Metrics.resource_metrics list) = []) 18 | () : export_metrics_service_request = { 19 | resource_metrics; 20 | } 21 | 22 | let rec default_export_metrics_partial_success 23 | ?rejected_data_points:((rejected_data_points:int64) = 0L) 24 | ?error_message:((error_message:string) = "") 25 | () : export_metrics_partial_success = { 26 | rejected_data_points; 27 | error_message; 28 | } 29 | 30 | let rec default_export_metrics_service_response 31 | ?partial_success:((partial_success:export_metrics_partial_success option) = None) 32 | () : export_metrics_service_response = { 33 | partial_success; 34 | } 35 | 36 | type export_metrics_service_request_mutable = { 37 | mutable resource_metrics : Metrics.resource_metrics list; 38 | } 39 | 40 | let default_export_metrics_service_request_mutable () : export_metrics_service_request_mutable = { 41 | resource_metrics = []; 42 | } 43 | 44 | type export_metrics_partial_success_mutable = { 45 | mutable rejected_data_points : int64; 46 | mutable error_message : string; 47 | } 48 | 49 | let default_export_metrics_partial_success_mutable () : export_metrics_partial_success_mutable = { 50 | rejected_data_points = 0L; 51 | error_message = ""; 52 | } 53 | 54 | type export_metrics_service_response_mutable = { 55 | mutable partial_success : export_metrics_partial_success option; 56 | } 57 | 58 | let default_export_metrics_service_response_mutable () : export_metrics_service_response_mutable = { 59 | partial_success = None; 60 | } 61 | 62 | 63 | (** {2 Make functions} *) 64 | 65 | let rec make_export_metrics_service_request 66 | ~(resource_metrics:Metrics.resource_metrics list) 67 | () : export_metrics_service_request = { 68 | resource_metrics; 69 | } 70 | 71 | let rec make_export_metrics_partial_success 72 | ~(rejected_data_points:int64) 73 | ~(error_message:string) 74 | () : export_metrics_partial_success = { 75 | rejected_data_points; 76 | error_message; 77 | } 78 | 79 | let rec make_export_metrics_service_response 80 | ?partial_success:((partial_success:export_metrics_partial_success option) = None) 81 | () : export_metrics_service_response = { 82 | partial_success; 83 | } 84 | 85 | [@@@ocaml.warning "-27-30-39"] 86 | 87 | (** {2 Formatters} *) 88 | 89 | let rec pp_export_metrics_service_request fmt (v:export_metrics_service_request) = 90 | let pp_i fmt () = 91 | Pbrt.Pp.pp_record_field ~first:true "resource_metrics" (Pbrt.Pp.pp_list Metrics.pp_resource_metrics) fmt v.resource_metrics; 92 | in 93 | Pbrt.Pp.pp_brk pp_i fmt () 94 | 95 | let rec pp_export_metrics_partial_success fmt (v:export_metrics_partial_success) = 96 | let pp_i fmt () = 97 | Pbrt.Pp.pp_record_field ~first:true "rejected_data_points" Pbrt.Pp.pp_int64 fmt v.rejected_data_points; 98 | Pbrt.Pp.pp_record_field ~first:false "error_message" Pbrt.Pp.pp_string fmt v.error_message; 99 | in 100 | Pbrt.Pp.pp_brk pp_i fmt () 101 | 102 | let rec pp_export_metrics_service_response fmt (v:export_metrics_service_response) = 103 | let pp_i fmt () = 104 | Pbrt.Pp.pp_record_field ~first:true "partial_success" (Pbrt.Pp.pp_option pp_export_metrics_partial_success) fmt v.partial_success; 105 | in 106 | Pbrt.Pp.pp_brk pp_i fmt () 107 | 108 | [@@@ocaml.warning "-27-30-39"] 109 | 110 | (** {2 Protobuf Encoding} *) 111 | 112 | let rec encode_pb_export_metrics_service_request (v:export_metrics_service_request) encoder = 113 | Pbrt.List_util.rev_iter_with (fun x encoder -> 114 | Pbrt.Encoder.nested Metrics.encode_pb_resource_metrics x encoder; 115 | Pbrt.Encoder.key 1 Pbrt.Bytes encoder; 116 | ) v.resource_metrics encoder; 117 | () 118 | 119 | let rec encode_pb_export_metrics_partial_success (v:export_metrics_partial_success) encoder = 120 | Pbrt.Encoder.int64_as_varint v.rejected_data_points encoder; 121 | Pbrt.Encoder.key 1 Pbrt.Varint encoder; 122 | Pbrt.Encoder.string v.error_message encoder; 123 | Pbrt.Encoder.key 2 Pbrt.Bytes encoder; 124 | () 125 | 126 | let rec encode_pb_export_metrics_service_response (v:export_metrics_service_response) encoder = 127 | begin match v.partial_success with 128 | | Some x -> 129 | Pbrt.Encoder.nested encode_pb_export_metrics_partial_success x encoder; 130 | Pbrt.Encoder.key 1 Pbrt.Bytes encoder; 131 | | None -> (); 132 | end; 133 | () 134 | 135 | [@@@ocaml.warning "-27-30-39"] 136 | 137 | (** {2 Protobuf Decoding} *) 138 | 139 | let rec decode_pb_export_metrics_service_request d = 140 | let v = default_export_metrics_service_request_mutable () in 141 | let continue__= ref true in 142 | while !continue__ do 143 | match Pbrt.Decoder.key d with 144 | | None -> ( 145 | v.resource_metrics <- List.rev v.resource_metrics; 146 | ); continue__ := false 147 | | Some (1, Pbrt.Bytes) -> begin 148 | v.resource_metrics <- (Metrics.decode_pb_resource_metrics (Pbrt.Decoder.nested d)) :: v.resource_metrics; 149 | end 150 | | Some (1, pk) -> 151 | Pbrt.Decoder.unexpected_payload "Message(export_metrics_service_request), field(1)" pk 152 | | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind 153 | done; 154 | ({ 155 | resource_metrics = v.resource_metrics; 156 | } : export_metrics_service_request) 157 | 158 | let rec decode_pb_export_metrics_partial_success d = 159 | let v = default_export_metrics_partial_success_mutable () in 160 | let continue__= ref true in 161 | while !continue__ do 162 | match Pbrt.Decoder.key d with 163 | | None -> ( 164 | ); continue__ := false 165 | | Some (1, Pbrt.Varint) -> begin 166 | v.rejected_data_points <- Pbrt.Decoder.int64_as_varint d; 167 | end 168 | | Some (1, pk) -> 169 | Pbrt.Decoder.unexpected_payload "Message(export_metrics_partial_success), field(1)" pk 170 | | Some (2, Pbrt.Bytes) -> begin 171 | v.error_message <- Pbrt.Decoder.string d; 172 | end 173 | | Some (2, pk) -> 174 | Pbrt.Decoder.unexpected_payload "Message(export_metrics_partial_success), field(2)" pk 175 | | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind 176 | done; 177 | ({ 178 | rejected_data_points = v.rejected_data_points; 179 | error_message = v.error_message; 180 | } : export_metrics_partial_success) 181 | 182 | let rec decode_pb_export_metrics_service_response d = 183 | let v = default_export_metrics_service_response_mutable () in 184 | let continue__= ref true in 185 | while !continue__ do 186 | match Pbrt.Decoder.key d with 187 | | None -> ( 188 | ); continue__ := false 189 | | Some (1, Pbrt.Bytes) -> begin 190 | v.partial_success <- Some (decode_pb_export_metrics_partial_success (Pbrt.Decoder.nested d)); 191 | end 192 | | Some (1, pk) -> 193 | Pbrt.Decoder.unexpected_payload "Message(export_metrics_service_response), field(1)" pk 194 | | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind 195 | done; 196 | ({ 197 | partial_success = v.partial_success; 198 | } : export_metrics_service_response) 199 | -------------------------------------------------------------------------------- /src/proto/metrics_service.mli: -------------------------------------------------------------------------------- 1 | 2 | (** Code for metrics_service.proto *) 3 | 4 | (* generated from "../../vendor/opentelemetry-proto/opentelemetry/proto/collector/metrics/v1/metrics_service.proto", do not edit *) 5 | 6 | 7 | 8 | (** {2 Types} *) 9 | 10 | type export_metrics_service_request = { 11 | resource_metrics : Metrics.resource_metrics list; 12 | } 13 | 14 | type export_metrics_partial_success = { 15 | rejected_data_points : int64; 16 | error_message : string; 17 | } 18 | 19 | type export_metrics_service_response = { 20 | partial_success : export_metrics_partial_success option; 21 | } 22 | 23 | 24 | (** {2 Basic values} *) 25 | 26 | val default_export_metrics_service_request : 27 | ?resource_metrics:Metrics.resource_metrics list -> 28 | unit -> 29 | export_metrics_service_request 30 | (** [default_export_metrics_service_request ()] is the default value for type [export_metrics_service_request] *) 31 | 32 | val default_export_metrics_partial_success : 33 | ?rejected_data_points:int64 -> 34 | ?error_message:string -> 35 | unit -> 36 | export_metrics_partial_success 37 | (** [default_export_metrics_partial_success ()] is the default value for type [export_metrics_partial_success] *) 38 | 39 | val default_export_metrics_service_response : 40 | ?partial_success:export_metrics_partial_success option -> 41 | unit -> 42 | export_metrics_service_response 43 | (** [default_export_metrics_service_response ()] is the default value for type [export_metrics_service_response] *) 44 | 45 | 46 | (** {2 Make functions} *) 47 | 48 | val make_export_metrics_service_request : 49 | resource_metrics:Metrics.resource_metrics list -> 50 | unit -> 51 | export_metrics_service_request 52 | (** [make_export_metrics_service_request … ()] is a builder for type [export_metrics_service_request] *) 53 | 54 | val make_export_metrics_partial_success : 55 | rejected_data_points:int64 -> 56 | error_message:string -> 57 | unit -> 58 | export_metrics_partial_success 59 | (** [make_export_metrics_partial_success … ()] is a builder for type [export_metrics_partial_success] *) 60 | 61 | val make_export_metrics_service_response : 62 | ?partial_success:export_metrics_partial_success option -> 63 | unit -> 64 | export_metrics_service_response 65 | (** [make_export_metrics_service_response … ()] is a builder for type [export_metrics_service_response] *) 66 | 67 | 68 | (** {2 Formatters} *) 69 | 70 | val pp_export_metrics_service_request : Format.formatter -> export_metrics_service_request -> unit 71 | (** [pp_export_metrics_service_request v] formats v *) 72 | 73 | val pp_export_metrics_partial_success : Format.formatter -> export_metrics_partial_success -> unit 74 | (** [pp_export_metrics_partial_success v] formats v *) 75 | 76 | val pp_export_metrics_service_response : Format.formatter -> export_metrics_service_response -> unit 77 | (** [pp_export_metrics_service_response v] formats v *) 78 | 79 | 80 | (** {2 Protobuf Encoding} *) 81 | 82 | val encode_pb_export_metrics_service_request : export_metrics_service_request -> Pbrt.Encoder.t -> unit 83 | (** [encode_pb_export_metrics_service_request v encoder] encodes [v] with the given [encoder] *) 84 | 85 | val encode_pb_export_metrics_partial_success : export_metrics_partial_success -> Pbrt.Encoder.t -> unit 86 | (** [encode_pb_export_metrics_partial_success v encoder] encodes [v] with the given [encoder] *) 87 | 88 | val encode_pb_export_metrics_service_response : export_metrics_service_response -> Pbrt.Encoder.t -> unit 89 | (** [encode_pb_export_metrics_service_response v encoder] encodes [v] with the given [encoder] *) 90 | 91 | 92 | (** {2 Protobuf Decoding} *) 93 | 94 | val decode_pb_export_metrics_service_request : Pbrt.Decoder.t -> export_metrics_service_request 95 | (** [decode_pb_export_metrics_service_request decoder] decodes a [export_metrics_service_request] binary value from [decoder] *) 96 | 97 | val decode_pb_export_metrics_partial_success : Pbrt.Decoder.t -> export_metrics_partial_success 98 | (** [decode_pb_export_metrics_partial_success decoder] decodes a [export_metrics_partial_success] binary value from [decoder] *) 99 | 100 | val decode_pb_export_metrics_service_response : Pbrt.Decoder.t -> export_metrics_service_response 101 | (** [decode_pb_export_metrics_service_response decoder] decodes a [export_metrics_service_response] binary value from [decoder] *) 102 | -------------------------------------------------------------------------------- /src/proto/resource.ml: -------------------------------------------------------------------------------- 1 | [@@@ocaml.warning "-27-30-39"] 2 | 3 | type resource = { 4 | attributes : Common.key_value list; 5 | dropped_attributes_count : int32; 6 | } 7 | 8 | let rec default_resource 9 | ?attributes:((attributes:Common.key_value list) = []) 10 | ?dropped_attributes_count:((dropped_attributes_count:int32) = 0l) 11 | () : resource = { 12 | attributes; 13 | dropped_attributes_count; 14 | } 15 | 16 | type resource_mutable = { 17 | mutable attributes : Common.key_value list; 18 | mutable dropped_attributes_count : int32; 19 | } 20 | 21 | let default_resource_mutable () : resource_mutable = { 22 | attributes = []; 23 | dropped_attributes_count = 0l; 24 | } 25 | 26 | 27 | (** {2 Make functions} *) 28 | 29 | let rec make_resource 30 | ~(attributes:Common.key_value list) 31 | ~(dropped_attributes_count:int32) 32 | () : resource = { 33 | attributes; 34 | dropped_attributes_count; 35 | } 36 | 37 | [@@@ocaml.warning "-27-30-39"] 38 | 39 | (** {2 Formatters} *) 40 | 41 | let rec pp_resource fmt (v:resource) = 42 | let pp_i fmt () = 43 | Pbrt.Pp.pp_record_field ~first:true "attributes" (Pbrt.Pp.pp_list Common.pp_key_value) fmt v.attributes; 44 | Pbrt.Pp.pp_record_field ~first:false "dropped_attributes_count" Pbrt.Pp.pp_int32 fmt v.dropped_attributes_count; 45 | in 46 | Pbrt.Pp.pp_brk pp_i fmt () 47 | 48 | [@@@ocaml.warning "-27-30-39"] 49 | 50 | (** {2 Protobuf Encoding} *) 51 | 52 | let rec encode_pb_resource (v:resource) encoder = 53 | Pbrt.List_util.rev_iter_with (fun x encoder -> 54 | Pbrt.Encoder.nested Common.encode_pb_key_value x encoder; 55 | Pbrt.Encoder.key 1 Pbrt.Bytes encoder; 56 | ) v.attributes encoder; 57 | Pbrt.Encoder.int32_as_varint v.dropped_attributes_count encoder; 58 | Pbrt.Encoder.key 2 Pbrt.Varint encoder; 59 | () 60 | 61 | [@@@ocaml.warning "-27-30-39"] 62 | 63 | (** {2 Protobuf Decoding} *) 64 | 65 | let rec decode_pb_resource d = 66 | let v = default_resource_mutable () in 67 | let continue__= ref true in 68 | while !continue__ do 69 | match Pbrt.Decoder.key d with 70 | | None -> ( 71 | v.attributes <- List.rev v.attributes; 72 | ); continue__ := false 73 | | Some (1, Pbrt.Bytes) -> begin 74 | v.attributes <- (Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes; 75 | end 76 | | Some (1, pk) -> 77 | Pbrt.Decoder.unexpected_payload "Message(resource), field(1)" pk 78 | | Some (2, Pbrt.Varint) -> begin 79 | v.dropped_attributes_count <- Pbrt.Decoder.int32_as_varint d; 80 | end 81 | | Some (2, pk) -> 82 | Pbrt.Decoder.unexpected_payload "Message(resource), field(2)" pk 83 | | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind 84 | done; 85 | ({ 86 | attributes = v.attributes; 87 | dropped_attributes_count = v.dropped_attributes_count; 88 | } : resource) 89 | -------------------------------------------------------------------------------- /src/proto/resource.mli: -------------------------------------------------------------------------------- 1 | 2 | (** Code for resource.proto *) 3 | 4 | (* generated from "../../vendor/opentelemetry-proto/opentelemetry/proto/resource/v1/resource.proto", do not edit *) 5 | 6 | 7 | 8 | (** {2 Types} *) 9 | 10 | type resource = { 11 | attributes : Common.key_value list; 12 | dropped_attributes_count : int32; 13 | } 14 | 15 | 16 | (** {2 Basic values} *) 17 | 18 | val default_resource : 19 | ?attributes:Common.key_value list -> 20 | ?dropped_attributes_count:int32 -> 21 | unit -> 22 | resource 23 | (** [default_resource ()] is the default value for type [resource] *) 24 | 25 | 26 | (** {2 Make functions} *) 27 | 28 | val make_resource : 29 | attributes:Common.key_value list -> 30 | dropped_attributes_count:int32 -> 31 | unit -> 32 | resource 33 | (** [make_resource … ()] is a builder for type [resource] *) 34 | 35 | 36 | (** {2 Formatters} *) 37 | 38 | val pp_resource : Format.formatter -> resource -> unit 39 | (** [pp_resource v] formats v *) 40 | 41 | 42 | (** {2 Protobuf Encoding} *) 43 | 44 | val encode_pb_resource : resource -> Pbrt.Encoder.t -> unit 45 | (** [encode_pb_resource v encoder] encodes [v] with the given [encoder] *) 46 | 47 | 48 | (** {2 Protobuf Decoding} *) 49 | 50 | val decode_pb_resource : Pbrt.Decoder.t -> resource 51 | (** [decode_pb_resource decoder] decodes a [resource] binary value from [decoder] *) 52 | -------------------------------------------------------------------------------- /src/proto/status.ml: -------------------------------------------------------------------------------- 1 | [@@@ocaml.warning "-27-30-39-44"] 2 | 3 | type status = { 4 | code : int32; 5 | message : bytes; 6 | details : bytes list; 7 | } 8 | 9 | let rec default_status 10 | ?code:((code:int32) = 0l) 11 | ?message:((message:bytes) = Bytes.create 0) 12 | ?details:((details:bytes list) = []) 13 | () : status = { 14 | code; 15 | message; 16 | details; 17 | } 18 | 19 | type status_mutable = { 20 | mutable code : int32; 21 | mutable message : bytes; 22 | mutable details : bytes list; 23 | } 24 | 25 | let default_status_mutable () : status_mutable = { 26 | code = 0l; 27 | message = Bytes.create 0; 28 | details = []; 29 | } 30 | 31 | 32 | (** {2 Make functions} *) 33 | 34 | let rec make_status 35 | ~(code:int32) 36 | ~(message:bytes) 37 | ~(details:bytes list) 38 | () : status = { 39 | code; 40 | message; 41 | details; 42 | } 43 | 44 | [@@@ocaml.warning "-27-30-39"] 45 | 46 | (** {2 Formatters} *) 47 | 48 | let rec pp_status fmt (v:status) = 49 | let pp_i fmt () = 50 | Pbrt.Pp.pp_record_field ~first:true "code" Pbrt.Pp.pp_int32 fmt v.code; 51 | Pbrt.Pp.pp_record_field ~first:false "message" Pbrt.Pp.pp_bytes fmt v.message; 52 | Pbrt.Pp.pp_record_field ~first:false "details" (Pbrt.Pp.pp_list Pbrt.Pp.pp_bytes) fmt v.details; 53 | in 54 | Pbrt.Pp.pp_brk pp_i fmt () 55 | 56 | [@@@ocaml.warning "-27-30-39"] 57 | 58 | (** {2 Protobuf Encoding} *) 59 | 60 | let rec encode_pb_status (v:status) encoder = 61 | Pbrt.Encoder.int32_as_varint v.code encoder; 62 | Pbrt.Encoder.key 1 Pbrt.Varint encoder; 63 | Pbrt.Encoder.bytes v.message encoder; 64 | Pbrt.Encoder.key 2 Pbrt.Bytes encoder; 65 | Pbrt.List_util.rev_iter_with (fun x encoder -> 66 | Pbrt.Encoder.bytes x encoder; 67 | Pbrt.Encoder.key 3 Pbrt.Bytes encoder; 68 | ) v.details encoder; 69 | () 70 | 71 | [@@@ocaml.warning "-27-30-39"] 72 | 73 | (** {2 Protobuf Decoding} *) 74 | 75 | let rec decode_pb_status d = 76 | let v = default_status_mutable () in 77 | let continue__= ref true in 78 | while !continue__ do 79 | match Pbrt.Decoder.key d with 80 | | None -> ( 81 | v.details <- List.rev v.details; 82 | ); continue__ := false 83 | | Some (1, Pbrt.Varint) -> begin 84 | v.code <- Pbrt.Decoder.int32_as_varint d; 85 | end 86 | | Some (1, pk) -> 87 | Pbrt.Decoder.unexpected_payload "Message(status), field(1)" pk 88 | | Some (2, Pbrt.Bytes) -> begin 89 | v.message <- Pbrt.Decoder.bytes d; 90 | end 91 | | Some (2, pk) -> 92 | Pbrt.Decoder.unexpected_payload "Message(status), field(2)" pk 93 | | Some (3, Pbrt.Bytes) -> begin 94 | v.details <- (Pbrt.Decoder.bytes d) :: v.details; 95 | end 96 | | Some (3, pk) -> 97 | Pbrt.Decoder.unexpected_payload "Message(status), field(3)" pk 98 | | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind 99 | done; 100 | ({ 101 | code = v.code; 102 | message = v.message; 103 | details = v.details; 104 | } : status) 105 | -------------------------------------------------------------------------------- /src/proto/status.mli: -------------------------------------------------------------------------------- 1 | 2 | (** Code for status.proto *) 3 | 4 | (* generated from "status.proto", do not edit *) 5 | 6 | 7 | 8 | (** {2 Types} *) 9 | 10 | type status = { 11 | code : int32; 12 | message : bytes; 13 | details : bytes list; 14 | } 15 | 16 | 17 | (** {2 Basic values} *) 18 | 19 | val default_status : 20 | ?code:int32 -> 21 | ?message:bytes -> 22 | ?details:bytes list -> 23 | unit -> 24 | status 25 | (** [default_status ()] is the default value for type [status] *) 26 | 27 | 28 | (** {2 Make functions} *) 29 | 30 | val make_status : 31 | code:int32 -> 32 | message:bytes -> 33 | details:bytes list -> 34 | unit -> 35 | status 36 | (** [make_status … ()] is a builder for type [status] *) 37 | 38 | 39 | (** {2 Formatters} *) 40 | 41 | val pp_status : Format.formatter -> status -> unit 42 | (** [pp_status v] formats v *) 43 | 44 | 45 | (** {2 Protobuf Encoding} *) 46 | 47 | val encode_pb_status : status -> Pbrt.Encoder.t -> unit 48 | (** [encode_pb_status v encoder] encodes [v] with the given [encoder] *) 49 | 50 | 51 | (** {2 Protobuf Decoding} *) 52 | 53 | val decode_pb_status : Pbrt.Decoder.t -> status 54 | (** [decode_pb_status decoder] decodes a [status] binary value from [decoder] *) 55 | -------------------------------------------------------------------------------- /src/proto/status.proto: -------------------------------------------------------------------------------- 1 | 2 | syntax = "proto3"; 3 | 4 | // from https://pkg.go.dev/google.golang.org/genproto/googleapis/rpc/status?utm_source=godoc#Status 5 | 6 | message Status { 7 | int32 code = 1; 8 | bytes message = 2; 9 | repeated bytes details = 3; 10 | } 11 | -------------------------------------------------------------------------------- /src/proto/trace.mli: -------------------------------------------------------------------------------- 1 | 2 | (** Code for trace.proto *) 3 | 4 | (* generated from "../../vendor/opentelemetry-proto/opentelemetry/proto/trace/v1/trace.proto", do not edit *) 5 | 6 | 7 | 8 | (** {2 Types} *) 9 | 10 | type span_span_kind = 11 | | Span_kind_unspecified 12 | | Span_kind_internal 13 | | Span_kind_server 14 | | Span_kind_client 15 | | Span_kind_producer 16 | | Span_kind_consumer 17 | 18 | type span_event = { 19 | time_unix_nano : int64; 20 | name : string; 21 | attributes : Common.key_value list; 22 | dropped_attributes_count : int32; 23 | } 24 | 25 | type span_link = { 26 | trace_id : bytes; 27 | span_id : bytes; 28 | trace_state : string; 29 | attributes : Common.key_value list; 30 | dropped_attributes_count : int32; 31 | } 32 | 33 | type status_status_code = 34 | | Status_code_unset 35 | | Status_code_ok 36 | | Status_code_error 37 | 38 | type status = { 39 | message : string; 40 | code : status_status_code; 41 | } 42 | 43 | type span = { 44 | trace_id : bytes; 45 | span_id : bytes; 46 | trace_state : string; 47 | parent_span_id : bytes; 48 | name : string; 49 | kind : span_span_kind; 50 | start_time_unix_nano : int64; 51 | end_time_unix_nano : int64; 52 | attributes : Common.key_value list; 53 | dropped_attributes_count : int32; 54 | events : span_event list; 55 | dropped_events_count : int32; 56 | links : span_link list; 57 | dropped_links_count : int32; 58 | status : status option; 59 | } 60 | 61 | type scope_spans = { 62 | scope : Common.instrumentation_scope option; 63 | spans : span list; 64 | schema_url : string; 65 | } 66 | 67 | type resource_spans = { 68 | resource : Resource.resource option; 69 | scope_spans : scope_spans list; 70 | schema_url : string; 71 | } 72 | 73 | type traces_data = { 74 | resource_spans : resource_spans list; 75 | } 76 | 77 | 78 | (** {2 Basic values} *) 79 | 80 | val default_span_span_kind : unit -> span_span_kind 81 | (** [default_span_span_kind ()] is the default value for type [span_span_kind] *) 82 | 83 | val default_span_event : 84 | ?time_unix_nano:int64 -> 85 | ?name:string -> 86 | ?attributes:Common.key_value list -> 87 | ?dropped_attributes_count:int32 -> 88 | unit -> 89 | span_event 90 | (** [default_span_event ()] is the default value for type [span_event] *) 91 | 92 | val default_span_link : 93 | ?trace_id:bytes -> 94 | ?span_id:bytes -> 95 | ?trace_state:string -> 96 | ?attributes:Common.key_value list -> 97 | ?dropped_attributes_count:int32 -> 98 | unit -> 99 | span_link 100 | (** [default_span_link ()] is the default value for type [span_link] *) 101 | 102 | val default_status_status_code : unit -> status_status_code 103 | (** [default_status_status_code ()] is the default value for type [status_status_code] *) 104 | 105 | val default_status : 106 | ?message:string -> 107 | ?code:status_status_code -> 108 | unit -> 109 | status 110 | (** [default_status ()] is the default value for type [status] *) 111 | 112 | val default_span : 113 | ?trace_id:bytes -> 114 | ?span_id:bytes -> 115 | ?trace_state:string -> 116 | ?parent_span_id:bytes -> 117 | ?name:string -> 118 | ?kind:span_span_kind -> 119 | ?start_time_unix_nano:int64 -> 120 | ?end_time_unix_nano:int64 -> 121 | ?attributes:Common.key_value list -> 122 | ?dropped_attributes_count:int32 -> 123 | ?events:span_event list -> 124 | ?dropped_events_count:int32 -> 125 | ?links:span_link list -> 126 | ?dropped_links_count:int32 -> 127 | ?status:status option -> 128 | unit -> 129 | span 130 | (** [default_span ()] is the default value for type [span] *) 131 | 132 | val default_scope_spans : 133 | ?scope:Common.instrumentation_scope option -> 134 | ?spans:span list -> 135 | ?schema_url:string -> 136 | unit -> 137 | scope_spans 138 | (** [default_scope_spans ()] is the default value for type [scope_spans] *) 139 | 140 | val default_resource_spans : 141 | ?resource:Resource.resource option -> 142 | ?scope_spans:scope_spans list -> 143 | ?schema_url:string -> 144 | unit -> 145 | resource_spans 146 | (** [default_resource_spans ()] is the default value for type [resource_spans] *) 147 | 148 | val default_traces_data : 149 | ?resource_spans:resource_spans list -> 150 | unit -> 151 | traces_data 152 | (** [default_traces_data ()] is the default value for type [traces_data] *) 153 | 154 | 155 | (** {2 Make functions} *) 156 | 157 | 158 | val make_span_event : 159 | time_unix_nano:int64 -> 160 | name:string -> 161 | attributes:Common.key_value list -> 162 | dropped_attributes_count:int32 -> 163 | unit -> 164 | span_event 165 | (** [make_span_event … ()] is a builder for type [span_event] *) 166 | 167 | val make_span_link : 168 | trace_id:bytes -> 169 | span_id:bytes -> 170 | trace_state:string -> 171 | attributes:Common.key_value list -> 172 | dropped_attributes_count:int32 -> 173 | unit -> 174 | span_link 175 | (** [make_span_link … ()] is a builder for type [span_link] *) 176 | 177 | 178 | val make_status : 179 | message:string -> 180 | code:status_status_code -> 181 | unit -> 182 | status 183 | (** [make_status … ()] is a builder for type [status] *) 184 | 185 | val make_span : 186 | trace_id:bytes -> 187 | span_id:bytes -> 188 | trace_state:string -> 189 | parent_span_id:bytes -> 190 | name:string -> 191 | kind:span_span_kind -> 192 | start_time_unix_nano:int64 -> 193 | end_time_unix_nano:int64 -> 194 | attributes:Common.key_value list -> 195 | dropped_attributes_count:int32 -> 196 | events:span_event list -> 197 | dropped_events_count:int32 -> 198 | links:span_link list -> 199 | dropped_links_count:int32 -> 200 | ?status:status option -> 201 | unit -> 202 | span 203 | (** [make_span … ()] is a builder for type [span] *) 204 | 205 | val make_scope_spans : 206 | ?scope:Common.instrumentation_scope option -> 207 | spans:span list -> 208 | schema_url:string -> 209 | unit -> 210 | scope_spans 211 | (** [make_scope_spans … ()] is a builder for type [scope_spans] *) 212 | 213 | val make_resource_spans : 214 | ?resource:Resource.resource option -> 215 | scope_spans:scope_spans list -> 216 | schema_url:string -> 217 | unit -> 218 | resource_spans 219 | (** [make_resource_spans … ()] is a builder for type [resource_spans] *) 220 | 221 | val make_traces_data : 222 | resource_spans:resource_spans list -> 223 | unit -> 224 | traces_data 225 | (** [make_traces_data … ()] is a builder for type [traces_data] *) 226 | 227 | 228 | (** {2 Formatters} *) 229 | 230 | val pp_span_span_kind : Format.formatter -> span_span_kind -> unit 231 | (** [pp_span_span_kind v] formats v *) 232 | 233 | val pp_span_event : Format.formatter -> span_event -> unit 234 | (** [pp_span_event v] formats v *) 235 | 236 | val pp_span_link : Format.formatter -> span_link -> unit 237 | (** [pp_span_link v] formats v *) 238 | 239 | val pp_status_status_code : Format.formatter -> status_status_code -> unit 240 | (** [pp_status_status_code v] formats v *) 241 | 242 | val pp_status : Format.formatter -> status -> unit 243 | (** [pp_status v] formats v *) 244 | 245 | val pp_span : Format.formatter -> span -> unit 246 | (** [pp_span v] formats v *) 247 | 248 | val pp_scope_spans : Format.formatter -> scope_spans -> unit 249 | (** [pp_scope_spans v] formats v *) 250 | 251 | val pp_resource_spans : Format.formatter -> resource_spans -> unit 252 | (** [pp_resource_spans v] formats v *) 253 | 254 | val pp_traces_data : Format.formatter -> traces_data -> unit 255 | (** [pp_traces_data v] formats v *) 256 | 257 | 258 | (** {2 Protobuf Encoding} *) 259 | 260 | val encode_pb_span_span_kind : span_span_kind -> Pbrt.Encoder.t -> unit 261 | (** [encode_pb_span_span_kind v encoder] encodes [v] with the given [encoder] *) 262 | 263 | val encode_pb_span_event : span_event -> Pbrt.Encoder.t -> unit 264 | (** [encode_pb_span_event v encoder] encodes [v] with the given [encoder] *) 265 | 266 | val encode_pb_span_link : span_link -> Pbrt.Encoder.t -> unit 267 | (** [encode_pb_span_link v encoder] encodes [v] with the given [encoder] *) 268 | 269 | val encode_pb_status_status_code : status_status_code -> Pbrt.Encoder.t -> unit 270 | (** [encode_pb_status_status_code v encoder] encodes [v] with the given [encoder] *) 271 | 272 | val encode_pb_status : status -> Pbrt.Encoder.t -> unit 273 | (** [encode_pb_status v encoder] encodes [v] with the given [encoder] *) 274 | 275 | val encode_pb_span : span -> Pbrt.Encoder.t -> unit 276 | (** [encode_pb_span v encoder] encodes [v] with the given [encoder] *) 277 | 278 | val encode_pb_scope_spans : scope_spans -> Pbrt.Encoder.t -> unit 279 | (** [encode_pb_scope_spans v encoder] encodes [v] with the given [encoder] *) 280 | 281 | val encode_pb_resource_spans : resource_spans -> Pbrt.Encoder.t -> unit 282 | (** [encode_pb_resource_spans v encoder] encodes [v] with the given [encoder] *) 283 | 284 | val encode_pb_traces_data : traces_data -> Pbrt.Encoder.t -> unit 285 | (** [encode_pb_traces_data v encoder] encodes [v] with the given [encoder] *) 286 | 287 | 288 | (** {2 Protobuf Decoding} *) 289 | 290 | val decode_pb_span_span_kind : Pbrt.Decoder.t -> span_span_kind 291 | (** [decode_pb_span_span_kind decoder] decodes a [span_span_kind] binary value from [decoder] *) 292 | 293 | val decode_pb_span_event : Pbrt.Decoder.t -> span_event 294 | (** [decode_pb_span_event decoder] decodes a [span_event] binary value from [decoder] *) 295 | 296 | val decode_pb_span_link : Pbrt.Decoder.t -> span_link 297 | (** [decode_pb_span_link decoder] decodes a [span_link] binary value from [decoder] *) 298 | 299 | val decode_pb_status_status_code : Pbrt.Decoder.t -> status_status_code 300 | (** [decode_pb_status_status_code decoder] decodes a [status_status_code] binary value from [decoder] *) 301 | 302 | val decode_pb_status : Pbrt.Decoder.t -> status 303 | (** [decode_pb_status decoder] decodes a [status] binary value from [decoder] *) 304 | 305 | val decode_pb_span : Pbrt.Decoder.t -> span 306 | (** [decode_pb_span decoder] decodes a [span] binary value from [decoder] *) 307 | 308 | val decode_pb_scope_spans : Pbrt.Decoder.t -> scope_spans 309 | (** [decode_pb_scope_spans decoder] decodes a [scope_spans] binary value from [decoder] *) 310 | 311 | val decode_pb_resource_spans : Pbrt.Decoder.t -> resource_spans 312 | (** [decode_pb_resource_spans decoder] decodes a [resource_spans] binary value from [decoder] *) 313 | 314 | val decode_pb_traces_data : Pbrt.Decoder.t -> traces_data 315 | (** [decode_pb_traces_data decoder] decodes a [traces_data] binary value from [decoder] *) 316 | -------------------------------------------------------------------------------- /src/proto/trace_service.ml: -------------------------------------------------------------------------------- 1 | [@@@ocaml.warning "-27-30-39"] 2 | 3 | type export_trace_service_request = { 4 | resource_spans : Trace.resource_spans list; 5 | } 6 | 7 | type export_trace_partial_success = { 8 | rejected_spans : int64; 9 | error_message : string; 10 | } 11 | 12 | type export_trace_service_response = { 13 | partial_success : export_trace_partial_success option; 14 | } 15 | 16 | let rec default_export_trace_service_request 17 | ?resource_spans:((resource_spans:Trace.resource_spans list) = []) 18 | () : export_trace_service_request = { 19 | resource_spans; 20 | } 21 | 22 | let rec default_export_trace_partial_success 23 | ?rejected_spans:((rejected_spans:int64) = 0L) 24 | ?error_message:((error_message:string) = "") 25 | () : export_trace_partial_success = { 26 | rejected_spans; 27 | error_message; 28 | } 29 | 30 | let rec default_export_trace_service_response 31 | ?partial_success:((partial_success:export_trace_partial_success option) = None) 32 | () : export_trace_service_response = { 33 | partial_success; 34 | } 35 | 36 | type export_trace_service_request_mutable = { 37 | mutable resource_spans : Trace.resource_spans list; 38 | } 39 | 40 | let default_export_trace_service_request_mutable () : export_trace_service_request_mutable = { 41 | resource_spans = []; 42 | } 43 | 44 | type export_trace_partial_success_mutable = { 45 | mutable rejected_spans : int64; 46 | mutable error_message : string; 47 | } 48 | 49 | let default_export_trace_partial_success_mutable () : export_trace_partial_success_mutable = { 50 | rejected_spans = 0L; 51 | error_message = ""; 52 | } 53 | 54 | type export_trace_service_response_mutable = { 55 | mutable partial_success : export_trace_partial_success option; 56 | } 57 | 58 | let default_export_trace_service_response_mutable () : export_trace_service_response_mutable = { 59 | partial_success = None; 60 | } 61 | 62 | 63 | (** {2 Make functions} *) 64 | 65 | let rec make_export_trace_service_request 66 | ~(resource_spans:Trace.resource_spans list) 67 | () : export_trace_service_request = { 68 | resource_spans; 69 | } 70 | 71 | let rec make_export_trace_partial_success 72 | ~(rejected_spans:int64) 73 | ~(error_message:string) 74 | () : export_trace_partial_success = { 75 | rejected_spans; 76 | error_message; 77 | } 78 | 79 | let rec make_export_trace_service_response 80 | ?partial_success:((partial_success:export_trace_partial_success option) = None) 81 | () : export_trace_service_response = { 82 | partial_success; 83 | } 84 | 85 | [@@@ocaml.warning "-27-30-39"] 86 | 87 | (** {2 Formatters} *) 88 | 89 | let rec pp_export_trace_service_request fmt (v:export_trace_service_request) = 90 | let pp_i fmt () = 91 | Pbrt.Pp.pp_record_field ~first:true "resource_spans" (Pbrt.Pp.pp_list Trace.pp_resource_spans) fmt v.resource_spans; 92 | in 93 | Pbrt.Pp.pp_brk pp_i fmt () 94 | 95 | let rec pp_export_trace_partial_success fmt (v:export_trace_partial_success) = 96 | let pp_i fmt () = 97 | Pbrt.Pp.pp_record_field ~first:true "rejected_spans" Pbrt.Pp.pp_int64 fmt v.rejected_spans; 98 | Pbrt.Pp.pp_record_field ~first:false "error_message" Pbrt.Pp.pp_string fmt v.error_message; 99 | in 100 | Pbrt.Pp.pp_brk pp_i fmt () 101 | 102 | let rec pp_export_trace_service_response fmt (v:export_trace_service_response) = 103 | let pp_i fmt () = 104 | Pbrt.Pp.pp_record_field ~first:true "partial_success" (Pbrt.Pp.pp_option pp_export_trace_partial_success) fmt v.partial_success; 105 | in 106 | Pbrt.Pp.pp_brk pp_i fmt () 107 | 108 | [@@@ocaml.warning "-27-30-39"] 109 | 110 | (** {2 Protobuf Encoding} *) 111 | 112 | let rec encode_pb_export_trace_service_request (v:export_trace_service_request) encoder = 113 | Pbrt.List_util.rev_iter_with (fun x encoder -> 114 | Pbrt.Encoder.nested Trace.encode_pb_resource_spans x encoder; 115 | Pbrt.Encoder.key 1 Pbrt.Bytes encoder; 116 | ) v.resource_spans encoder; 117 | () 118 | 119 | let rec encode_pb_export_trace_partial_success (v:export_trace_partial_success) encoder = 120 | Pbrt.Encoder.int64_as_varint v.rejected_spans encoder; 121 | Pbrt.Encoder.key 1 Pbrt.Varint encoder; 122 | Pbrt.Encoder.string v.error_message encoder; 123 | Pbrt.Encoder.key 2 Pbrt.Bytes encoder; 124 | () 125 | 126 | let rec encode_pb_export_trace_service_response (v:export_trace_service_response) encoder = 127 | begin match v.partial_success with 128 | | Some x -> 129 | Pbrt.Encoder.nested encode_pb_export_trace_partial_success x encoder; 130 | Pbrt.Encoder.key 1 Pbrt.Bytes encoder; 131 | | None -> (); 132 | end; 133 | () 134 | 135 | [@@@ocaml.warning "-27-30-39"] 136 | 137 | (** {2 Protobuf Decoding} *) 138 | 139 | let rec decode_pb_export_trace_service_request d = 140 | let v = default_export_trace_service_request_mutable () in 141 | let continue__= ref true in 142 | while !continue__ do 143 | match Pbrt.Decoder.key d with 144 | | None -> ( 145 | v.resource_spans <- List.rev v.resource_spans; 146 | ); continue__ := false 147 | | Some (1, Pbrt.Bytes) -> begin 148 | v.resource_spans <- (Trace.decode_pb_resource_spans (Pbrt.Decoder.nested d)) :: v.resource_spans; 149 | end 150 | | Some (1, pk) -> 151 | Pbrt.Decoder.unexpected_payload "Message(export_trace_service_request), field(1)" pk 152 | | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind 153 | done; 154 | ({ 155 | resource_spans = v.resource_spans; 156 | } : export_trace_service_request) 157 | 158 | let rec decode_pb_export_trace_partial_success d = 159 | let v = default_export_trace_partial_success_mutable () in 160 | let continue__= ref true in 161 | while !continue__ do 162 | match Pbrt.Decoder.key d with 163 | | None -> ( 164 | ); continue__ := false 165 | | Some (1, Pbrt.Varint) -> begin 166 | v.rejected_spans <- Pbrt.Decoder.int64_as_varint d; 167 | end 168 | | Some (1, pk) -> 169 | Pbrt.Decoder.unexpected_payload "Message(export_trace_partial_success), field(1)" pk 170 | | Some (2, Pbrt.Bytes) -> begin 171 | v.error_message <- Pbrt.Decoder.string d; 172 | end 173 | | Some (2, pk) -> 174 | Pbrt.Decoder.unexpected_payload "Message(export_trace_partial_success), field(2)" pk 175 | | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind 176 | done; 177 | ({ 178 | rejected_spans = v.rejected_spans; 179 | error_message = v.error_message; 180 | } : export_trace_partial_success) 181 | 182 | let rec decode_pb_export_trace_service_response d = 183 | let v = default_export_trace_service_response_mutable () in 184 | let continue__= ref true in 185 | while !continue__ do 186 | match Pbrt.Decoder.key d with 187 | | None -> ( 188 | ); continue__ := false 189 | | Some (1, Pbrt.Bytes) -> begin 190 | v.partial_success <- Some (decode_pb_export_trace_partial_success (Pbrt.Decoder.nested d)); 191 | end 192 | | Some (1, pk) -> 193 | Pbrt.Decoder.unexpected_payload "Message(export_trace_service_response), field(1)" pk 194 | | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind 195 | done; 196 | ({ 197 | partial_success = v.partial_success; 198 | } : export_trace_service_response) 199 | -------------------------------------------------------------------------------- /src/proto/trace_service.mli: -------------------------------------------------------------------------------- 1 | 2 | (** Code for trace_service.proto *) 3 | 4 | (* generated from "../../vendor/opentelemetry-proto/opentelemetry/proto/collector/trace/v1/trace_service.proto", do not edit *) 5 | 6 | 7 | 8 | (** {2 Types} *) 9 | 10 | type export_trace_service_request = { 11 | resource_spans : Trace.resource_spans list; 12 | } 13 | 14 | type export_trace_partial_success = { 15 | rejected_spans : int64; 16 | error_message : string; 17 | } 18 | 19 | type export_trace_service_response = { 20 | partial_success : export_trace_partial_success option; 21 | } 22 | 23 | 24 | (** {2 Basic values} *) 25 | 26 | val default_export_trace_service_request : 27 | ?resource_spans:Trace.resource_spans list -> 28 | unit -> 29 | export_trace_service_request 30 | (** [default_export_trace_service_request ()] is the default value for type [export_trace_service_request] *) 31 | 32 | val default_export_trace_partial_success : 33 | ?rejected_spans:int64 -> 34 | ?error_message:string -> 35 | unit -> 36 | export_trace_partial_success 37 | (** [default_export_trace_partial_success ()] is the default value for type [export_trace_partial_success] *) 38 | 39 | val default_export_trace_service_response : 40 | ?partial_success:export_trace_partial_success option -> 41 | unit -> 42 | export_trace_service_response 43 | (** [default_export_trace_service_response ()] is the default value for type [export_trace_service_response] *) 44 | 45 | 46 | (** {2 Make functions} *) 47 | 48 | val make_export_trace_service_request : 49 | resource_spans:Trace.resource_spans list -> 50 | unit -> 51 | export_trace_service_request 52 | (** [make_export_trace_service_request … ()] is a builder for type [export_trace_service_request] *) 53 | 54 | val make_export_trace_partial_success : 55 | rejected_spans:int64 -> 56 | error_message:string -> 57 | unit -> 58 | export_trace_partial_success 59 | (** [make_export_trace_partial_success … ()] is a builder for type [export_trace_partial_success] *) 60 | 61 | val make_export_trace_service_response : 62 | ?partial_success:export_trace_partial_success option -> 63 | unit -> 64 | export_trace_service_response 65 | (** [make_export_trace_service_response … ()] is a builder for type [export_trace_service_response] *) 66 | 67 | 68 | (** {2 Formatters} *) 69 | 70 | val pp_export_trace_service_request : Format.formatter -> export_trace_service_request -> unit 71 | (** [pp_export_trace_service_request v] formats v *) 72 | 73 | val pp_export_trace_partial_success : Format.formatter -> export_trace_partial_success -> unit 74 | (** [pp_export_trace_partial_success v] formats v *) 75 | 76 | val pp_export_trace_service_response : Format.formatter -> export_trace_service_response -> unit 77 | (** [pp_export_trace_service_response v] formats v *) 78 | 79 | 80 | (** {2 Protobuf Encoding} *) 81 | 82 | val encode_pb_export_trace_service_request : export_trace_service_request -> Pbrt.Encoder.t -> unit 83 | (** [encode_pb_export_trace_service_request v encoder] encodes [v] with the given [encoder] *) 84 | 85 | val encode_pb_export_trace_partial_success : export_trace_partial_success -> Pbrt.Encoder.t -> unit 86 | (** [encode_pb_export_trace_partial_success v encoder] encodes [v] with the given [encoder] *) 87 | 88 | val encode_pb_export_trace_service_response : export_trace_service_response -> Pbrt.Encoder.t -> unit 89 | (** [encode_pb_export_trace_service_response v encoder] encodes [v] with the given [encoder] *) 90 | 91 | 92 | (** {2 Protobuf Decoding} *) 93 | 94 | val decode_pb_export_trace_service_request : Pbrt.Decoder.t -> export_trace_service_request 95 | (** [decode_pb_export_trace_service_request decoder] decodes a [export_trace_service_request] binary value from [decoder] *) 96 | 97 | val decode_pb_export_trace_partial_success : Pbrt.Decoder.t -> export_trace_partial_success 98 | (** [decode_pb_export_trace_partial_success decoder] decodes a [export_trace_partial_success] binary value from [decoder] *) 99 | 100 | val decode_pb_export_trace_service_response : Pbrt.Decoder.t -> export_trace_service_response 101 | (** [decode_pb_export_trace_service_response decoder] decodes a [export_trace_service_response] binary value from [decoder] *) 102 | -------------------------------------------------------------------------------- /src/trace/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name opentelemetry_trace) 3 | (public_name opentelemetry.trace) 4 | (synopsis "Use opentelemetry as a collector for trace") 5 | (optional) 6 | (libraries opentelemetry.ambient-context trace.core opentelemetry)) 7 | -------------------------------------------------------------------------------- /src/trace/opentelemetry_trace.ml: -------------------------------------------------------------------------------- 1 | module Otel = Opentelemetry 2 | module Otrace = Trace_core (* ocaml-trace *) 3 | module TLS = Thread_local_storage 4 | 5 | open struct 6 | let spf = Printf.sprintf 7 | end 8 | 9 | module Conv = struct 10 | let[@inline] trace_id_of_otel (id : Otel.Trace_id.t) : Otrace.trace_id = 11 | if id == Otel.Trace_id.dummy then 12 | Otrace.Collector.dummy_trace_id 13 | else 14 | Bytes.unsafe_to_string (Otel.Trace_id.to_bytes id) 15 | 16 | let[@inline] trace_id_to_otel (id : Otrace.trace_id) : Otel.Trace_id.t = 17 | if id == Otrace.Collector.dummy_trace_id then 18 | Otel.Trace_id.dummy 19 | else 20 | Otel.Trace_id.of_bytes @@ Bytes.unsafe_of_string id 21 | 22 | let[@inline] span_id_of_otel (id : Otel.Span_id.t) : Otrace.span = 23 | if id == Otel.Span_id.dummy then 24 | Otrace.Collector.dummy_span 25 | else 26 | Bytes.get_int64_le (Otel.Span_id.to_bytes id) 0 27 | 28 | let[@inline] span_id_to_otel (id : Otrace.span) : Otel.Span_id.t = 29 | if id == Otrace.Collector.dummy_span then 30 | Otel.Span_id.dummy 31 | else ( 32 | let b = Bytes.create 8 in 33 | Bytes.set_int64_le b 0 id; 34 | Otel.Span_id.of_bytes b 35 | ) 36 | 37 | let[@inline] ctx_to_otel (self : Otrace.explicit_span_ctx) : Otel.Span_ctx.t = 38 | Otel.Span_ctx.make 39 | ~trace_id:(trace_id_to_otel self.trace_id) 40 | ~parent_id:(span_id_to_otel self.span) 41 | () 42 | 43 | let[@inline] ctx_of_otel (ctx : Otel.Span_ctx.t) : Otrace.explicit_span_ctx = 44 | { 45 | trace_id = trace_id_of_otel (Otel.Span_ctx.trace_id ctx); 46 | span = span_id_of_otel (Otel.Span_ctx.parent_id ctx); 47 | } 48 | end 49 | 50 | open Conv 51 | 52 | module Well_known = struct 53 | let spankind_key = "otrace.spankind" 54 | 55 | let internal = `String "INTERNAL" 56 | 57 | let server = `String "SERVER" 58 | 59 | let client = `String "CLIENT" 60 | 61 | let producer = `String "PRODUCER" 62 | 63 | let consumer = `String "CONSUMER" 64 | 65 | let spankind_of_string = 66 | let open Otel.Span in 67 | function 68 | | "INTERNAL" -> Span_kind_internal 69 | | "SERVER" -> Span_kind_server 70 | | "CLIENT" -> Span_kind_client 71 | | "PRODUCER" -> Span_kind_producer 72 | | "CONSUMER" -> Span_kind_consumer 73 | | _ -> Span_kind_unspecified 74 | 75 | let otel_attrs_of_otrace_data data = 76 | let kind : Otel.Span.kind ref = ref Otel.Span.Span_kind_unspecified in 77 | let data = 78 | List.filter_map 79 | (function 80 | | name, `String v when name = "otrace.spankind" -> 81 | kind := spankind_of_string v; 82 | None 83 | | x -> Some x) 84 | data 85 | in 86 | !kind, data 87 | 88 | (** Key to store an error [Otel.Span.status] with the message. Set 89 | ["otrace.error" = "mymsg"] in a span data to set the span's status to 90 | [{message="mymsg"; code=Error}]. *) 91 | let status_error_key = "otrace.error" 92 | end 93 | 94 | open Well_known 95 | 96 | let on_internal_error = 97 | ref (fun msg -> Printf.eprintf "error in Opentelemetry_trace: %s\n%!" msg) 98 | 99 | type Otrace.extension_event += 100 | | Ev_link_span of Otrace.explicit_span * Otrace.explicit_span 101 | | Ev_set_span_kind of Otrace.explicit_span * Otel.Span_kind.t 102 | | Ev_record_exn of Otrace.explicit_span * exn * Printexc.raw_backtrace 103 | 104 | module Internal = struct 105 | type span_begin = { 106 | start_time: int64; 107 | name: string; 108 | __FILE__: string; 109 | __LINE__: int; 110 | __FUNCTION__: string option; 111 | scope: Otel.Scope.t; 112 | parent: Otel.Span_ctx.t option; 113 | } 114 | 115 | module Active_span_tbl = Hashtbl.Make (struct 116 | include Int64 117 | 118 | let hash : t -> int = Hashtbl.hash 119 | end) 120 | 121 | (** key to access a OTEL scope from an explicit span *) 122 | let k_explicit_scope : Otel.Scope.t Otrace.Meta_map.key = 123 | Otrace.Meta_map.Key.create () 124 | 125 | (** Per-thread set of active spans. *) 126 | module Active_spans = struct 127 | type t = { tbl: span_begin Active_span_tbl.t } [@@unboxed] 128 | 129 | let create () : t = { tbl = Active_span_tbl.create 32 } 130 | 131 | let k_tls : t TLS.t = TLS.create () 132 | 133 | let[@inline] get () : t = 134 | try TLS.get_exn k_tls 135 | with TLS.Not_set -> 136 | let self = create () in 137 | TLS.set k_tls self; 138 | self 139 | end 140 | 141 | let otrace_of_otel (id : Otel.Span_id.t) : int64 = 142 | let bs = Otel.Span_id.to_bytes id in 143 | (* lucky that it coincides! *) 144 | assert (Bytes.length bs = 8); 145 | Bytes.get_int64_le bs 0 146 | 147 | let enter_span' ?(explicit_parent : Otrace.explicit_span_ctx option) 148 | ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name = 149 | let open Otel in 150 | let otel_id = Span_id.create () in 151 | let otrace_id = otrace_of_otel otel_id in 152 | 153 | let parent_scope = Scope.get_ambient_scope () in 154 | let trace_id = 155 | match parent_scope with 156 | | Some sc -> sc.trace_id 157 | | None -> Trace_id.create () 158 | in 159 | let parent = 160 | match explicit_parent, parent_scope with 161 | | Some p, _ -> 162 | Some 163 | (Otel.Span_ctx.make ~trace_id ~parent_id:(span_id_to_otel p.span) ()) 164 | | None, Some parent -> Some (Otel.Scope.to_span_ctx parent) 165 | | None, None -> None 166 | in 167 | 168 | let new_scope = Otel.Scope.make ~trace_id ~span_id:otel_id ~attrs:data () in 169 | 170 | let start_time = Timestamp_ns.now_unix_ns () in 171 | let sb = 172 | { 173 | start_time; 174 | name; 175 | __FILE__; 176 | __LINE__; 177 | __FUNCTION__; 178 | scope = new_scope; 179 | parent; 180 | } 181 | in 182 | 183 | let active_spans = Active_spans.get () in 184 | Active_span_tbl.add active_spans.tbl otrace_id sb; 185 | 186 | otrace_id, sb 187 | 188 | let exit_span_ 189 | { start_time; name; __FILE__; __LINE__; __FUNCTION__; scope; parent } = 190 | let open Otel in 191 | let end_time = Timestamp_ns.now_unix_ns () in 192 | let kind, attrs = otel_attrs_of_otrace_data (Scope.attrs scope) in 193 | 194 | let status : Span_status.t = 195 | match List.assoc_opt Well_known.status_error_key attrs with 196 | | Some (`String message) -> { message; code = Status_code_error } 197 | | _ -> { message = ""; code = Status_code_ok } 198 | in 199 | 200 | let attrs = 201 | match __FUNCTION__ with 202 | | None -> 203 | [ "code.filepath", `String __FILE__; "code.lineno", `Int __LINE__ ] 204 | @ attrs 205 | | Some __FUNCTION__ -> 206 | let last_dot = String.rindex __FUNCTION__ '.' in 207 | let module_path = String.sub __FUNCTION__ 0 last_dot in 208 | let function_name = 209 | String.sub __FUNCTION__ (last_dot + 1) 210 | (String.length __FUNCTION__ - last_dot - 1) 211 | in 212 | [ 213 | "code.filepath", `String __FILE__; 214 | "code.lineno", `Int __LINE__; 215 | "code.function", `String function_name; 216 | "code.namespace", `String module_path; 217 | ] 218 | @ attrs 219 | in 220 | 221 | let parent_id = Option.map Otel.Span_ctx.parent_id parent in 222 | Span.create ~kind ~trace_id:scope.trace_id ?parent:parent_id ~status 223 | ~id:scope.span_id ~start_time ~end_time ~attrs 224 | ~events:(Scope.events scope) name 225 | |> fst 226 | 227 | let exit_span' otrace_id otel_span_begin = 228 | let active_spans = Active_spans.get () in 229 | Active_span_tbl.remove active_spans.tbl otrace_id; 230 | exit_span_ otel_span_begin 231 | 232 | let exit_span_from_id otrace_id = 233 | let active_spans = Active_spans.get () in 234 | match Active_span_tbl.find_opt active_spans.tbl otrace_id with 235 | | None -> None 236 | | Some otel_span_begin -> 237 | Active_span_tbl.remove active_spans.tbl otrace_id; 238 | Some (exit_span_ otel_span_begin) 239 | 240 | let[@inline] get_scope (span : Otrace.explicit_span) : Otel.Scope.t option = 241 | Otrace.Meta_map.find k_explicit_scope span.meta 242 | 243 | module M = struct 244 | let with_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name cb = 245 | let otrace_id, sb = 246 | enter_span' ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name 247 | in 248 | 249 | Otel.Scope.with_ambient_scope sb.scope @@ fun () -> 250 | match cb otrace_id with 251 | | res -> 252 | let otel_span = exit_span' otrace_id sb in 253 | Otel.Trace.emit [ otel_span ]; 254 | res 255 | | exception e -> 256 | let bt = Printexc.get_raw_backtrace () in 257 | 258 | Otel.Scope.record_exception sb.scope e bt; 259 | let otel_span = exit_span' otrace_id sb in 260 | Otel.Trace.emit [ otel_span ]; 261 | 262 | Printexc.raise_with_backtrace e bt 263 | 264 | let enter_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name : 265 | Trace_core.span = 266 | let otrace_id, _sb = 267 | enter_span' ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name 268 | in 269 | (* NOTE: we cannot enter ambient scope in a disjoint way 270 | with the exit, because we only have [Ambient_context.with_binding], 271 | no [set_binding] *) 272 | otrace_id 273 | 274 | let exit_span otrace_id = 275 | match exit_span_from_id otrace_id with 276 | | None -> () 277 | | Some otel_span -> Otel.Trace.emit [ otel_span ] 278 | 279 | let enter_manual_span ~(parent : Otrace.explicit_span_ctx option) ~flavor:_ 280 | ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name : Otrace.explicit_span = 281 | let otrace_id, sb = 282 | match parent with 283 | | None -> enter_span' ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name 284 | | Some parent -> 285 | enter_span' ~explicit_parent:parent ~__FUNCTION__ ~__FILE__ ~__LINE__ 286 | ~data name 287 | in 288 | 289 | let active_spans = Active_spans.get () in 290 | Active_span_tbl.add active_spans.tbl otrace_id sb; 291 | 292 | Otrace. 293 | { 294 | span = otrace_id; 295 | trace_id = trace_id_of_otel sb.scope.trace_id; 296 | meta = Meta_map.(empty |> add k_explicit_scope sb.scope); 297 | } 298 | 299 | let exit_manual_span Otrace.{ span = otrace_id; _ } = 300 | let active_spans = Active_spans.get () in 301 | match Active_span_tbl.find_opt active_spans.tbl otrace_id with 302 | | None -> !on_internal_error (spf "no active span with ID %Ld" otrace_id) 303 | | Some sb -> 304 | let otel_span = exit_span' otrace_id sb in 305 | Otel.Trace.emit [ otel_span ] 306 | 307 | let add_data_to_span otrace_id data = 308 | let active_spans = Active_spans.get () in 309 | match Active_span_tbl.find_opt active_spans.tbl otrace_id with 310 | | None -> !on_internal_error (spf "no active span with ID %Ld" otrace_id) 311 | | Some sb -> Otel.Scope.add_attrs sb.scope (fun () -> data) 312 | 313 | let add_data_to_manual_span (span : Otrace.explicit_span) data : unit = 314 | match get_scope span with 315 | | None -> 316 | !on_internal_error (spf "manual span does not a contain an OTEL scope") 317 | | Some scope -> Otel.Scope.add_attrs scope (fun () -> data) 318 | 319 | let message ?span ~data:_ msg : unit = 320 | (* gather information from context *) 321 | let old_scope = Otel.Scope.get_ambient_scope () in 322 | let trace_id = Option.map (fun sc -> sc.Otel.Scope.trace_id) old_scope in 323 | 324 | let span_id = 325 | match span with 326 | | Some id -> Some (span_id_to_otel id) 327 | | None -> Option.map (fun sc -> sc.Otel.Scope.span_id) old_scope 328 | in 329 | 330 | let log = Otel.Logs.make_str ?trace_id ?span_id msg in 331 | Otel.Logs.emit [ log ] 332 | 333 | let shutdown () = () 334 | 335 | let name_process _name = () 336 | 337 | let name_thread _name = () 338 | 339 | let counter_int ~data name cur_val : unit = 340 | let _kind, attrs = otel_attrs_of_otrace_data data in 341 | let m = Otel.Metrics.(gauge ~name [ int ~attrs cur_val ]) in 342 | Otel.Metrics.emit [ m ] 343 | 344 | let counter_float ~data name cur_val : unit = 345 | let _kind, attrs = otel_attrs_of_otrace_data data in 346 | let m = Otel.Metrics.(gauge ~name [ float ~attrs cur_val ]) in 347 | Otel.Metrics.emit [ m ] 348 | 349 | let extension_event = function 350 | | Ev_link_span (sp1, sp2) -> 351 | (match get_scope sp1, get_scope sp2 with 352 | | Some sc1, Some sc2 -> 353 | Otel.Scope.add_links sc1 (fun () -> [ Otel.Scope.to_span_link sc2 ]) 354 | | _ -> !on_internal_error "could not find scope for OTEL span") 355 | | Ev_set_span_kind (sp, k) -> 356 | (match get_scope sp with 357 | | None -> !on_internal_error "could not find scope for OTEL span" 358 | | Some sc -> Otel.Scope.set_kind sc k) 359 | | Ev_record_exn (sp, exn, bt) -> 360 | (match get_scope sp with 361 | | None -> !on_internal_error "could not find scope for OTEL span" 362 | | Some sc -> Otel.Scope.record_exception sc exn bt) 363 | | _ -> () 364 | end 365 | end 366 | 367 | let link_spans (sp1 : Otrace.explicit_span) (sp2 : Otrace.explicit_span) : unit 368 | = 369 | if Otrace.enabled () then Otrace.extension_event @@ Ev_link_span (sp1, sp2) 370 | 371 | let set_span_kind sp k : unit = 372 | if Otrace.enabled () then Otrace.extension_event @@ Ev_set_span_kind (sp, k) 373 | 374 | let record_exception sp exn bt : unit = 375 | if Otrace.enabled () then Otrace.extension_event @@ Ev_record_exn (sp, exn, bt) 376 | 377 | let collector () : Otrace.collector = (module Internal.M) 378 | 379 | let setup () = Otrace.setup_collector @@ collector () 380 | 381 | let setup_with_otel_backend b : unit = 382 | Otel.Collector.set_backend b; 383 | setup () 384 | -------------------------------------------------------------------------------- /src/trace/opentelemetry_trace.mli: -------------------------------------------------------------------------------- 1 | module Otel := Opentelemetry 2 | module Otrace := Trace_core 3 | module TLS := Thread_local_storage 4 | 5 | module Conv : sig 6 | val trace_id_of_otel : Otel.Trace_id.t -> string 7 | 8 | val trace_id_to_otel : string -> Otel.Trace_id.t 9 | 10 | val span_id_of_otel : Otel.Span_id.t -> int64 11 | 12 | val span_id_to_otel : int64 -> Otel.Span_id.t 13 | 14 | val ctx_to_otel : Otrace.explicit_span_ctx -> Otel.Span_ctx.t 15 | 16 | val ctx_of_otel : Otel.Span_ctx.t -> Otrace.explicit_span_ctx 17 | end 18 | 19 | (** [opentelemetry.trace] implements a {!Trace_core.Collector} for 20 | {{:https://v3.ocaml.org/p/trace} ocaml-trace}. 21 | 22 | After installing this collector with {!setup}, you can consume libraries 23 | that use [ocaml-trace], and they will automatically emit OpenTelemetry spans 24 | and logs. 25 | 26 | Both explicit scope (in the [_manual] functions such as [enter_manual_span]) 27 | and implicit scope (in {!Internal.M.with_span}, via {!Ambient_context}) are 28 | supported; see the detailed notes on {!Internal.M.enter_manual_span}. 29 | 30 | {1:wellknown Well-known identifiers} 31 | 32 | Because [ocaml-trace]'s API is a subset of OpenTelemetry functionality, this 33 | interface allows for a few 'well-known' identifiers to be used in 34 | [Trace]-instrumented libraries that wish to further support OpenTelemetry 35 | usage. 36 | 37 | (These strings will not change in subsequent versions of this library, so 38 | you do not need to depend on [opentelemetry.trace] to use them.) 39 | 40 | - If a key of exactly ["otrace.spankind"] is included in the 41 | {!Trace_core.user_data} passed to [with_span] et al., it will be used as 42 | the {!Opentelemetry.Span.kind} of the emitted span. (See 43 | {!Internal.spankind_of_string} for the list of supported values.) 44 | 45 | {[ 46 | ocaml 47 | let describe () = [ Opentelemetry_trace.(spankind_key, client) ] in 48 | Trace_core.with_span ~__FILE__ ~__LINE__ ~data:describe "my-span" 49 | @@ fun _ -> 50 | (* ... *) 51 | ]} *) 52 | 53 | val on_internal_error : (string -> unit) ref 54 | (** Callback to print errors in the library itself (ie bugs) *) 55 | 56 | val setup : unit -> unit 57 | (** Install the OTEL backend as a Trace collector *) 58 | 59 | val setup_with_otel_backend : Opentelemetry.Collector.backend -> unit 60 | (** Same as {!setup}, but also install the given backend as OTEL backend *) 61 | 62 | val collector : unit -> Trace_core.collector 63 | (** Make a Trace collector that uses the OTEL backend to send spans and logs *) 64 | 65 | val link_spans : Otrace.explicit_span -> Otrace.explicit_span -> unit 66 | (** [link_spans sp1 sp2] modifies [sp1] by adding a span link to [sp2]. 67 | @since 0.11 *) 68 | 69 | val set_span_kind : Otrace.explicit_span -> Otel.Span.kind -> unit 70 | (** [set_span_kind sp k] sets the span's kind. 71 | @since 0.11 *) 72 | 73 | val record_exception : 74 | Otrace.explicit_span -> exn -> Printexc.raw_backtrace -> unit 75 | (** Record exception in the current span. 76 | @since 0.11 *) 77 | 78 | (** Static references for well-known identifiers; see {!label-wellknown}. *) 79 | module Well_known : sig 80 | val spankind_key : string 81 | 82 | val internal : Otrace.user_data 83 | 84 | val server : Otrace.user_data 85 | 86 | val client : Otrace.user_data 87 | 88 | val producer : Otrace.user_data 89 | 90 | val consumer : Otrace.user_data 91 | 92 | val spankind_of_string : string -> Otel.Span.kind 93 | 94 | val otel_attrs_of_otrace_data : 95 | (string * Otrace.user_data) list -> 96 | Otel.Span.kind * Otel.Span.key_value list 97 | end 98 | [@@deprecated "use the regular functions for this"] 99 | 100 | (**/**) 101 | 102 | (** Internal implementation details; do not consider these stable. *) 103 | module Internal : sig 104 | module M : sig 105 | val with_span : 106 | __FUNCTION__:string option -> 107 | __FILE__:string -> 108 | __LINE__:int -> 109 | data:(string * Otrace.user_data) list -> 110 | string (* span name *) -> 111 | (Otrace.span -> 'a) -> 112 | 'a 113 | (** Implements {!Trace_core.Collector.S.with_span}, with the OpenTelemetry 114 | collector as the backend. Invoked via {!Trace_core.with_span}. 115 | 116 | Notably, this has the same implicit-scope semantics as 117 | {!Opentelemetry.Trace.with_}, and requires configuration of 118 | {!Ambient_context}. 119 | 120 | @see 121 | ambient-context docs *) 122 | 123 | val enter_manual_span : 124 | parent:Otrace.explicit_span_ctx option -> 125 | flavor:'a -> 126 | __FUNCTION__:string option -> 127 | __FILE__:string -> 128 | __LINE__:int -> 129 | data:(string * Otrace.user_data) list -> 130 | string (* span name *) -> 131 | Otrace.explicit_span 132 | (** Implements {!Trace_core.Collector.S.enter_manual_span}, with the 133 | OpenTelemetry collector as the backend. Invoked at 134 | {!Trace_core.enter_manual_toplevel_span} and 135 | {!Trace_core.enter_manual_sub_span}; requires an eventual call to 136 | {!Trace_core.exit_manual_span}. 137 | 138 | These 'manual span' functions {e do not} implement the same implicit- 139 | scope semantics of {!with_span}; and thus don't need to wrap a single 140 | stack-frame / callback; you can freely enter a span at any point, store 141 | the returned {!Trace_core.explicit_span}, and exit it at any later point 142 | with {!Trace_core.exit_manual_span}. 143 | 144 | However, for that same reason, they also cannot update the 145 | {!Ambient_context} — that is, when you invoke the various [manual] 146 | functions, if you then invoke other functions that use 147 | {!Trace_core.with_span}, those callees {e will not} see the span you 148 | entered manually as their [parent]. 149 | 150 | Generally, the best practice is to only use these [manual] functions at 151 | the 'leaves' of your callstack: that is, don't invoke user callbacks 152 | from within them; or if you do, make sure to pass the [explicit_span] 153 | you recieve from this function onwards to the user callback, so they can 154 | create further child-spans. *) 155 | 156 | val exit_manual_span : Otrace.explicit_span -> unit 157 | (** Implements {!Trace_core.Collector.S.exit_manual_span}, with the 158 | OpenTelemetry collector as the backend. Invoked at 159 | {!Trace_core.exit_manual_span}. Expects the [explicit_span] returned 160 | from an earlier call to {!Trace_core.enter_manual_toplevel_span} or 161 | {!Trace_core.enter_manual_sub_span}. 162 | 163 | (See the notes at {!enter_manual_span} about {!Ambient_context}.) *) 164 | 165 | val add_data_to_span : 166 | Otrace.span -> (string * Otrace.user_data) list -> unit 167 | 168 | val add_data_to_manual_span : 169 | Otrace.explicit_span -> (string * Otrace.user_data) list -> unit 170 | 171 | val message : 172 | ?span:Otrace.span -> 173 | data:(string * Otrace.user_data) list -> 174 | string -> 175 | unit 176 | 177 | val shutdown : unit -> unit 178 | 179 | val name_process : string -> unit 180 | 181 | val name_thread : string -> unit 182 | 183 | val counter_int : 184 | data:(string * Otrace.user_data) list -> string -> int -> unit 185 | 186 | val counter_float : 187 | data:(string * Otrace.user_data) list -> string -> float -> unit 188 | end 189 | 190 | type span_begin = { 191 | start_time: int64; 192 | name: string; 193 | __FILE__: string; 194 | __LINE__: int; 195 | __FUNCTION__: string option; 196 | scope: Otel.Scope.t; 197 | parent: Otel.Span_ctx.t option; 198 | } 199 | 200 | module Active_span_tbl : Hashtbl.S with type key = Otrace.span 201 | 202 | (** Table indexed by ocaml-trace spans. *) 203 | module Active_spans : sig 204 | type t = private { tbl: span_begin Active_span_tbl.t } [@@unboxed] 205 | 206 | val create : unit -> t 207 | 208 | val k_tls : t TLS.t 209 | 210 | val get : unit -> t 211 | end 212 | 213 | val otrace_of_otel : Otel.Span_id.t -> Otrace.span 214 | 215 | val enter_span' : 216 | ?explicit_parent:Otrace.explicit_span_ctx -> 217 | __FUNCTION__:string option -> 218 | __FILE__:string -> 219 | __LINE__:int -> 220 | data:(string * Otrace.user_data) list -> 221 | string -> 222 | Otrace.span * span_begin 223 | 224 | val exit_span' : Otrace.span -> span_begin -> Otel.Span.t 225 | end 226 | 227 | (**/**) 228 | -------------------------------------------------------------------------------- /tests/bin/cohttp_client.ml: -------------------------------------------------------------------------------- 1 | module T = Opentelemetry 2 | module Otel_lwt = Opentelemetry_lwt 3 | 4 | let spf = Printf.sprintf 5 | 6 | let ( let@ ) f x = f x 7 | 8 | let sleep_inner = ref 0.1 9 | 10 | let sleep_outer = ref 2.0 11 | 12 | let mk_client ~scope = 13 | Opentelemetry_cohttp_lwt.client ~scope (module Cohttp_lwt_unix.Client) 14 | 15 | let run () = 16 | let open Lwt.Syntax in 17 | let rec go () = 18 | let@ scope = 19 | Otel_lwt.Trace.with_ ~kind:T.Span.Span_kind_producer "loop.outer" 20 | in 21 | let* () = Lwt_unix.sleep !sleep_outer in 22 | let module C = (val mk_client ~scope) in 23 | let* _res, body = 24 | C.get (Uri.of_string "https://enec1hql02hz.x.pipedream.net") 25 | in 26 | let* () = Cohttp_lwt.Body.drain_body body in 27 | go () 28 | in 29 | go () 30 | 31 | let () = 32 | Sys.catch_break true; 33 | T.Globals.service_name := "ocaml-otel-cohttp-client"; 34 | T.Globals.service_namespace := Some "ocaml-otel.test"; 35 | 36 | let debug = ref false in 37 | let batch_traces = ref 400 in 38 | let batch_metrics = ref 3 in 39 | let opts = 40 | [ 41 | "--debug", Arg.Bool (( := ) debug), " enable debug output"; 42 | "--batch-traces", Arg.Int (( := ) batch_traces), " size of traces batch"; 43 | ( "--batch-metrics", 44 | Arg.Int (( := ) batch_metrics), 45 | " size of metrics batch" ); 46 | "--sleep-inner", Arg.Set_float sleep_inner, " sleep (in s) in inner loop"; 47 | "--sleep-outer", Arg.Set_float sleep_outer, " sleep (in s) in outer loop"; 48 | ] 49 | |> Arg.align 50 | in 51 | 52 | Arg.parse opts (fun _ -> ()) "emit1 [opt]*"; 53 | 54 | let some_if_nzero r = 55 | if !r > 0 then 56 | Some !r 57 | else 58 | None 59 | in 60 | let config = 61 | Opentelemetry_client_cohttp_lwt.Config.make ~debug:!debug 62 | ~batch_traces:(some_if_nzero batch_traces) 63 | ~batch_metrics:(some_if_nzero batch_metrics) 64 | () 65 | in 66 | Format.printf "@[<2>sleep outer: %.3fs,@ sleep inner: %.3fs,@ config: %a@]@." 67 | !sleep_outer !sleep_inner Opentelemetry_client_cohttp_lwt.Config.pp config; 68 | 69 | Format.printf 70 | "Check HTTP requests at \ 71 | https://requestbin.com/r/enec1hql02hz/26qShWryt5vJc1JfrOwalhr5vQt@."; 72 | 73 | Opentelemetry_client_cohttp_lwt.with_setup ~config () run |> Lwt_main.run 74 | -------------------------------------------------------------------------------- /tests/bin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name emit1) 3 | (modules emit1) 4 | (libraries unix opentelemetry opentelemetry-client-ocurl)) 5 | 6 | (executable 7 | (name emit1_cohttp) 8 | (modules emit1_cohttp) 9 | (preprocess 10 | (pps lwt_ppx)) 11 | (libraries 12 | unix 13 | opentelemetry 14 | opentelemetry-lwt 15 | opentelemetry-client-cohttp-lwt 16 | lwt.unix)) 17 | 18 | (executable 19 | (name cohttp_client) 20 | (modules cohttp_client) 21 | (libraries 22 | cohttp-lwt-unix 23 | opentelemetry 24 | opentelemetry-client-cohttp-lwt 25 | opentelemetry-cohttp-lwt)) 26 | -------------------------------------------------------------------------------- /tests/bin/emit1.ml: -------------------------------------------------------------------------------- 1 | module T = Opentelemetry 2 | module Atomic = Opentelemetry_atomic.Atomic 3 | 4 | let spf = Printf.sprintf 5 | 6 | let ( let@ ) = ( @@ ) 7 | 8 | let sleep_inner = ref 0.1 9 | 10 | let sleep_outer = ref 2.0 11 | 12 | let n_jobs = ref 1 13 | 14 | let n = ref max_int 15 | 16 | let num_sleep = Atomic.make 0 17 | 18 | let stress_alloc_ = ref true 19 | 20 | let stop = Atomic.make false 21 | 22 | let num_tr = Atomic.make 0 23 | 24 | let run_job () = 25 | let@ () = Fun.protect ~finally:(fun () -> Atomic.set stop true) in 26 | let i = ref 0 in 27 | let cnt = ref 0 in 28 | 29 | while (not @@ Atomic.get stop) && !cnt < !n do 30 | let@ _scope = 31 | Atomic.incr num_tr; 32 | T.Trace.with_ ~kind:T.Span.Span_kind_producer "loop.outer" 33 | ~attrs:[ "i", `Int !i ] 34 | in 35 | 36 | (* Printf.printf "cnt=%d\n%!" !cnt; *) 37 | incr cnt; 38 | 39 | for j = 0 to 4 do 40 | (* parent scope is found via thread local storage *) 41 | let@ scope = 42 | Atomic.incr num_tr; 43 | T.Trace.with_ ~kind:T.Span.Span_kind_internal 44 | ~attrs:[ "j", `Int j ] 45 | "loop.inner" 46 | in 47 | 48 | Unix.sleepf !sleep_outer; 49 | Atomic.incr num_sleep; 50 | 51 | T.Logs.( 52 | emit 53 | [ 54 | make_strf ~trace_id:scope.trace_id ~span_id:scope.span_id 55 | ~severity:Severity_number_info "inner at %d" j; 56 | ]); 57 | 58 | incr i; 59 | 60 | try 61 | Atomic.incr num_tr; 62 | let@ _ = T.Trace.with_ ~kind:T.Span.Span_kind_internal ~scope "alloc" in 63 | (* allocate some stuff *) 64 | if !stress_alloc_ then ( 65 | let _arr = Sys.opaque_identity @@ Array.make (25 * 25551) 42.0 in 66 | ignore _arr 67 | ); 68 | 69 | Unix.sleepf !sleep_inner; 70 | Atomic.incr num_sleep; 71 | 72 | if j = 4 && !i mod 13 = 0 then failwith "oh no"; 73 | 74 | (* simulate a failure *) 75 | Opentelemetry.Scope.add_event scope (fun () -> 76 | T.Event.make "done with alloc") 77 | with Failure _ -> () 78 | done 79 | done 80 | 81 | let run () = 82 | T.GC_metrics.basic_setup (); 83 | 84 | T.Metrics_callbacks.register (fun () -> 85 | T.Metrics. 86 | [ 87 | sum ~name:"num-sleep" ~is_monotonic:true 88 | [ int (Atomic.get num_sleep) ]; 89 | ]); 90 | 91 | let n_jobs = max 1 !n_jobs in 92 | Printf.printf "run %d jobs\n%!" n_jobs; 93 | 94 | let jobs = 95 | Array.init n_jobs (fun _ -> 96 | let job () = try run_job () with Sys.Break -> () in 97 | Thread.create job ()) 98 | in 99 | Array.iter Thread.join jobs 100 | 101 | let () = 102 | Sys.catch_break true; 103 | T.Globals.service_name := "t1"; 104 | T.Globals.service_namespace := Some "ocaml-otel.test"; 105 | let ts_start = Unix.gettimeofday () in 106 | 107 | let debug = ref false in 108 | let n_bg_threads = ref 0 in 109 | let opts = 110 | [ 111 | "--debug", Arg.Bool (( := ) debug), " enable debug output"; 112 | ( "--stress-alloc", 113 | Arg.Bool (( := ) stress_alloc_), 114 | " perform heavy allocs in inner loop" ); 115 | "--sleep-inner", Arg.Set_float sleep_inner, " sleep (in s) in inner loop"; 116 | "--sleep-outer", Arg.Set_float sleep_outer, " sleep (in s) in outer loop"; 117 | "-j", Arg.Set_int n_jobs, " number of parallel jobs"; 118 | "--bg-threads", Arg.Set_int n_bg_threads, " number of background threads"; 119 | "-n", Arg.Set_int n, " number of iterations (default ∞)"; 120 | ] 121 | |> Arg.align 122 | in 123 | 124 | Arg.parse opts (fun _ -> ()) "emit1 [opt]*"; 125 | 126 | let config = 127 | Opentelemetry_client_ocurl.Config.make ~debug:!debug ~self_trace:true 128 | ?bg_threads: 129 | (let n = !n_bg_threads in 130 | if n = 0 then 131 | None 132 | else 133 | Some n) 134 | () 135 | in 136 | Format.printf "@[<2>sleep outer: %.3fs,@ sleep inner: %.3fs,@ config: %a@]@." 137 | !sleep_outer !sleep_inner Opentelemetry_client_ocurl.Config.pp config; 138 | 139 | let@ () = 140 | Fun.protect ~finally:(fun () -> 141 | let elapsed = Unix.gettimeofday () -. ts_start in 142 | let n_per_sec = float (Atomic.get num_tr) /. elapsed in 143 | Printf.printf "\ndone. %d spans in %.4fs (%.4f/s)\n%!" 144 | (Atomic.get num_tr) elapsed n_per_sec) 145 | in 146 | Opentelemetry_client_ocurl.with_setup ~stop ~config () run 147 | -------------------------------------------------------------------------------- /tests/bin/emit1_cohttp.ml: -------------------------------------------------------------------------------- 1 | module T = Opentelemetry_lwt 2 | module Atomic = Opentelemetry_atomic.Atomic 3 | open Lwt.Syntax 4 | 5 | let spf = Printf.sprintf 6 | 7 | let ( let@ ) f x = f x 8 | 9 | let sleep_inner = ref 0.1 10 | 11 | let sleep_outer = ref 2.0 12 | 13 | let n_jobs = ref 1 14 | 15 | let num_sleep = Atomic.make 0 16 | 17 | let stress_alloc_ = ref true 18 | 19 | let stop = Atomic.make false 20 | 21 | let num_tr = Atomic.make 0 22 | 23 | let run_job () : unit Lwt.t = 24 | let i = ref 0 in 25 | while%lwt not @@ Atomic.get stop do 26 | let@ scope = 27 | Atomic.incr num_tr; 28 | T.Trace.with_ ~kind:T.Span.Span_kind_producer "loop.outer" 29 | ~attrs:[ "i", `Int !i ] 30 | in 31 | 32 | for%lwt j = 0 to 4 do 33 | (* parent scope is found via thread local storage *) 34 | let@ scope = 35 | Atomic.incr num_tr; 36 | T.Trace.with_ ~scope ~kind:T.Span.Span_kind_internal 37 | ~attrs:[ "j", `Int j ] 38 | "loop.inner" 39 | in 40 | 41 | let* () = Lwt_unix.sleep !sleep_outer in 42 | Atomic.incr num_sleep; 43 | 44 | T.Logs.( 45 | emit 46 | [ 47 | make_strf ~trace_id:scope.trace_id ~span_id:scope.span_id 48 | ~severity:Severity_number_info "inner at %d" j; 49 | ]); 50 | 51 | incr i; 52 | 53 | try%lwt 54 | Atomic.incr num_tr; 55 | let@ scope = 56 | T.Trace.with_ ~kind:T.Span.Span_kind_internal ~scope "alloc" 57 | in 58 | (* allocate some stuff *) 59 | if !stress_alloc_ then ( 60 | let _arr = Sys.opaque_identity @@ Array.make (25 * 25551) 42.0 in 61 | ignore _arr 62 | ); 63 | 64 | let* () = Lwt_unix.sleep !sleep_inner in 65 | Atomic.incr num_sleep; 66 | 67 | if j = 4 && !i mod 13 = 0 then failwith "oh no"; 68 | 69 | (* simulate a failure *) 70 | Opentelemetry.Scope.add_event scope (fun () -> 71 | T.Event.make "done with alloc"); 72 | Lwt.return () 73 | with Failure _ -> Lwt.return () 74 | done 75 | done 76 | 77 | let run () : unit Lwt.t = 78 | T.GC_metrics.basic_setup (); 79 | 80 | T.Metrics_callbacks.register (fun () -> 81 | T.Metrics. 82 | [ 83 | sum ~name:"num-sleep" ~is_monotonic:true 84 | [ int (Atomic.get num_sleep) ]; 85 | ]); 86 | 87 | let n_jobs = max 1 !n_jobs in 88 | Printf.printf "run %d jobs\n%!" n_jobs; 89 | 90 | let jobs = Array.init n_jobs (fun _ -> run_job ()) |> Array.to_list in 91 | Lwt.join jobs 92 | 93 | let () = 94 | Sys.catch_break true; 95 | T.Globals.service_name := "t1"; 96 | T.Globals.service_namespace := Some "ocaml-otel.test"; 97 | let ts_start = Unix.gettimeofday () in 98 | 99 | let debug = ref false in 100 | let batch_traces = ref 400 in 101 | let batch_metrics = ref 3 in 102 | let opts = 103 | [ 104 | "--debug", Arg.Bool (( := ) debug), " enable debug output"; 105 | ( "--stress-alloc", 106 | Arg.Bool (( := ) stress_alloc_), 107 | " perform heavy allocs in inner loop" ); 108 | "--batch-traces", Arg.Int (( := ) batch_traces), " size of traces batch"; 109 | ( "--batch-metrics", 110 | Arg.Int (( := ) batch_metrics), 111 | " size of metrics batch" ); 112 | "--sleep-inner", Arg.Set_float sleep_inner, " sleep (in s) in inner loop"; 113 | "--sleep-outer", Arg.Set_float sleep_outer, " sleep (in s) in outer loop"; 114 | "-j", Arg.Set_int n_jobs, " number of parallel jobs"; 115 | ] 116 | |> Arg.align 117 | in 118 | 119 | Arg.parse opts (fun _ -> ()) "emit1 [opt]*"; 120 | 121 | let some_if_nzero r = 122 | if !r > 0 then 123 | Some !r 124 | else 125 | None 126 | in 127 | let config = 128 | Opentelemetry_client_cohttp_lwt.Config.make ~debug:!debug 129 | ~batch_traces:(some_if_nzero batch_traces) 130 | ~batch_metrics:(some_if_nzero batch_metrics) 131 | () 132 | in 133 | Format.printf "@[<2>sleep outer: %.3fs,@ sleep inner: %.3fs,@ config: %a@]@." 134 | !sleep_outer !sleep_inner Opentelemetry_client_cohttp_lwt.Config.pp config; 135 | 136 | let@ () = 137 | Fun.protect ~finally:(fun () -> 138 | let elapsed = Unix.gettimeofday () -. ts_start in 139 | let n_per_sec = float (Atomic.get num_tr) /. elapsed in 140 | Printf.printf "\ndone. %d spans in %.4fs (%.4f/s)\n%!" 141 | (Atomic.get num_tr) elapsed n_per_sec) 142 | in 143 | Opentelemetry_client_cohttp_lwt.with_setup ~stop ~config () run 144 | |> Lwt_main.run 145 | -------------------------------------------------------------------------------- /tests/cohttp/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (names test_urls) 3 | (package opentelemetry-client-cohttp-lwt) 4 | (libraries opentelemetry opentelemetry-client-cohttp-lwt)) 5 | -------------------------------------------------------------------------------- /tests/cohttp/test_urls.expected: -------------------------------------------------------------------------------- 1 | --- default_url --- 2 | url_traces = http://localhost:4318/v1/traces 3 | url_metrics = http://localhost:4318/v1/metrics 4 | url_logs = http://localhost:4318/v1/logs 5 | ------ 6 | 7 | --- base_url_from_config --- 8 | url_traces = http://localhost:3000/v1/traces 9 | url_metrics = http://localhost:3000/v1/metrics 10 | url_logs = http://localhost:3000/v1/logs 11 | ------ 12 | 13 | --- base_url_from_env --- 14 | url_traces = http://localhost:5000/v1/traces 15 | url_metrics = http://localhost:5000/v1/metrics 16 | url_logs = http://localhost:5000/v1/logs 17 | ------ 18 | 19 | --- base_url_from_both_config_and_env --- 20 | url_traces = http://localhost:5000/v1/traces 21 | url_metrics = http://localhost:5000/v1/metrics 22 | url_logs = http://localhost:5000/v1/logs 23 | ------ 24 | 25 | --- override_trace_url_from_config --- 26 | url_traces = http://localhost:3001/send/traces 27 | url_metrics = http://localhost:5000/v1/metrics 28 | url_logs = http://localhost:5000/v1/logs 29 | ------ 30 | 31 | --- override_trace_url_from_env --- 32 | url_traces = http://localhost:3001/send/traces 33 | url_metrics = http://localhost:5000/v1/metrics 34 | url_logs = http://localhost:5000/v1/logs 35 | ------ 36 | 37 | --- override_trace_url_from_both_config_and_env --- 38 | url_traces = http://localhost:3001/send/traces 39 | url_metrics = http://localhost:5000/v1/metrics 40 | url_logs = http://localhost:5000/v1/logs 41 | ------ 42 | 43 | --- set_all_in_config --- 44 | url_traces = http://localhost:3001/send/traces 45 | url_metrics = http://localhost:3002/send/metrics 46 | url_logs = http://localhost:3003/send/logs 47 | ------ 48 | 49 | --- set_all_in_env --- 50 | url_traces = http://localhost:3001/send/traces 51 | url_metrics = http://localhost:3002/send/metrics 52 | url_logs = http://localhost:3003/send/logs 53 | ------ 54 | 55 | --- remove_trailing_slash_config --- 56 | url_traces = http://localhost:3001/send/traces 57 | url_metrics = http://localhost:3002/send/metrics 58 | url_logs = http://localhost:3003/send/logs 59 | ------ 60 | 61 | --- remove_trailing_slash_env --- 62 | url_traces = http://localhost:3001/send/traces 63 | url_metrics = http://localhost:3002/send/metrics 64 | url_logs = http://localhost:3003/send/logs 65 | ------ 66 | 67 | -------------------------------------------------------------------------------- /tests/cohttp/test_urls.ml: -------------------------------------------------------------------------------- 1 | open Opentelemetry_client_cohttp_lwt 2 | 3 | let test_urls ~name config = 4 | Printf.printf "--- %s ---\n" name; 5 | Printf.printf "url_traces = %s\n" config.Config.url_traces; 6 | Printf.printf "url_metrics = %s\n" config.Config.url_metrics; 7 | Printf.printf "url_logs = %s\n" config.Config.url_logs; 8 | print_endline "------\n" 9 | 10 | let default_url () = 11 | let config = Config.make () in 12 | test_urls ~name:"default_url" config 13 | 14 | let base_url_from_config () = 15 | let config = Config.make ~url:"http://localhost:3000" () in 16 | test_urls ~name:"base_url_from_config" config 17 | 18 | let base_url_from_env () = 19 | Unix.putenv "OTEL_EXPORTER_OTLP_ENDPOINT" "http://localhost:5000"; 20 | let config = Config.make () in 21 | test_urls ~name:"base_url_from_env" config 22 | 23 | let base_url_from_both_config_and_env () = 24 | (* url from env should take precedence *) 25 | Unix.putenv "OTEL_EXPORTER_OTLP_ENDPOINT" "http://localhost:5000"; 26 | let config = Config.make ~url:"http://localhost:3000" () in 27 | test_urls ~name:"base_url_from_both_config_and_env" config 28 | 29 | let override_trace_url_from_config () = 30 | let config = 31 | Config.make ~url:"http://localhost:3000" 32 | ~url_traces:"http://localhost:3001/send/traces" () 33 | in 34 | test_urls ~name:"override_trace_url_from_config" config 35 | 36 | let override_trace_url_from_env () = 37 | Unix.putenv "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" 38 | "http://localhost:3001/send/traces"; 39 | let config = Config.make () in 40 | test_urls ~name:"override_trace_url_from_env" config 41 | 42 | let override_trace_url_from_both_config_and_env () = 43 | Unix.putenv "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" 44 | "http://localhost:3001/send/traces/env"; 45 | let config = 46 | Config.make ~url_traces:"http://localhost:3001/send/traces/config" () 47 | in 48 | test_urls ~name:"override_trace_url_from_both_config_and_env" config 49 | 50 | let set_all_in_config () = 51 | let config = 52 | Config.make ~url_traces:"http://localhost:3001/send/traces" 53 | ~url_metrics:"http://localhost:3002/send/metrics" 54 | ~url_logs:"http://localhost:3003/send/logs" () 55 | in 56 | test_urls ~name:"set_all_in_config" config 57 | 58 | let set_all_in_env () = 59 | Unix.putenv "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" 60 | "http://localhost:3001/send/traces"; 61 | Unix.putenv "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT" 62 | "http://localhost:3002/send/metrics"; 63 | Unix.putenv "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT" 64 | "http://localhost:3003/send/logs"; 65 | let config = Config.make () in 66 | test_urls ~name:"set_all_in_env" config 67 | 68 | let remove_trailing_slash_config () = 69 | let config = Config.make ~url:"http://localhost:3000/" () in 70 | test_urls ~name:"remove_trailing_slash_config" config 71 | 72 | let remove_trailing_slash_env () = 73 | Unix.putenv "OTEL_EXPORTER_OTLP_ENDPOINT" "http://localhost:3000/"; 74 | let config = Config.make () in 75 | test_urls ~name:"remove_trailing_slash_env" config 76 | 77 | let () = default_url () 78 | 79 | let () = base_url_from_config () 80 | 81 | let () = base_url_from_env () 82 | 83 | let () = base_url_from_both_config_and_env () 84 | 85 | let () = override_trace_url_from_config () 86 | 87 | let () = override_trace_url_from_env () 88 | 89 | let () = override_trace_url_from_both_config_and_env () 90 | 91 | let () = set_all_in_config () 92 | 93 | let () = set_all_in_env () 94 | 95 | let () = remove_trailing_slash_config () 96 | 97 | let () = remove_trailing_slash_env () 98 | -------------------------------------------------------------------------------- /tests/core/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (names test_trace_context) 3 | (package opentelemetry) 4 | (libraries opentelemetry)) 5 | -------------------------------------------------------------------------------- /tests/core/test_trace_context.expected: -------------------------------------------------------------------------------- 1 | Trace_context.Traceparent.of_value "xx": 2 | Error "trace context must be 55 bytes" 3 | Trace_context.Traceparent.of_value "00": 4 | Error "trace context must be 55 bytes" 5 | Trace_context.Traceparent.of_value "00-xxxx": 6 | Error "trace context must be 55 bytes" 7 | Trace_context.Traceparent.of_value "00-xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx": 8 | Error "trace context must be 55 bytes" 9 | Trace_context.Traceparent.of_value "00-0123456789abcdef0123456789abcdef": 10 | Error "trace context must be 55 bytes" 11 | Trace_context.Traceparent.of_value "00-0123456789abcdef0123456789abcdef-xxxx": 12 | Error "trace context must be 55 bytes" 13 | Trace_context.Traceparent.of_value "00-0123456789abcdef0123456789abcdef-xxxxxxxxxxxxxxxx": 14 | Error "trace context must be 55 bytes" 15 | Trace_context.Traceparent.of_value "00-0123456789abcdef0123456789abcdef-0123456789abcdef": 16 | Error "trace context must be 55 bytes" 17 | Trace_context.Traceparent.of_value "00-0123456789abcdef0123456789abcdef-0123456789abcdef-": 18 | Error "trace context must be 55 bytes" 19 | Trace_context.Traceparent.of_value "00-0123456789abcdef0123456789abcdef-0123456789abcdef-00": 20 | Ok trace_id:"0123456789abcdef0123456789abcdef" parent_id:"0123456789abcdef" 21 | Trace_context.Traceparent.of_value "00-4bf92f3577b34da6a3ce929d0e0e4736-00f067aa0ba902b7-01": 22 | Ok trace_id:"4bf92f3577b34da6a3ce929d0e0e4736" parent_id:"00f067aa0ba902b7" 23 | Trace_context.Traceparent.of_value "03-4bf92f3577b34da6a3ce929d0e0e4736-00f067aa0ba902b7-01": 24 | Error "version is 3, expected 0" 25 | Trace_context.Traceparent.of_value "00-ohnonohex7b34da6a3ce929d0e0e4736-00f067aa0ba902b7-01": 26 | Error "in trace id: invalid hex char: 'o'" 27 | Trace_context.Traceparent.of_value "00-4bf92f3577b34da6a3ce929d0e0e4736-00f067aazzzzzzb7-01": 28 | Error "in span id: invalid hex char: 'z'" 29 | 30 | Trace_context.Traceparent.to_value trace_id:"4bf92f3577b34da6a3ce929d0e0e4736" parent_id:"00f067aa0ba902b7": 31 | "00-4bf92f3577b34da6a3ce929d0e0e4736-00f067aa0ba902b7-00" 32 | -------------------------------------------------------------------------------- /tests/core/test_trace_context.ml: -------------------------------------------------------------------------------- 1 | open Opentelemetry 2 | 3 | let pp_traceparent fmt (trace_id, parent_id) = 4 | let open Format in 5 | fprintf fmt "trace_id:%S parent_id:%S" (Trace_id.to_hex trace_id) 6 | (Span_id.to_hex parent_id) 7 | 8 | let test_of_value str = 9 | let open Format in 10 | printf "@[Trace_context.Traceparent.of_value %S:@ %a@]@." str 11 | (pp_print_result 12 | ~ok:(fun fmt (trace_id, parent_id) -> 13 | fprintf fmt "Ok %a" pp_traceparent (trace_id, parent_id)) 14 | ~error:(fun fmt msg -> fprintf fmt "Error %S" msg)) 15 | (Trace_context.Traceparent.of_value str) 16 | 17 | let () = test_of_value "xx" 18 | 19 | let () = test_of_value "00" 20 | 21 | let () = test_of_value "00-xxxx" 22 | 23 | let () = test_of_value "00-xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" 24 | 25 | let () = test_of_value "00-0123456789abcdef0123456789abcdef" 26 | 27 | let () = test_of_value "00-0123456789abcdef0123456789abcdef-xxxx" 28 | 29 | let () = test_of_value "00-0123456789abcdef0123456789abcdef-xxxxxxxxxxxxxxxx" 30 | 31 | let () = test_of_value "00-0123456789abcdef0123456789abcdef-0123456789abcdef" 32 | 33 | let () = test_of_value "00-0123456789abcdef0123456789abcdef-0123456789abcdef-" 34 | 35 | let () = test_of_value "00-0123456789abcdef0123456789abcdef-0123456789abcdef-00" 36 | 37 | let () = test_of_value "00-4bf92f3577b34da6a3ce929d0e0e4736-00f067aa0ba902b7-01" 38 | 39 | let () = test_of_value "03-4bf92f3577b34da6a3ce929d0e0e4736-00f067aa0ba902b7-01" 40 | 41 | let () = test_of_value "00-ohnonohex7b34da6a3ce929d0e0e4736-00f067aa0ba902b7-01" 42 | 43 | let () = test_of_value "00-4bf92f3577b34da6a3ce929d0e0e4736-00f067aazzzzzzb7-01" 44 | 45 | let () = print_endline "" 46 | 47 | let test_to_value trace_id parent_id = 48 | let open Format in 49 | printf "@[Trace_context.Traceparent.to_value %a:@ %S@]@." pp_traceparent 50 | (trace_id, parent_id) 51 | (Trace_context.Traceparent.to_value ~trace_id ~parent_id ()) 52 | 53 | let () = 54 | test_to_value 55 | (Trace_id.of_hex "4bf92f3577b34da6a3ce929d0e0e4736") 56 | (Span_id.of_hex "00f067aa0ba902b7") 57 | -------------------------------------------------------------------------------- /tests/implicit_scope/sync/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (names test_implicit_scope_sync) 3 | (package opentelemetry-client-cohttp-lwt) 4 | (libraries alcotest opentelemetry opentelemetry-client-cohttp-lwt)) 5 | -------------------------------------------------------------------------------- /tests/implicit_scope/sync/test_implicit_scope_sync.ml: -------------------------------------------------------------------------------- 1 | open Alcotest 2 | module Otel = Opentelemetry 3 | 4 | let spans_emitted : Otel.Proto.Trace.resource_spans list ref = ref [] 5 | 6 | module Test_backend = struct 7 | open Otel.Collector 8 | open Otel.Proto 9 | include Noop_backend 10 | 11 | let record_emitted_spans (l : Trace.resource_spans list) ~ret = 12 | spans_emitted := l @ !spans_emitted; 13 | ret () 14 | 15 | let send_trace : Trace.resource_spans list sender = 16 | { send = record_emitted_spans } 17 | end 18 | 19 | let with_test_backend f = 20 | (* uncomment for eprintf debugging: *) 21 | (* let module Debug_and_test_backend = Otel.Collector.Debug_backend (Test_backend) in 22 | let backend = (module Debug_and_test_backend : Otel.Collector.BACKEND) in *) 23 | let backend = (module Test_backend : Otel.Collector.BACKEND) in 24 | Otel.Collector.with_setup_debug_backend backend () f 25 | 26 | let bytes_to_hex = Otel.Util_.bytes_to_hex 27 | 28 | let test_stack_based_implicit_scope () = 29 | let run () = 30 | Otel.Trace.with_ "first trace" @@ fun _scope -> 31 | Thread.delay 0.2; 32 | Otel.Trace.with_ "second trace" @@ fun _scope -> 33 | Thread.delay 0.2; 34 | Otel.Trace.with_ "third trace" @@ fun _scope -> 35 | Thread.delay 0.2; 36 | () 37 | in 38 | with_test_backend @@ fun () -> 39 | (* start *) 40 | run (); 41 | check' int ~msg:"count of spans emitted" 42 | ~actual:(List.length !spans_emitted) 43 | ~expected:3; 44 | let open Otel.Proto.Trace in 45 | let f prev_span_id { scope_spans; _ } = 46 | Format.printf "\n%a@\n" (Format.pp_print_list pp_scope_spans) scope_spans; 47 | check' int ~msg:"count of scope_spans in emitted span" 48 | ~actual:(List.length scope_spans) ~expected:1; 49 | let { scope; spans; _ } = List.hd scope_spans in 50 | check' bool ~msg:"scope exists in emitted span" 51 | ~actual:(Option.is_some scope) ~expected:true; 52 | check' int ~msg:"count of spans in scope_span" ~actual:(List.length spans) 53 | ~expected:1; 54 | let { name; trace_id; span_id; parent_span_id; _ } = List.hd spans in 55 | Printf.printf 56 | "name='%s' trace_id='%s' span_id='%s' parent_span_id='%s' \ 57 | prev_span_id='%s'\n" 58 | name (bytes_to_hex trace_id) (bytes_to_hex span_id) 59 | (bytes_to_hex parent_span_id) 60 | (bytes_to_hex prev_span_id); 61 | check' string ~msg:"previous span is parent" 62 | ~actual:(bytes_to_hex parent_span_id) 63 | ~expected:(bytes_to_hex prev_span_id); 64 | span_id 65 | in 66 | List.fold_left f (Bytes.of_string "") !spans_emitted |> ignore 67 | 68 | let suite = 69 | [ 70 | test_case "stack-based implicit scope" `Quick 71 | test_stack_based_implicit_scope; 72 | ] 73 | 74 | let () = Alcotest.run "implicit scope" [ "sync", suite ] 75 | -------------------------------------------------------------------------------- /tests/ocurl/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (names test_urls) 3 | (package opentelemetry-client-ocurl) 4 | (libraries opentelemetry opentelemetry-client-ocurl)) 5 | -------------------------------------------------------------------------------- /tests/ocurl/test_urls.expected: -------------------------------------------------------------------------------- 1 | --- default_url --- 2 | url_traces = http://localhost:4318/v1/traces 3 | url_metrics = http://localhost:4318/v1/metrics 4 | url_logs = http://localhost:4318/v1/logs 5 | ------ 6 | 7 | --- base_url_from_config --- 8 | url_traces = http://localhost:3000/v1/traces 9 | url_metrics = http://localhost:3000/v1/metrics 10 | url_logs = http://localhost:3000/v1/logs 11 | ------ 12 | 13 | --- base_url_from_env --- 14 | url_traces = http://localhost:5000/v1/traces 15 | url_metrics = http://localhost:5000/v1/metrics 16 | url_logs = http://localhost:5000/v1/logs 17 | ------ 18 | 19 | --- base_url_from_both_config_and_env --- 20 | url_traces = http://localhost:5000/v1/traces 21 | url_metrics = http://localhost:5000/v1/metrics 22 | url_logs = http://localhost:5000/v1/logs 23 | ------ 24 | 25 | --- override_trace_url_from_config --- 26 | url_traces = http://localhost:3001/send/traces 27 | url_metrics = http://localhost:5000/v1/metrics 28 | url_logs = http://localhost:5000/v1/logs 29 | ------ 30 | 31 | --- override_trace_url_from_env --- 32 | url_traces = http://localhost:3001/send/traces 33 | url_metrics = http://localhost:5000/v1/metrics 34 | url_logs = http://localhost:5000/v1/logs 35 | ------ 36 | 37 | --- override_trace_url_from_both_config_and_env --- 38 | url_traces = http://localhost:3001/send/traces 39 | url_metrics = http://localhost:5000/v1/metrics 40 | url_logs = http://localhost:5000/v1/logs 41 | ------ 42 | 43 | --- set_all_in_config --- 44 | url_traces = http://localhost:3001/send/traces 45 | url_metrics = http://localhost:3002/send/metrics 46 | url_logs = http://localhost:3003/send/logs 47 | ------ 48 | 49 | --- set_all_in_env --- 50 | url_traces = http://localhost:3001/send/traces 51 | url_metrics = http://localhost:3002/send/metrics 52 | url_logs = http://localhost:3003/send/logs 53 | ------ 54 | 55 | --- remove_trailing_slash_config --- 56 | url_traces = http://localhost:3001/send/traces 57 | url_metrics = http://localhost:3002/send/metrics 58 | url_logs = http://localhost:3003/send/logs 59 | ------ 60 | 61 | --- remove_trailing_slash_env --- 62 | url_traces = http://localhost:3001/send/traces 63 | url_metrics = http://localhost:3002/send/metrics 64 | url_logs = http://localhost:3003/send/logs 65 | ------ 66 | 67 | -------------------------------------------------------------------------------- /tests/ocurl/test_urls.ml: -------------------------------------------------------------------------------- 1 | open Opentelemetry_client_ocurl 2 | 3 | let test_urls ~name config = 4 | Printf.printf "--- %s ---\n" name; 5 | Printf.printf "url_traces = %s\n" config.Config.url_traces; 6 | Printf.printf "url_metrics = %s\n" config.Config.url_metrics; 7 | Printf.printf "url_logs = %s\n" config.Config.url_logs; 8 | print_endline "------\n" 9 | 10 | let default_url () = 11 | let config = Config.make () in 12 | test_urls ~name:"default_url" config 13 | 14 | let base_url_from_config () = 15 | let config = Config.make ~url:"http://localhost:3000" () in 16 | test_urls ~name:"base_url_from_config" config 17 | 18 | let base_url_from_env () = 19 | Unix.putenv "OTEL_EXPORTER_OTLP_ENDPOINT" "http://localhost:5000"; 20 | let config = Config.make () in 21 | test_urls ~name:"base_url_from_env" config 22 | 23 | let base_url_from_both_config_and_env () = 24 | (* url from env should take precedence *) 25 | Unix.putenv "OTEL_EXPORTER_OTLP_ENDPOINT" "http://localhost:5000"; 26 | let config = Config.make ~url:"http://localhost:3000" () in 27 | test_urls ~name:"base_url_from_both_config_and_env" config 28 | 29 | let override_trace_url_from_config () = 30 | let config = 31 | Config.make ~url:"http://localhost:3000" 32 | ~url_traces:"http://localhost:3001/send/traces" () 33 | in 34 | test_urls ~name:"override_trace_url_from_config" config 35 | 36 | let override_trace_url_from_env () = 37 | Unix.putenv "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" 38 | "http://localhost:3001/send/traces"; 39 | let config = Config.make () in 40 | test_urls ~name:"override_trace_url_from_env" config 41 | 42 | let override_trace_url_from_both_config_and_env () = 43 | Unix.putenv "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" 44 | "http://localhost:3001/send/traces/env"; 45 | let config = 46 | Config.make ~url_traces:"http://localhost:3001/send/traces/config" () 47 | in 48 | test_urls ~name:"override_trace_url_from_both_config_and_env" config 49 | 50 | let set_all_in_config () = 51 | let config = 52 | Config.make ~url_traces:"http://localhost:3001/send/traces" 53 | ~url_metrics:"http://localhost:3002/send/metrics" 54 | ~url_logs:"http://localhost:3003/send/logs" () 55 | in 56 | test_urls ~name:"set_all_in_config" config 57 | 58 | let set_all_in_env () = 59 | Unix.putenv "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" 60 | "http://localhost:3001/send/traces"; 61 | Unix.putenv "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT" 62 | "http://localhost:3002/send/metrics"; 63 | Unix.putenv "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT" 64 | "http://localhost:3003/send/logs"; 65 | let config = Config.make () in 66 | test_urls ~name:"set_all_in_env" config 67 | 68 | let remove_trailing_slash_config () = 69 | let config = Config.make ~url:"http://localhost:3000/" () in 70 | test_urls ~name:"remove_trailing_slash_config" config 71 | 72 | let remove_trailing_slash_env () = 73 | Unix.putenv "OTEL_EXPORTER_OTLP_ENDPOINT" "http://localhost:3000/"; 74 | let config = Config.make () in 75 | test_urls ~name:"remove_trailing_slash_env" config 76 | 77 | let () = default_url () 78 | 79 | let () = base_url_from_config () 80 | 81 | let () = base_url_from_env () 82 | 83 | let () = base_url_from_both_config_and_env () 84 | 85 | let () = override_trace_url_from_config () 86 | 87 | let () = override_trace_url_from_env () 88 | 89 | let () = override_trace_url_from_both_config_and_env () 90 | 91 | let () = set_all_in_config () 92 | 93 | let () = set_all_in_env () 94 | 95 | let () = remove_trailing_slash_config () 96 | 97 | let () = remove_trailing_slash_env () 98 | -------------------------------------------------------------------------------- /vendor/dune: -------------------------------------------------------------------------------- 1 | (vendored_dirs atomic) 2 | --------------------------------------------------------------------------------